Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/extract_rst.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/extract_rst.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/extract_rst.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/install.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/install.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/install.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/makefile_compile
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/makefile_compile	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/makefile_compile	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/sphinx/conf.py
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/sphinx/conf.py	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/DOC_SCRIPTS/sphinx/conf.py	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/ADM/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/ADM/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_book.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_book.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_book.tex	(revision 3437)
@@ -0,0 +1,335 @@
+%description: Book template
+
+% template of document for LaTeX
+% (C) Xavier Perseguers 2002 - xavier.perseguers@epfl.ch
+
+\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
+
+% ================================================================
+% HEADERS DEFINITION
+% ================================================================
+
+\usepackage[french]{babel}
+%\usepackage{color}
+\usepackage{xcolor}
+%\usepackage{graphics}				% allows insertion of pictures
+\usepackage{graphicx}				% allows insertion of pictures
+\usepackage[capbesideposition={top,center}]{floatrow} % allows captions
+\floatsetup[table]{style=plaintop}                                   % beside pictures
+\usepackage[margin=10pt,font={small},labelsep=colon,labelfont={bf}]{caption} % Gives small font for captions
+\usepackage{enumitem}                          % allows non-bold description items
+%\usepackage{colortbl}                           % gives coloured panels behind table columns
+
+%hyperref
+\usepackage[					%
+  pdftitle={NEMO ocean engine},	%
+  pdfauthor={Gurvan Madec},		% pdfsubject={The preprint document class
+                           				% elsart},% pdfkeywords={diapycnal diffusion,numerical mixing,z-level models},%
+  pdfstartview=FitH,				%
+  bookmarks=true,				%
+  bookmarksopen=true,			%
+  breaklinks=true,				%
+  colorlinks=true,				%
+  linkcolor=blue,anchorcolor=blue,	%
+  citecolor=blue,filecolor=blue,		%
+ menucolor=blue,                   	%
+  urlcolor=blue]{hyperref}
+%  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
+\fancypagestyle{plain}{
+  \fancyhead{}         % get rid of headers on plain pages
+  \renewcommand{\headrulewidth}{0pt}  % and the line
+}
+
+
+%%%%  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}
+\usepackage{amssymb}
+\usepackage{amsmath}
+\allowdisplaybreaks[1]				% allow page breaks in the middle of equations
+\usepackage{./TexFiles/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}  		%%  alltt for namelist
+\usepackage{verbatim}  	%%  alltt for namelist
+% namelists
+\newcommand{\namdisplay} [1] {
+\begin{alltt}
+{\tiny \verbatiminput{./TexFiles/Namelist/#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{\np} [1] {\textit{#1}\index{Namelist parameters!#1}}		%namelist parameter (nampar)
+\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}
+
+
+% ================================================================
+% FRONT PAGE
+% ================================================================
+
+%\usepackage{pstricks}
+\title{
+%\psset{unit=1.1in,linewidth=4pt} 	%parameters of the units for pstricks
+% \rput(0,2){ \includegraphics[width=1.1\textwidth]{./TexFiles/Figures/logo_ALL.pdf}             } \\
+% \vspace{0.1cm}
+\vspace{-6.0cm}
+\includegraphics[width=1.1\textwidth]{./TexFiles/Figures/logo_ALL.pdf}\\
+\vspace{5.1cm}
+\includegraphics[width=0.9\textwidth]{./TexFiles/Figures/NEMO_logo_Black.pdf} \\
+\vspace{1.4cm}
+\rule{345pt}{1.5pt} \\
+\vspace{0.45cm}
+{\Huge NEMO ocean engine}
+\rule{345pt}{1.5pt} \\
+ }
+%{ -- Draft --}   }
+%\date{\today}
+\date{
+January 2012  \\
+{\small  -- version 3.4 --} \\
+~  \\
+\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@hermes.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
+
+% ================================================================
+%      Include ONLY order
+% ================================================================
+
+%\includeonly{./TexFiles/Chapters/Chap_MISC}
+%\includeonly{./TexFiles/Chapters/Chap_ZDF}
+%\includeonly{./TexFiles/Chapters/Chap_STP,./TexFiles/Chapters/Chap_SBC,./TexFiles/Chapters/Chap_TRA}
+%\includeonly{./TexFiles/Chapters/Chap_LBC,./TexFiles/Chapters/Chap_MISC}
+%\includeonly{./TexFiles/Chapters/Chap_Model_Basics}
+%\includeonly{./TexFiles/Chapters/Annex_A,./TexFiles/Chapters/Annex_B,./TexFiles/Chapters/Annex_C,./TexFiles/Chapters/Annex_D}
+
+% ================================================================
+% ================================================================
+\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
+% ================================================================
+
+\include{./TexFiles/Chapters/Abstracts_Foreword}
+
+% ================================================================
+% INTRODUCTION
+% ================================================================
+
+\include{./TexFiles/Chapters/Introduction}
+
+% ================================================================
+% CHAPTERS
+% ================================================================
+
+\include{./TexFiles/Chapters/Chap_Model_Basics}
+
+\include{./TexFiles/Chapters/Chap_STP}			% Time discretisation (time stepping strategy)
+
+\include{./TexFiles/Chapters/Chap_DOM}			% Space discretisation
+
+\include{./TexFiles/Chapters/Chap_TRA}			% Tracer advection/diffusion equation
+
+\include{./TexFiles/Chapters/Chap_DYN}			% Dynamics : momentum equation
+
+\include{./TexFiles/Chapters/Chap_SBC}			% Surface Boundary Conditions
+
+\include{./TexFiles/Chapters/Chap_LBC}			% Lateral Boundary Conditions
+
+\include{./TexFiles/Chapters/Chap_LDF}			% Lateral diffusion
+
+\include{./TexFiles/Chapters/Chap_ZDF}			% Vertical diffusion
+
+\include{./TexFiles/Chapters/Chap_DIA}			% Miscellaneous topics
+
+\include{./TexFiles/Chapters/Chap_OBS}                  % Observation operator
+
+\include{./TexFiles/Chapters/Chap_ASM}                  % Assimilation increments
+
+\include{./TexFiles/Chapters/Chap_MISC}			% Miscellaneous topics
+
+\include{./TexFiles/Chapters/Chap_CFG}			% Predefined configurations
+
+% ================================================================
+% APPENDIX
+% ================================================================
+
+\appendix
+
+%\include{./TexFiles/Chapters/Chap_Conservation}
+\include{./TexFiles/Chapters/Annex_A}			% generalised vertical coordinate
+\include{./TexFiles/Chapters/Annex_B}			% diffusive operator
+\include{./TexFiles/Chapters/Annex_C}			% Discrete invariants of the eqs.
+\include{./TexFiles/Chapters/Annex_D}			% Coding rules
+\include{./TexFiles/Chapters/Annex_ISO}	                  % Isoneutral diffusion using triads
+%\include{./TexFiles/Chapters/Annex_E}	                  % Notes on some on going staff (no included in the DOC)
+%\include{./TexFiles/Chapters/Annex_Fox-Kemper}   % Notes on Fox-Kemper (no included in the DOC)
+%\include{./TexFiles/Chapters/Annex_EVP}        	% Notes on EVP (no included in the DOC)
+
+% ================================================================
+% INDEX
+% ================================================================
+
+\addcontentsline{toc}{chapter}{Index}
+\printindex
+
+% ================================================================
+% BIBLIOGRAPHY
+% ================================================================
+
+%%\bibliographystyle{plainat}
+\bibliographystyle{./TexFiles/ametsoc}		% AMS biblio style (JPO)
+\bibliography{./TexFiles/Biblio/Biblio}
+
+% ================================================================
+\end{document}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_coding.conv.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_coding.conv.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/NEMO_coding.conv.tex	(revision 3437)
@@ -0,0 +1,599 @@
+\documentclass[a4paper]{article}
+\usepackage{type1cm} 
+\usepackage{times} 
+\usepackage{color} 
+\usepackage{rotating} 
+\usepackage{color} 
+\usepackage{framed} 
+\usepackage{makeidx} 
+
+
+%%%%%%%
+\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]{./TexFiles/Figures/NEMO_logo_Black.pdf} \\
+\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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Biblio/Biblio.bib
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Biblio/Biblio.bib	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Biblio/Biblio.bib	(revision 3437)
@@ -0,0 +1,2994 @@
+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{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{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{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{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{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}
+}
+
+
+@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},
+  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{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{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{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{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{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}
+}
+
+@ARTICLE{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},
+  publisher = {LA-CC-06-012, Los Alamos National Laboratory, N.M.},
+  year = {2008}
+}
+
+@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{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}
+}
+
+@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{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/}
+}
+
+@ARTICLE{Leclair_Madec_OM10s,
+  author = {M. Leclair and G. Madec},
+  title = {$\tilde{z}$-coordinate, an Arbitrary Lagrangian-Eulerian coordinate separating high and low frequency},
+  journal = OM,
+  year = {2010},
+  pages = {submitted},
+}
+
+@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}
+}
+
+@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}
+}
+
+@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_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 diﬀusion from dissipation measurements},
+  journal = JPO,
+  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{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{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{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{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{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},
+}
+
+@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{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{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}
+}
+
+@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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Abstracts_Foreword.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Abstracts_Foreword.tex	(revision 3437)
@@ -0,0 +1,70 @@
+
+% ================================================================
+% 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 linear 
+or non-linear sea surface height, the temperature and the salinity. In the horizontal direction, 
+the model uses a curvilinear orthogonal grid and in the vertical direction, a full or partial step 
+$z$-coordinate, or $s$-coordinate, or a mixture of the two. The distribution of variables is a 
+three-dimensional Arakawa C-type grid. Various physical choices are available to describe 
+ocean physics, including TKE, GLS and KPP vertical physics. Within NEMO, the ocean is 
+interfaced with a sea-ice model (LIM v2 and v3), passive tracer and biogeochemical models (TOP) 
+and, via the OASIS coupler, with several atmospheric general circulation models. It also 
+support two-way grid embedding via the AGRIF software.
+
+% ================================================================
+ \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 ou non, la temperature et la salinit\'{e}. 
+La distribution des variables se fait sur une grille C d'Arakawa tridimensionnelle utilisant une 
+coordonn\'{e}e verticale $z$ \`{a} niveaux entiers ou partiels, ou une coordonn\'{e}e s, ou encore 
+une combinaison des deux. Diff\'{e}rents choix sont propos\'{e}s pour d\'{e}crire la physique 
+oc\'{e}anique, incluant notamment des physiques verticales TKE, GLS et KPP. A travers l'infrastructure 
+NEMO, l'oc\'{e}an est interfac\'{e} avec des mod\`{e}les de glace de mer, de biog\'{e}ochimie 
+et de traceurs passifs, et, via le coupleur OASIS, \`{a} plusieurs mod\`{e}les de circulation 
+g\'{e}n\'{e}rale atmosph\'{e}rique. Il supporte \'{e}galement l'embo\^{i}tement interactif de 
+maillages via le logiciel AGRIF.
+} 
+
+% ================================================================
+% 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}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_A.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_A.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_A.tex	(revision 3437)
@@ -0,0 +1,533 @@
+
+% ================================================================
+% 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. 
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_B.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_B.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_B.tex	(revision 3437)
@@ -0,0 +1,365 @@
+% ================================================================
+% 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.
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_C.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_C.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_C.tex	(revision 3437)
@@ -0,0 +1,1549 @@
+% ================================================================
+% 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 $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 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  = 0
+\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 &&&\\
+&= A^{\,lm} \int \limits_D \zeta \textbf{k} \cdot \nabla \times 
+ 	\left[    \nabla_h \times \left( \zeta \; \textbf{k} \right)   \right]\;dv &&&\\
+&\equiv A^{\,lm} \sum\limits_{i,j,k}  \zeta \;e_{3f} 
+	\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:}
+%
+&\equiv  - A^{\,lm} \sum\limits_{i,j,k} 
+	\left\{    \left(  \frac{1} {e_{1v}\,e_{3v}}  \delta_i \left[ e_{3f} \zeta  \right]  \right)^2   b_v
+	         + \left(  \frac{1} {e_{2u}\,e_{3u}}  \delta_j \left[ e_{3f} \zeta  \right] \right)^2   b_u  \right\}      &&&\\
+& \leq \;0       &&&\\ 
+\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 (!!! II.1.8  !!!!!). 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\} 
+	\qquad \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\} \;    &&&\\
+%
+&\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, second 
+order centered finite differences). Since a flux form is used to compute the 
+temperature and salinity, the quadratic form of these quantities (i.e. their variance) 
+globally tends to diminish. As for the advection term, there is generally no strict 
+conservation of mass, even if in practice the mass is conserved to a very high 
+accuracy. 
+
+% -------------------------------------------------------------------------------------------------------------
+%       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
+%}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_D.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_D.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_D.tex	(revision 3437)
@@ -0,0 +1,199 @@
+% ================================================================
+% 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\_}& 
+\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}& 
+\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}
+%--------------------------------------------------------------------------------------------------------------
+
+\newpage
+% ================================================================
+% The program structure
+% ================================================================
+\section{The program structure}
+\label{Apdx_D_structure}
+
+To be done....
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_E.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_E.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_E.tex	(revision 3437)
@@ -0,0 +1,807 @@
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_ISO_triad.pdf}
+\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.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_ISO.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_ISO.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Annex_ISO.tex	(revision 3437)
@@ -0,0 +1,1195 @@
+% ================================================================
+% 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 namelist parameters}
+%-----------------------------------------nam_traldf------------------------------------------------------
+\namdisplay{namtra_ldf}
+%---------------------------------------------------------------------------------------------------------
+If the namelist variable \np{ln\_traldf\_grif} is set true (and
+\key{ldfslp} is set), \NEMO updates both active and passive tracers
+using the Griffies triad representation of iso-neutral diffusion and
+the eddy-induced advective skew (GM) fluxes. Otherwise (by default) the
+filtered version of Cox's original scheme is employed
+(\S\ref{LDF_slp}). In the present implementation of the Griffies
+scheme, the advective skew fluxes are implemented even if
+\key{traldf\_eiv} is not set.
+
+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
+  $0.5^{\circ}$ runs (\key{orca\_r05}) 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 \key{orca\_r2}, \key{orca\_r1} or
+\key{orca\_r05} 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.
+
+The options specific to the Griffies scheme include:
+\begin{description}[font=\normalfont]
+\item[\np{ln\_traldf\_gdia}] Default value is false. See \S\ref{sec:triad:sfdiag}. If this is set true, time-mean
+  eddy-advective (GM) velocities are output for diagnostic purposes, even
+  though the eddy advection is accomplished by means of the skew
+  fluxes.
+\item[\np{ln\_traldf\_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\_traldf\_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\_traldf\_botmix}] 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.
+\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}[h] \begin{center}
+    \includegraphics[width=1.05\textwidth]{./TexFiles/Figures/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
+  {\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}
+In calculating the slopes of the local neutral
+surfaces, the expansion coefficients $\alpha$ and $\beta$ are
+evaluated at the anchor points of the triad \footnote{Note that in \eqref{eq:triad:R} 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}, while the metrics are
+calculated at the $u$- and $w$-points on the arms.
+
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[h] \begin{center}
+    \includegraphics[width=0.80\textwidth]{./TexFiles/Figures/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\_grif}=false, but left unmasked,
+giving bottom mixing, if \np{ln\_botmix\_grif}=true.
+
+The default option \np{ln\_botmix\_grif}=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\_grif}=true may be necessary.
+% >>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[h] \begin{center}
+    \includegraphics[width=0.60\textwidth]{./TexFiles/Figures/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\_grif}=.false., but left
+      unmasked, giving bottom mixing, if \np{botmix\_grif}=.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]{./TexFiles/Figures/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\_grif} 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\_grif} 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\_grif} 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}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ASM.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ASM.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ASM.tex	(revision 3437)
@@ -0,0 +1,173 @@
+% ================================================================
+% 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{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 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}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_CFG.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_CFG.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_CFG.tex	(revision 3437)
@@ -0,0 +1,298 @@
+% ================================================================
+% 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 predefined configuration. 
+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 test cases also provide a sense for some of the options available 
+in the code, though by no means are all options exercised in the predefined configurations.
+
+
+%There is several predefined ocean configuration which use is controlled by a specific CPP key. 
+
+%The key set the domain sizes (\jp{jpiglo}, \jp{jpjglo}, \jp{jpk}), the mesh and the bathymetry, 
+%and, in some cases, add to the model physics some specific treatments.
+
+
+% ================================================================
+% 1D model functionality
+% ================================================================
+\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 \key{c1d} CPP key. 
+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 3 x 3 domain centred on the grid point of interest (see \S\ref{MISC_zoom}), 
+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 par\_oce.F90 module by setting the \jp{jpizoom} and \jp{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. 
+Therefore a simplified \rou{step} routine is used (\rou{step\_c1d}) in which both lateral tendancy 
+terms and lateral physics are not called, and the vertical velocity is zero (so far, no attempt at
+introducing a Ekman pumping velocity has been made).
+Second, the two components of the velocity are moved on a $T$-point. 
+This requires a specific treatment of the Coriolis term (see \rou{dyncor\_c1d}) and of the 
+dynamic time stepping (\rou{dynnxt\_c1d}).
+All the relevant 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 (\key{orca\_rX})}
+\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.
+
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=0.98\textwidth]{./TexFiles/Figures/Fig_ORCA_NH_mesh.pdf}
+\caption{  \label{Fig_MISC_ORCA_msh}     
+ORCA mesh conception. The departure from an isotropic Mercator grid start poleward of 20\deg N.
+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]{./TexFiles/Figures/Fig_ORCA_NH_msh05_e1_e2.pdf}
+\includegraphics[width=0.80\textwidth]{./TexFiles/Figures/Fig_ORCA_aniso.pdf}
+\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\deg N a Mercator grid is used ($e_1 = e_2$) 
+so that the anisotropy ratio is 1. Poleward of 20\deg N, 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\deg$N, 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 a CPP key, \key{orca\_rX} 
+(with X being an indicator of the resolution), which set the grid size and configuration 
+name parameters  (Tab.~\ref{Tab_ORCA}).
+.
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[!t]     \begin{center}
+\begin{tabular}{p{4cm} c c c c}
+CPP key          	             & \jp{jp\_cfg} &  \jp{jpiglo} & \jp{jpiglo} &       \\  
+\hline  \hline
+\key{orca\_r4} 	    &        4         &         92     &      76      &       \\
+\key{orca\_r2}       &        2         &       182     &    149      &        \\
+\key{orca\_r1}       &        1         &       362     &     292     &        \\
+\key{orca\_r05}     &        05       &       722     &     511     &        \\
+\key{orca\_r025}   &        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 name of the configuration is set to "orca" ($i.e.$ \jp{cp\_cfg}~=~orca). }
+\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} 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 employ 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 key \key{arctic} or \key{antarctic}, 
+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 (\key{gyre})}
+\label{MISC_config_gyre}
+
+The GYRE configuration \citep{Levy_al_OM10} have been built to simulated 
+the seasonal cycle of a double-gyre box model. It consist 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\deg$N 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\deg N and 36\deg N. 
+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 through the \key{gyre} CPP key. Its horizontal resolution 
+(and thus the size of the domain) is determined by setting \jp{jp\_cfg} in \hf{par\_GYRE} file: \\
+\jp{jpiglo} $= 30 \times$ \jp{jp\_cfg} + 2   \\
+\jp{jpjglo} $= 20 \times$ \jp{jp\_cfg} + 2   \\
+Obviously, the namelist parameters have to be adjusted to the chosen resolution.
+In the vertical, GYRE uses the default 30 ocean levels (\jp{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.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]   \begin{center}
+\includegraphics[width=1.0\textwidth]{./TexFiles/Figures/Fig_GYRE.pdf}
+\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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%       EEL family configuration
+% -------------------------------------------------------------------------------------------------------------
+\section{EEL family: periodic channel}
+\label{MISC_config_EEL}
+
+\begin{description}
+\item[\key{eel\_r2}]  to be described....
+\item[\key{eel\_r5}]  
+\item[\key{eel\_r6}]  
+\end{description}
+
+% -------------------------------------------------------------------------------------------------------------
+%       AMM configuration
+% -------------------------------------------------------------------------------------------------------------
+\section{AMM: atlantic margin configuration (\key{amm\_12km})}
+\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 key \key{amm\_12km}
+is used to create 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 (key\_bdy).
+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 ommited by removing the BDY key (key\_bdy).
+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.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Conservation.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Conservation.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Conservation.tex	(revision 3437)
@@ -0,0 +1,334 @@
+
+% ================================================================
+% 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.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DIA.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DIA.tex	(revision 3437)
@@ -0,0 +1,1192 @@
+% ================================================================
+% Chapter Ñ I/O & Diagnostics
+% ================================================================
+\chapter{Ouput and Diagnostics (IOM, DIA, TRD, FLO)}
+\label{DIA}
+\minitoc
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+%       Old Model Output 
+% ================================================================
+\section{Old Model Output (default or \key{dimgout})}
+\label{DIA_io_old}
+
+The model outputs are of three types: the restart file, the output listing, 
+and the 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.
+
+In the standard configuration, the user will find the model results in 
+NetCDF files containing mean values (or instantaneous values if 
+\key{diainstant} is defined) for every time-step where output is demanded.
+These outputs are defined in the \mdl{diawri} module. 
+When defining \key{dimgout}, the output are written in DIMG format,
+an IEEE output format.
+
+Since version 3.2, an I/O server has been added which provides more
+flexibility in the choice of the fields to be output as well as how the 
+writing work is distributed over the processors in massively parallel
+computing. It is presented in next section. 
+
+
+%\gmcomment{                    % start of gmcomment
+
+% ================================================================
+% Diagnostics
+% ================================================================
+\section{Standard model Output (IOM)}
+\label{DIA_iom}
+
+
+Since version 3.2, iom\_put is the NEMO output interface. It was designed to be simple to use, 
+flexible and efficient. Two main functionalities are covered by iom\_put: 
+(1) the control of the output files through an external xml file defined by the user ; 
+(2) the distribution (or not) of all task related to output files on dedicated processors.
+The first functionality allows the user to specify, without touching anything into the code, 
+the way he want to output data: \\
+- choice of output frequencies that can be different for each file (including real months and years) \\
+- choice of file contents: decide which data will be written in which file (the same data can be 
+outputted in different files)  \\
+- possibility to extract a subdomain (for example all TAO-PIRATA-RAMA moorings are already defined)  \\
+- choice of the temporal operation to perform: mean, instantaneous, min, max  \\
+- extremely large choice of data available   \\
+- redefine variables name and long\_name  \\
+In addition, iom\_put allows the user to output any variable (scalar, 2D or 3D) in the code 
+in a very easy way. All details of iom\_put functionalities are listed in the following subsections.
+An example of the iodef.xml file that control the outputs can be found here: 
+NEMOGCM/CONFIG/ORCA2\_LIM/EXP00/iodef.xml
+
+The second functionality targets outputs performances when running on a very large number of processes. 
+The idea is to dedicate N specific processes to write the outputs, where N is defined by the user. 
+In the current version, this functionality is technically working however, its performance are usually poor 
+(for known reasons). Users can therefore test this functionality but they must be aware that expected 
+performance improvement will not be achieved before the release 3.4.
+An example of xmlio\_server.def NEMOGCM/CONFIG/ORCA2\_LIM/EXP00/xmlio\_server.def
+ 
+
+\subsection{Basic knowledge}
+
+
+\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 is split into 3 parts:
+\begin{description}
+\item[field definition]: define all variables that can be output \\
+all lines in between the following two tags\\
+\verb?   <field\_definition ...> ?  \\
+\verb?   </field\_definition ...> ? 
+\item[file definition]: define the netcdf files to be created and the variables they will contain \\
+all lines in between the following two tags \\
+\verb?   <field\_definition> ?  \\
+\verb?   </field\_definition> ?
+\item[axis and grid definitions]: define the horizontal and vertical grids \\
+all lines in between the following two set of two tags\\
+\verb?   <axis\_definition ...> ?  \\
+\verb?   </axis\_definition ...> ?
+and \\
+\verb?   <grid\_definition ...> ?  \\
+\verb?   </grid\_definition ...> ?
+\end{description}
+
+\subsubsection{Inheritance and group }
+
+ Xml extensively uses the concept of inheritance. \\
+\\
+example 1: \\
+\vspace{-30pt}
+\begin{alltt}  {{\scriptsize    
+\begin{verbatim}
+   <field_definition operation="ave(X)" >
+      <field id="sst"                    />   <!-- averaged      sst --> 
+      <field id="sss" operation="inst(X)"/>   <!-- 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 ''ave(X)'' 
+of the attribute ''operation'' from its parent ''field definition''. Note that a child can overwrite 
+the attribute definition inherited from its parents. In the example above, the field ''sss'' will 
+therefore output instantaneous values instead of average values.
+
+example 2: Use (or overwrite) attributes value of a field when listing the variables included in a file
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_definition>
+      <field id="sst" description="sea surface temperature" />   
+      <field id="sss" description="sea surface salinity"    />  
+   </field_definition>      
+
+   <file_definition>
+      <file id="file_1" />   
+            <field ref="sst"                              />  <!-- default def -->
+            <field ref="sss" description="my description" />  <!-- overwrite   -->
+      </file>   
+   </file_definition> 
+\end{verbatim}
+}}\end{alltt} 
+
+With the help of the inheritance, the concept of group allow to define a set of attributes 
+for several fields or files. 
+
+example 3, group of fields: define a group ''T\_grid\_variables'' identified with the name 
+''grid\_T''. By default variables of this group have no vertical axis but, following inheritance 
+rules, ''axis\_ref'' can be redefined for the field ''toce'' that is a 3D variable.
+\vspace{-30pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_definition>
+      <group id="grid_T" axis_ref="none" grid_ref="T_grid_variables">
+            <field id="sst"/>  
+            <field id="sss"/>  
+            <field id="toce" axis_ref="deptht"/>  <!-- overwrite axis def -->
+      </group>
+   </field_definition> 
+\end{verbatim}
+}}\end{alltt} 
+
+example 4, group of files: define a group of file with the attribute output\_freq equal to 432000 (5 days)
+\vspace{-30pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file_definition>
+      <group id="5d" output_freq="432000">    <!-- 5d files -->
+         <file id="5d_grid_T" name="auto">   <!-- T grid file -->
+         ...
+         </file>
+         <file id="5d_grid_U" name="auto">   <!-- U grid file -->
+         ...
+         </file>
+      </group>
+   </file_definition> 
+\end{verbatim}
+}}\end{alltt} 
+
+\subsubsection{Control of the xml attributes from NEMO}
+
+The values of some attributes are automatically defined by NEMO (and any definition 
+given in the xml file is 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
+    1h, 2h, 3h, 4h, 6h, 12h & \_grid\_T, \_grid\_U,  &  name & filename defined by   \\
+    1d, 3d, 5d                     & \_grid\_V, \_grid\_W, &            & a call to rou{dia\_nam}  \\
+    1m, 2m, 3m, 4m, 6m    & \_icemod, \_ptrc\_T,  &            & following NEMO \\
+    1y, 2y, 5y, 10y               &  \_diad\_T, \_scalar   &            & nomenclature \\
+   \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} & ibegin, jbegin,      & according to the grid    \\
+    \multicolumn{2}{|c|}{                                                       } & name\_suffix &                                      \\
+   \hline
+\end{tabular}
+
+
+\subsection{ Detailed functionalities }
+
+\subsubsection{Tag list}
+
+\begin{description}
+
+\item[context]: define the model using the xml file. Id is the only attribute accepted. 
+Its value must be ''nemo'' or ''n\_nemo'' for the nth AGRIF zoom. Child of simulation tag.
+
+\item[field]: define the field to be output. Accepted attributes are axis\_ref, description, enable, 
+freq\_op, grid\_ref, id (if child of field\_definition), level, operation, name, ref (if child of file), 
+unit, zoom\_ref. Child of field\_definition, file or group of fields tag.
+
+\item[field\_definition]: definition of the part of the xml file corresponding to the field definition. 
+Accept the same attributes as field tag. Child of context tag.
+
+\item[group]: define a group of file or field. Accept the same attributes as file or field.
+
+\item[file]: define the output file's characteristics. Accepted attributes are description, enable, 
+output\_freq, output\_level, id, name, name\_suffix. Child of file\_definition or group of files tag.
+
+\item[file\_definition]: definition of the part of the xml file corresponding to the file definition. 
+Accept the same attributes as file tag. Child of context tag.
+
+\item[axis]: definition of the vertical axis. Accepted attributes are description, id, positive, size, unit. 
+Child of axis\_definition tag.
+
+\item[axis\_definition]: definition of the part of the xml file corresponding to the vertical axis definition. 
+Accept the same attributes as axis tag. Child of context tag
+
+\item[grid]: definition of the horizontal grid. Accepted attributes are description and id. 
+Child of axis\_definition tag.
+
+\item[grid\_definition]: definition of the part of the xml file corresponding to the horizontal grid definition. 
+Accept the same attributes as grid tag. Child of context tag
+
+\item[zoom]: definition of a subdomain of an horizontal grid. Accepted attributes are description, id, 
+i/jbegin, ni/j. Child of grid tag.
+
+\end{description}
+
+
+\subsubsection{Attributes list}
+
+Applied to a tag or a group of tags.
+
+% table to be added ?
+Another table, perhaps?
+
+%%%%
+
+Attribute
+Applied to?
+Definition
+Comment
+axis\_ref
+field
+String defining the vertical axis of the variable. It refers to the id of the vertical axis defined in the axis tag.
+Use ''non'' if the variable has no vertical axis
+
+%%%%%%
+
+\begin{description}
+
+\item[axis\_ref]: field attribute. String defining the vertical axis of the variable. 
+It refers to the id of the vertical axis defined in the axis tag. 
+Use ''none'' if the variable has no vertical axis
+
+\item[description]: this attribute can be applied to all tags but it is used only with the field tag. 
+In this case, the value of description will be used to define, in the output netcdf file, 
+the attributes long\_name and standard\_name of the variable.
+
+\item[enabled]: field and file attribute. Logical to switch on/off the output of a field or a file. 
+
+\item[freq\_op]: field attribute (automatically defined, see part 1.4 (''control of the xml attributes'')). 
+An integer defining the frequency in seconds at which NEMO is calling iom\_put for this variable. 
+It corresponds to the model time step (rn\_rdt in the namelist) except for the variables computed 
+at the frequency of the surface boundary condition (rn\_rdt ? nn\_fsbc in the namelist).   
+
+\item[grid\_ref]: field attribute. String defining the horizontal grid of the variable. 
+It refers to the id of the grid tag.
+
+\item[ibegin]: zoom attribute. Integer defining the zoom starting point along x direction. 
+Automatically defined for TAO/RAMA/PIRATA moorings (see part 1.4).  
+
+\item[id]: exists for all tag. This is a string defining the name to a specific tag that will be used 
+later to refer to this tag. Tags of the same category must have different ids.
+
+\item[jbegin]: zoom attribute. Integer defining the zoom starting point along y direction. 
+Automatically defined for TAO/RAMA/PIRATA moorings and equatorial section (see part 1.4). 
+
+\item[level]: field attribute. Integer from 0 to 10 defining the output priority of a field. 
+See output\_level attribute definition
+
+\item[operation]: field attribute. String defining the type of temporal operation to perform on a variable. 
+Possible choices are ''ave(X)'' for temporal mean, ''inst(X)'' for instantaneous, ''t\_min(X)'' for temporal min 
+and ''t\_max(X)'' for temporal max.
+
+\item[output\_freq]: file attribute. Integer defining the operation frequency in seconds. 
+For example 86400 for daily mean.
+
+\item[output\_level]: file attribute. Integer from 0 to 10 defining the output priority of variables in a file: 
+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.  
+
+\item[positive]: axis attribute (always .FALSE.). Logical defining the vertical axis convention used 
+in \NEMO (positive downward). Define the attribute positive of the variable in the netcdf output file.
+
+\item[prec]: field attribute. Integer defining the output precision. 
+Not implemented, we always output real4 arrays. 
+
+\item[name]: field or file attribute. String defining the name of a variable or a file. 
+If the name of a file is undefined, its id is used as a name. 2 files must have different names. 
+Files with specific ids will have their name automatically defined (see part 1.4). 
+Note that is name will be automatically completed by the cpu number (if needed) and ''.nc''
+
+\item[name\_suffix]: file attribute. String defining a suffix to be inserted after the name 
+and before the cpu number and the ''.nc'' termination. Files with specific ids have an 
+automatic definition of their suffix (see part 1.4).
+
+\item[ni]: zoom attribute. Integer defining the zoom extent along x direction. 
+Automatically defined for equatorial sections (see part 1.4).  
+
+\item[nj]: zoom attribute. Integer defining the zoom extent along x direction. 
+
+\item[ref]: field attribute. String referring to the id of the field we want to add in a file.
+
+\item[size]: axis attribute. use unknown...
+
+\item[unit]: field attribute. String defining the unit of a variable and the associated 
+attribute in the netcdf output file.
+
+\item[zoom\_ref]: field attribute. String defining the subdomain of data on which 
+the file should be written (to ouput data only in a limited area). 
+It refers to the id of a zoom defined in the zoom tag.
+\end{description}
+
+
+\subsection{IO\_SERVER}
+
+\subsubsection{Attached or detached mode?}
+
+Iom\_put is based on the io\_server developed by Yann Meurdesoif from IPSL 
+(see \href{http://forge.ipsl.jussieu.fr/ioserver/browser}{here} for the source code or 
+see its copy in NEMOGCM/EXTERNAL directory). 
+This server can be used in ''attached mode'' (as a library) or in ''detached mode'' 
+(as an external executable on n cpus). In attached mode, each cpu of NEMO will output 
+its own subdomain. In detached mode, the io\_server will gather data from NEMO 
+and output them split over n files with n the number of cpu dedicated to the io\_server.
+
+\subsubsection{Control the io\_server: the namelist file xmlio\_server.def}
+
+%
+%Again, a small table might be more readable?
+%Name
+%Type
+%Description
+%Comment
+%Using_server
+%Logical 
+%Switch to use the server in attached or detached mode
+%(.TRUE. corresponding to detached mode).
+
+The control of the use of the io\_server is done through the namelist file of the io\_server 
+called xmlio\_server.def.
+
+\textbf{using\_server}: logical, switch to use the server in attached or detached mode 
+(.TRUE. corresponding to detached mode).
+
+\textbf{using\_oasis}: logical, set to .TRUE. if NEMO is used in coupled mode.
+
+\textbf{client\_id} = ''oceanx'' : character, used only in coupled mode. 
+Specify the id used in OASIS to refer to NEMO. The same id must be used to refer to NEMO 
+in the \$NBMODEL part of OASIS namcouple in the call of prim\_init\_comp\_proto in cpl\_oasis3f90
+
+\textbf{server\_id} = ''ionemo'' : character, used only in coupled mode. 
+Specify the id used in OASIS to refer to the IO\_SERVER when used in detached mode. 
+Use the same id to refer to the io\_server in the \$NBMODEL part of OASIS namcouple.
+
+\textbf{global\_mpi\_buffer\_size}: integer; define the size in Mb of the MPI buffer used by the io\_server.
+
+\subsubsection{Number of cpu used by the io\_server in detached mode}
+
+The number of cpu used by the io\_server is specified only when launching the model.
+Here is an example of 2 cpus for the io\_server and 6 cpu for opa using mpirun:
+
+\texttt{ -p 2 -e ./ioserver}
+
+\texttt{ -p 6 -e ./opa }
+
+
+\subsection{Practical issues}
+
+\subsubsection{Add your own outputs}
+
+It is very easy to add you own outputs with iom\_put. 4 points must be followed.
+\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-] don't forget to add \\
+\texttt{   USE iom            ! I/O manager library }  \\
+in the list of used modules in the upper part of your module. 
+
+\item[3-] in the file\_definition part of the xml file, add the definition of your variable using the same identifier you used in the f90 code.
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <field_definition>
+      ...
+      <field id="identifier" description="blabla" />   
+      ...
+   </field_definition> 
+\end{verbatim}
+}}\end{alltt} 
+attributes axis\_ref and grid\_ref must be consistent with the size of the array to pass to iom\_put.
+if your array is computed within the surface module each nn\_fsbc time\_step, 
+add the field definition within the group defined with the id ''SBC'': $<$group id=''SBC''...$>$
+
+\item[4-] add your field in one of the output files   \\
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+   <file id="file_1" .../>   
+      ...
+      <field ref="identifier" />   
+      ...
+   </file>   
+\end{verbatim}
+}}\end{alltt} 
+
+\end{description}
+
+\subsubsection{Several time axes in the output file}
+
+If your output file contains variables with different operations (see operation definition), 
+IOIPSL will create one specific time axis for each operation. Note that inst(X) will have 
+a time axis corresponding to the end each output period whereas all other operators 
+will have a time axis centred in the middle of the output periods.
+
+\subsubsection{Error/bug messages from IOIPSL}
+
+If you get the following error in the standard output file:
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+FATAL ERROR FROM ROUTINE flio_dom_set
+ --> too many domains simultaneously defined 
+ --> please unset useless domains 
+ --> by calling flio_dom_unset 
+\end{verbatim}
+}}\end{alltt} 
+
+You must increase the value of dom\_max\_nb in fliocom.f90 (multiply it by 10 for example). 
+
+If you mix, in the same file, variables with different freq\_op (see definition above), 
+like for example variables from the surface module with other variables, 
+IOIPSL will print in the standard output file warning messages saying there may be a bug. 
+\vspace{-20pt}
+\begin{alltt}  {{\scriptsize
+\begin{verbatim}
+WARNING FROM ROUTINE histvar_seq   
+ --> There were 10 errors in the learned sequence of variables  
+ --> for file   4 
+ --> This looks like a bug, please report it.
+\end{verbatim}
+}}\end{alltt} 
+
+Don't worry, there is no bug, everything is properly working!
+
+ %    }      %end  \gmcomment
+
+
+% ================================================================
+%       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:
+
+\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 \np{ 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  (\key{trdtra}, \key{trddyn},    \\ 
+                                                             \key{trddvor}, \key{trdmld})}
+\label{DIA_trd}
+
+%------------------------------------------namtrd----------------------------------------------------
+\namdisplay{namtrd} 
+%-------------------------------------------------------------------------------------------------------------
+
+When \key{trddyn} and/or \key{trddyn} CPP variables are defined, each 
+trend of the dynamics and/or temperature and salinity time evolution equations 
+is stored in three-dimensional arrays just after their computation ($i.e.$ at the end 
+of each $dyn\cdots.F90$ and/or $tra\cdots.F90$ routines). These trends are then 
+used in \mdl{trdmod} (see TRD directory) every \textit{nn\_trd } time-steps.
+
+What is done depends on the CPP keys defined:
+\begin{description}
+\item[\key{trddyn}, \key{trdtra}] : a check of the basin averaged properties of the momentum 
+and/or tracer equations is performed ; 
+\item[\key{trdvor}] : a vertical summation of the moment tendencies is performed, 
+then the curl is computed to obtain the barotropic vorticity tendencies which are output ;
+\item[\key{trdmld}] : output of the tracer tendencies averaged vertically  
+either over the mixed layer (\np{nn\_ctls}=0), 
+or       over a fixed number of model levels (\np{nn\_ctls}$>$1 provides the number of level), 
+or       over a spatially varying but temporally fixed number of levels (typically the base 
+of the winter mixed layer) read in \ifile{ctlsurf\_idx} (\np{nn\_ctls}=1) ;
+\end{description}
+
+The units in the output file can be changed using the \np{nn\_ucf} namelist parameter. 
+For example, in case of salinity tendency the units are given by PSU/s/\np{nn\_ucf}.
+Setting \np{nn\_ucf}=86400 ($i.e.$ the number of second in a day) provides the tendencies in PSU/d.
+
+When \key{trdmld} is defined, two time averaging procedure are proposed.
+Setting \np{ln\_trdmld\_instant} to \textit{true}, a simple time averaging is performed, 
+so that the resulting tendency is the contribution to the change of a quantity between 
+the two instantaneous values taken at the extremities of the time averaging period.
+Setting \np{ln\_trdmld\_instant} to \textit{false}, a double time averaging is performed, 
+so that the resulting tendency is the contribution to the change of a quantity between 
+two \textit{time mean} values. The later option requires the use of an extra file, \ifile{restart\_mld}  
+(\np{ln\_trdmld\_restart}=true), to restart a run.
+
+
+Note that the mixed layer tendency diagnostic can also be used on biogeochemical models 
+via the \key{trdtrc} and \key{trdmld\_trc} CPP keys.
+
+% -------------------------------------------------------------------------------------------------------------
+%       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. 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 \np{"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 \np{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  \np{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 \np{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}
+
+A module is available to compute the amplitude and phase for tidal waves. 
+This diagnostic is actived with \key{diaharm}.
+
+%------------------------------------------namdia_harm----------------------------------------------------
+\namdisplay{namdia_harm}
+%----------------------------------------------------------------------------------------------------------
+
+Concerning the on-line Harmonic analysis, some parameters are available in namelist:
+
+- \texttt{nit000\_han} is the first time step used for harmonic analysis
+
+- \texttt{nitend\_han} is the last time step used for harmonic analysis
+
+- \texttt{nstep\_han} is the time step frequency for harmonic analysis
+
+- \texttt{nb\_ana} is the number of harmonics to analyse
+
+- \texttt{tname} is an array with names of tidal constituents to analyse
+
+\texttt{nit000\_han} and \texttt{nitend\_han} must be between \texttt{nit000} and \texttt{nitend} of the simulation.
+The restart capability is not implemented.
+
+The Harmonic analysis solve this 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}
+
+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}g s^{-1}$ )\\
+
+
+Namelist parameters 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:
+
+%------------------------------------------namdct----------------------------------------------------
+\namdisplay{namdct}
+%-------------------------------------------------------------------------------------------------------------
+
+\texttt{nn\_dct}: frequency of instantaneous transports computing
+
+\texttt{nn\_dctwri}: frequency of writing ( mean of instantaneous transports )
+
+\texttt{nn\_debug}: debugging of the section
+
+\subsubsection{ To create a binary file containing the pathway of each section }
+
+In \texttt{NEMOGCM/TOOLS/SECTIONS\_DIADCT/run}, the file \texttt{ {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}
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%       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 routines can be found in directory DIA. 
+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, \citet{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})
+
+The poleward heat and salt transports, their advective and diffusive component, and 
+the meriodional stream function can be computed on-line in \mdl{diaptr} by setting 
+\np{ln\_diaptr} to true (see the \textit{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}). 
+
+%------------------------------------------namptr----------------------------------------------------
+\namdisplay{namptr} 
+%-------------------------------------------------------------------------------------------------------------
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=1.0\textwidth]{./TexFiles/Figures/Fig_mask_subasins.pdf}
+\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}  
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+In addition, a series of diagnostics has been added in the \mdl{diaar5}. 
+They corresponds to outputs that are required for AR5 simulations 
+(see Section \ref{MISC_steric} below for one of them). 
+Activating those outputs requires to define the \key{diaar5} CPP key.
+\\
+\\
+
+
+
+% ================================================================
+% 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.
+
+% ================================================================
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DOM.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DOM.tex	(revision 3437)
@@ -0,0 +1,853 @@
+% ================================================================
+% 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 ligne
+
+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 ligne
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_cell.pdf}
+\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{equation} \label{Eq_DOM_div}
+\nabla \cdot \rm{\bf A}=\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{equation}
+
+In the special case of a pure $z$-coordinate system, \eqref{Eq_DOM_lap} and 
+\eqref{Eq_DOM_div} can be simplified. In this case, the vertical scale factor 
+becomes a function of the single variable $k$ and thus does not depend on the 
+horizontal location of a grid point. For example \eqref{Eq_DOM_div} reduces to: 
+\begin{equation*}
+\nabla \cdot \rm{\bf A}=\frac{1}{e_{1t}\,e_{2t}} \left( \delta_i \left[e_{2u}\,a_1 \right] 
+                                                                              +\delta_j \left[e_{1v}\, a_2 \right]  \right)
+                                                     +\frac{1}{e_{3t}} \delta_k \left[             a_3 \right]
+\end{equation*}
+
+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 anti-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]{./TexFiles/Figures/Fig_index_hor.pdf}
+\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]{./TexFiles/Figures/Fig_index_vert.pdf}
+\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 \jp{jpiglo}, 
+\jp{jpjglo} and \jp{jpk} in the $i$, $j$ and $k$ directions respectively. They are 
+given as parameters in the \mdl{par\_oce} module\footnote{When a specific 
+configuration is used (ORCA2 global ocean, etc...) the parameter are actually 
+defined in additional files introduced by \mdl{par\_oce} module via CPP 
+\textit{include} command. For example, ORCA2 parameters are set in 
+\textit{par\_ORCA\_R2.h90} file}. The use of parameters rather than variables 
+(together with dynamic allocation of arrays) was chosen because it ensured that 
+the compiler would optimize the executable code efficiently, especially on vector 
+machines (optimization may be less efficient when the problem size is unknown 
+at the time of compilation). Nevertheless, it is possible to set up the code with full 
+dynamical allocation by using the AGRIF packaged \citep{Debreu_al_CG2008}. 
+%
+\gmcomment{  add the following ref 
+\colorbox{yellow}{(ref part of the doc)} } 
+%
+Note that are other parameters in \mdl{par\_oce} that refer to the domain size. 
+The two parameters $jpidta$ and $jpjdta$ may be larger than $jpiglo$, $jpjglo$ 
+when the user wants to use only a sub-region of a given configuration. This is 
+the "zoom" capability described in \S\ref{MISC_zoom}. In most applications of 
+the model, $jpidta=jpiglo$, $jpjdta=jpjglo$, and $jpizoom=jpjzoom=1$. 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 ligne
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_zgr_e3.pdf}
+\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\,(i-1/2)^3 - 45\,(i-1/2)^2 + 140\,(i-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 parameter $jphgr\_mesh$ of the \mdl{par\_oce} module. 
+\begin{description}
+\item[\jp{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[\jp{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 
+\jp{jphgr\_mesh}=1, the grid (expressed in degrees) is regular in space, 
+with grid sizes specified by parameters \pp{ppe1\_deg} and \pp{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 (\jp{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 \pp{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 (\jp{jphgr\_mesh}=1 or 4), the grid position is defined by the 
+longitude and latitude of the south-westernmost point (\pp{ppglamt0} 
+and \pp{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 
+\jp{jphgr\_mesh} = 2, 3, 5. The domain is either an $f$-plane (\jp{jphgr\_mesh} = 2, 
+Coriolis factor is constant) or a beta-plane (\jp{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 \pp{ppe1\_m} and \pp{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 
+parameter \pp{ppglam0} is ignored. \pp{ppgphi0} is used to set the reference 
+latitude for computation of the Coriolis parameter. In the case of the beta plane, 
+\pp{ppgphi0} corresponds to the center of the domain. Finally, the special case 
+\jp{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 the parameter \jp{jperio} (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 parameter). 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 ligne
+
+% ================================================================
+% 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} 
+%-------------------------------------------------------------------------------------------------------------
+
+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]{./TexFiles/Figures/Fig_z_zps_s_sps.pdf}
+\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 with variable volume associated with the non-linear free surface. 
+Note that the variable volume option (\key{vvl}) 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 a namelist parameter, 
+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). When using the variable 
+volume option \key{vvl}) ($i.e.$ non-linear free surface), 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). This option can be used with full step 
+bathymetry or $s$-coordinate (hybride and partial step coordinates have not 
+yet been tested in NEMO v2.3). 
+
+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}. 
+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...}
+%%%
+
+The arrays describing the grid point depths and vertical scale factors 
+are three dimensional arrays $(i,j,k)$ even in the case of $z$-coordinate with 
+full step bottom topography. In non-linear free surface (\key{vvl}), their knowledge
+is required at \textit{before}, \textit{now} and \textit{after} time step, while they 
+do not vary in time in linear free surface case. 
+To improve the code readability while providing this flexibility, the vertical coordinate 
+and scale factors are defined as functions of 
+$(i,j,k)$ with "fs" as prefix (examples: \textit{fse3t\_b, fse3t\_n, fse3t\_a,} 
+for the  \textit{before}, \textit{now} and \textit{after} scale factors at $t$-point) 
+that can be either three different arrays when \key{vvl} is defined, or a single fixed arrays. 
+These functions are defined in the file \hf{domzgr\_substitute} of the DOM directory. 
+They are used throughout the code, and replaced by the corresponding arrays at 
+the time of pre-processing (CPP capability).
+
+% -------------------------------------------------------------------------------------------------------------
+%        Meter Bathymetry
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Meter Bathymetry}
+\label{DOM_bathy}
+
+Three options are possible for defining the bathymetry, according to the 
+namelist variable \np{nn\_bathy}: 
+\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 \jp{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. 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).
+\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]{./TexFiles/Figures/Fig_zgr.pdf}
+\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 \textit{par\_oce.h90} file. 
+
+It is possible to define a simple regular vertical grid by giving zero stretching (\pp{ppacr=0}). 
+In that case, the parameters \jp{jpk} (number of $w$-levels) and \pp{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}).
+
+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 
+\pp{ppsur}, \pp{ppa0}, \pp{ppa1}, \pp{ppkth} in the parameter file \mdl{par\_oce}. 
+
+Rather than entering parameters $h_{sur}$, $h_{0}$, and $h_{1}$ directly, it is 
+possible to recalculate them. In that case the user sets 
+\pp{ppsur}=\pp{ppa0}=\pp{ppa1}=\pp{pp\_to\_be\_computed}, in \mdl{par\_oce}, 
+and specifies instead the four following parameters:
+\begin{itemize}
+\item 	\pp{ppacr}=$h_{cr} $: stretching factor (nondimensional). The larger 
+\pp{ppacr}, the smaller the stretching. Values from $3$ to $10$ are usual.
+\item 	\pp{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 	\pp{ppdzmin}: minimum thickness for the top layer (in meters)
+\item 	\pp{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, \pp{ppacr}=9, \pp{ppkth}=23.563, \pp{ppdzmin}=6m, 
+\pp{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 the maximum depth \pp{pphmax} in partial steps: for example, with 
+\pp{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)$).
+
+ \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} 
+%--------------------------------------------------------------------------------------------------------------
+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). In the example provided 
+(\rou{zgr\_sco} routine, see \mdl{domzgr}) $h$ is a smooth envelope bathymetry 
+and steps are used to represent sharp bathymetric gradients.
+
+A new flexible stretching function, modified from \citet{Song_Haidvogel_JCP94} is provided as an example:
+\begin{equation} \label{DOM_sco_function}
+\begin{split}
+z	&= h_c +( h-h_c)\;c s)	\\
+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}
+where $h_c$ is the thermocline depth and $\theta$ and $b$ 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}).
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!tb]    \begin{center}
+\includegraphics[width=1.0\textwidth]{./TexFiles/Figures/Fig_sco_function.pdf}
+\caption{  \label{Fig_sco_function}   
+Examples of the stretching function applied to a sea mont; from left to right: 
+surface, surface and bottom, and bottom intensified resolutions}
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+%        z*- or s*-coordinate
+% -------------------------------------------------------------------------------------------------------------
+\subsection{$z^*$- or $s^*$-coordinate (add \key{vvl}) }
+\label{DOM_zgr_vvl}
+
+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.
+
+From the \textit{mbathy} array, the mask fields are defined as follows:
+\begin{align*}
+tmask(i,j,k) &= \begin{cases}   \; 1&   \text{ if $k\leq mbathy(i,j)$  }    \\
+                                                \; 0&   \text{ if $k\leq mbathy(i,j)$  }    \end{cases}     \\
+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)
+\end{align*}
+
+Note that \textit{wmask} is not defined as it is exactly equal to \textit{tmask} with 
+the numerical indexing used (\S~\ref{DOM_Num_Index}). Moreover, the 
+specification of closed lateral boundaries requires that at least the first and last 
+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}).
+
+%%%
+\gmcomment{   \colorbox{yellow}{Add one word on tricky trick !} mbathy in further modified in zdfbfr{\ldots}.  }
+%%%
+
+% ================================================================
+% 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} 
+%------------------------------------------------------------------------------------------
+
+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}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DYN.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_DYN.tex	(revision 3437)
@@ -0,0 +1,1248 @@
+% ================================================================
+% Chapter Ñ Ocean Dynamics (DYN)
+% ================================================================
+\chapter{Ocean Dynamics (DYN)}
+\label{DYN}
+\minitoc
+
+% add a figure for  dynvor ens, ene latices
+
+%\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 \ref{Griffies_al_MWR01, LeclairMadec2009}.
+
+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$. 
+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} 
+%-------------------------------------------------------------------------------------------------------------
+
+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_vor_zad}). 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]{./TexFiles/Figures/Fig_DYN_een_triad.pdf}
+\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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Note that a key point in \eqref{Eq_een_e3f} is that the averaging in the \textbf{i}- and 
+\textbf{j}- directions uses the masked vertical scale factor but is always divided by 
+$4$, not by the sum of the masks at the four $T$-points. This preserves the continuity of 
+$e_{3f}$ when one or more of the neighbouring $e_{3t}$ tends to zero and 
+extends by continuity the value of $e_{3f}$ into the land areas. This feature is essential for 
+the $z$-coordinate with partial steps.
+
+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_vor_zad}). 
+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} 
+
+% ================================================================
+% Coriolis and Advection : flux form
+% ================================================================
+\section{Coriolis and Advection: flux form}
+\label{DYN_adv_cor_flux}
+%------------------------------------------nam_dynadv----------------------------------------------------
+\namdisplay{namdyn_adv} 
+%-------------------------------------------------------------------------------------------------------------
+
+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} 
+%-------------------------------------------------------------------------------------------------------------
+
+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$ 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.
+
+%--------------------------------------------------------------------------------------------------------------
+%           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
+
+%%%
+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}
+
+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{Griffies_Bk04}. 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$.
+ 
+
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_DYN_dynspg_ts.pdf}
+\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. 
+Internal mode time steps (which are also the model time steps) are denoted 
+by $t-\rdt$, $t, t+\rdt$, and $t+2\rdt$. 
+The curved line represents a leap-frog time step, and the smaller time 
+steps $N \rdt_e=\frac{3}{2}\rdt$ are denoted by the zig-zag line. 
+The vertically integrated forcing \textbf{M}(t) computed at the model time step $t$ 
+represents the interaction between the external and internal motions. 
+While keeping \textbf{M} and freshwater forcing field fixed, a leap-frog 
+integration carries the external mode variables (surface height and vertically 
+integrated velocity) from $t$ to $t+\frac{3}{2} \rdt$ using N external time 
+steps of length $\rdt_e$. Time averaging the external fields over the 
+$\frac{2}{3}N+1$ time steps (endpoints included) centers the vertically integrated 
+velocity and the sea surface height at the model timestep $t+\rdt$. 
+These averaged values are used to update \textbf{M}(t) with both the surface 
+pressure gradient and the Coriolis force, therefore providing the $t+\rdt$
+velocity.  The model time stepping scheme can then be achieved by a baroclinic 
+leap-frog time step that carries the surface height from $t-\rdt$ to $t+\rdt$.  }
+\end{center}    \end{figure}
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+
+The split-explicit formulation has a damping effect on external gravity waves, 
+which is weaker damping than that for the filtered free surface but 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} 
+%-------------------------------------------------------------------------------------------------------------
+
+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{DOM_nxt}) 
+
+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}).
+
+% ================================================================
+\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} 
+%-------------------------------------------------------------------------------------------------------------
+
+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{DOM_nxt}). 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, two other forcings 
+enter the dynamical equations. 
+
+One is the effect of atmospheric pressure on the ocean dynamics.
+Another forcing term is the tidal potential.
+Both of which will be introduced into the reference version soon. 
+
+\gmcomment{atmospheric pressure is there!!!!    include its description }
+
+% ================================================================
+% Time evolution term 
+% ================================================================
+\section  [Time evolution term (\textit{dynnxt})]
+		{Time evolution term (\mdl{dynnxt})}
+\label{DYN_nxt}
+
+%----------------------------------------------namdom----------------------------------------------------
+\namdisplay{namdom} 
+%-------------------------------------------------------------------------------------------------------------
+
+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}.
+
+% ================================================================
+% Neptune effect 
+% ================================================================
+\section  [Neptune effect (\textit{dynnept})]
+                {Neptune effect (\mdl{dynnept})}
+\label{DYN_nept}
+
+The "Neptune effect" (thus named in \citep{HollowayOM86}) is a
+parameterisation of the potentially large effect of topographic form stress
+(caused by eddies) in driving the ocean circulation. Originally developed for
+low-resolution models, in which it was applied via a Laplacian (second-order)
+diffusion-like term in the momentum equation, it can also be applied in eddy
+permitting or resolving models, in which a more scale-selective bilaplacian
+(fourth-order) implementation is preferred. This mechanism has a
+significant effect on boundary currents (including undercurrents), and the
+upwelling of deep water near continental shelves.
+
+The theoretical basis for the method can be found in 
+\citep{HollowayJPO92}, including the explanation of why form stress is not
+necessarily a drag force, but may actually drive the flow. 
+\citep{HollowayJPO94} demonstrate the effects of the parameterisation in
+the GFDL-MOM model, at a horizontal resolution of about 1.8 degrees. 
+\citep{HollowayOM08} demonstrate the biharmonic version of the
+parameterisation in a global run of the POP model, with an average horizontal
+grid spacing of about 32km.
+
+The NEMO implementation is a simplified form of that supplied by
+Greg Holloway, the testing of which was described in \citep{HollowayJGR09}.
+The major simplification is that a time invariant Neptune velocity
+field is assumed.  This is computed only once, during start-up, and
+made available to the rest of the code via a module.  Vertical
+diffusive terms are also ignored, and the model topography itself
+is used, rather than a separate topographic dataset as in
+\citep{HollowayOM08}.  This implementation is only in the iso-level
+formulation, as is the case anyway for the bilaplacian operator.
+
+The velocity field is derived from a transport stream function given by:
+
+\begin{equation} \label{Eq_dynnept_sf}
+\psi = -fL^2H
+\end{equation}
+
+where $L$ is a latitude-dependant length scale given by:
+
+\begin{equation} \label{Eq_dynnept_ls}
+L = l_1 + (l_2 -l_1)\left ( {1 + \cos 2\phi \over 2 } \right )
+\end{equation}
+
+where $\phi$ is latitude and $l_1$ and $l_2$ are polar and equatorial length scales respectively.
+Neptune velocity components, $u^*$, $v^*$ are derived from the stremfunction as:
+
+\begin{equation} \label{Eq_dynnept_vel}
+u^* = -{1\over H} {\partial \psi \over \partial y}\ \ \  ,\ \ \ v^* = {1\over H} {\partial \psi \over \partial x}
+\end{equation}
+
+\smallskip
+%----------------------------------------------namdom----------------------------------------------------
+\namdisplay{namdyn_nept}
+%--------------------------------------------------------------------------------------------------------
+\smallskip
+
+The Neptune effect is enabled when \np{ln\_neptsimp}=true (default=false).
+\np{ln\_smooth\_neptvel} controls whether a scale-selective smoothing is applied
+to the Neptune effect flow field (default=false) (this smoothing method is as
+used by Holloway).  \np{rn\_tslse} and \np{rn\_tslsp} are the equatorial and
+polar values respectively of the length-scale parameter $L$ used in determining
+the Neptune stream function \eqref{Eq_dynnept_sf} and \eqref{Eq_dynnept_ls}.
+Values at intermediate latitudes are given by a cosine fit, mimicking the
+variation of the deformation radius with latitude.  The default values of 12km
+and 3km are those given in \citep{HollowayJPO94}, appropriate for a coarse
+resolution model. The finer resolution study of \citep{HollowayOM08} increased
+the values of L by a factor of $\sqrt 2$ to 17km and 4.2km, thus doubling the
+stream function for a given topography.
+
+The simple formulation for ($u^*$, $v^*$) can give unacceptably large velocities
+in shallow water, and \citep{HollowayOM08} add an offset to the depth in the
+denominator to control this problem. In this implementation we offer instead (at
+the suggestion of G. Madec) the option of ramping down the Neptune flow field to
+zero over a finite depth range. The switch \np{ln\_neptramp} activates this
+option (default=false), in which case velocities at depths greater than
+\np{rn\_htrmax} are unaltered, but ramp down linearly with depth to zero at a
+depth of \np{rn\_htrmin} (and shallower).
+
+% ================================================================
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LBC.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LBC.tex	(revision 3437)
@@ -0,0 +1,1030 @@
+% ================================================================
+% 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}.
+
+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]{./TexFiles/Figures/Fig_LBC_uv.pdf}
+\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]{./TexFiles/Figures/Fig_LBC_shlat.pdf}
+\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.
+
+The alternative numerical implementation of the no-slip boundary conditions for an 
+arbitrary coast line of \citet{Shchepetkin1996} is also available through the 
+\key{noslip\_accurate} CPP key. It is based on a fourth order evaluation of the shear at the 
+coast which, in turn, allows a true second order scheme in the interior of the domain 
+($i.e.$ the numerical boundary scheme simulates the truncation error of the numerical 
+scheme used in the interior of the domain). \citet{Shchepetkin1996} found that such a 
+technique considerably improves the quality of the numerical solution. In \NEMO, such 
+spectacular improvements have not been found in the half-degree global ocean 
+(ORCA05), but significant reductions of numerically induced coastal upwellings were 
+found in an eddy resolving simulation of the Alboran Sea \citep{Olivier_PhD01}. 
+Nevertheless, since a no-slip boundary condition is not recommended in an eddy 
+permitting or resolving simulation \citep{Penduff_al_OS07}, the use of this option is also 
+not recommended.
+
+In practice, the no-slip accurate option changes the way the curl is evaluated at the 
+coast (see \mdl{divcur} module), and requires the nature of each coastline grid point 
+(convex or concave corners, straight north-south or east-west coast) to be specified.  
+This is performed in routine \rou{dom\_msk\_nsa} in the \mdl{domask} module.
+
+% ================================================================
+% Boundary Condition around the Model Domain
+% ================================================================
+\section{Model Domain Boundary Condition (\jp{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 (\jp{jperio} = 0, 1 or 2) 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Closed, cyclic, south symmetric (\jp{jperio} = 0, 1 or 2)}
+\label{LBC_jperio012}
+
+The choice of closed, cyclic or symmetric model domain boundary condition is made 
+by setting \jp{jperio} to 0, 1 or 2 in file \mdl{par\_oce}. 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]{./TexFiles/Figures/Fig_LBC_jperio.pdf}
+\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. 
+\colorbox{yellow}{to be completed...}
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_North_Fold_T.pdf}
+\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, 1.5 
+turbulent closure scheme, ...) (delocalization over the whole water column), 
+and the solving of the elliptic equation associated with the surface pressure 
+gradient computation (delocalization over the whole horizontal domain). 
+Therefore, a pencil strategy is used for the data sub-structuration 
+\gmcomment{no idea what this means!}
+: the 3D initial domain is laid out on local processor 
+memories following a 2D horizontal topological splitting. Each sub-domain 
+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 message passing. Usually the parallel virtual 
+language, PVM, is used as it is a standard language available on  nearly  all 
+MPP computers. More specific languages (i.e. computer dependant languages) 
+can be easily used to speed up the communication, such as SHEM on a T3E 
+computer. The data exchanges between processors are required at the very 
+place where lateral domain boundary conditions are set in the mono-domain 
+computation (\S III.10-c): the lbc\_lnk routine which manages such conditions 
+is substituted by mpplnk.F or mpplnk2.F routine when running on an MPP 
+computer (\key{mpp\_mpi} defined). It has to be pointed out that when using 
+the MPP version of the model, the east-west cyclic boundary condition is done 
+implicitly, whilst the south-symmetric boundary condition option is not available.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]    \begin{center}
+\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_mpp.pdf}
+\caption{   \label{Fig_mpp} 
+Positioning of a sub-domain when massively parallel processing is used. }
+\end{center}   \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+In the standard version of the OPA model, the splitting is regular and arithmetic.
+ the i-axis is divided by \jp{jpni} and the j-axis by \jp{jpnj} for a number of processors 
+ \jp{jpnij} most often equal to $jpni \times jpnj$ (model parameters set in 
+ \mdl{par\_oce}). Each processor is independent and without message passing 
+ or synchronous process 
+ \gmcomment{how does a synchronous process relate to this?}, 
+ programs run alone and access just its own local memory. For this reason, the 
+ main model dimensions are now the local dimensions of the subdomain (pencil) 
+ 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 \jp{jpiglo}, \jp{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.
+
+\colorbox{yellow}{Figure IV.3: example of a domain splitting with 9 processors and 
+no east-west cyclic boundary conditions.}
+
+One also defines variables nldi and nlei which correspond to the internal 
+domain bounds, and the variables nimpp and njmpp which are the position 
+of the (1,1) grid-point in the global domain. An element of $T_{l}$, a local array 
+(subdomain) corresponds to an element of $T_{g}$, a global array 
+(whole domain) by the relationship: 
+\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 
+\colorbox{yellow}{(see Fig.IV.3)}:
+\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.
+		 
+\colorbox{yellow}{Figure IV.4: pencil splitting with the additional outer halos }
+
+
+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. 
+(For example, the mpp\_optimiz tools, available from the DRAKKAR web site.) 
+This optimisation is dependent on the specific bathymetry employed. The user 
+then chooses optimal parameters \jp{jpni}, \jp{jpnj} and \jp{jpnij} with 
+$jpnij < jpni \times jpnj$, leading to the elimination of $jpni \times jpnj - jpnij$ 
+land processors. When those parameters are specified in module \mdl{par\_oce}, 
+the algorithm in the \rou{inimpp2} routine sets each processor's parameters (nbound, 
+nono, noea,...) so that the land-only processors are not taken into account. 
+
+\colorbox{yellow}{Note that the inimpp2 routine is general so that the original inimpp 
+routine should be suppressed from the code.}
+
+When land processors are eliminated, the value corresponding to these locations in 
+the model output files is zero. Note that this is a problem for a mesh output file written 
+by such a model configuration, because model users often divide by the scale factors 
+($e1t$, $e2t$, etc) and do not expect the grid size to be zero, even on land. It may be 
+best not to eliminate land processors when running the model especially to write the 
+mesh files as outputs (when \np{nn\_msh} namelist parameter differs from 0).
+%%
+\gmcomment{Steven : dont understand this, no land processor means no output file 
+covering this part of globe; its only when files are stitched together into one that you 
+can leave a hole}
+%%
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht]     \begin{center}
+\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_mppini2.pdf}
+\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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ================================================================
+% Open Boundary Conditions 
+% ================================================================
+\section{Open Boundary Conditions (\key{obc}) (OBC)}
+\label{LBC_obc}
+%-----------------------------------------nam_obc  -------------------------------------------
+%-    nobc_dta    =    0     !  = 0 the obc data are equal to the initial state
+%-                           !  = 1 the obc data are read in 'obc   .dta' files
+%-    rn_dpein      =    1.    !  ???
+%-    rn_dpwin      =    1.    !  ???
+%-    rn_dpnin      =   30.    !  ???
+%-    rn_dpsin      =    1.    !  ???
+%-    rn_dpeob      = 1500.    !  time relaxation (days) for the east  open boundary
+%-    rn_dpwob      =   15.    !    "        "           for the west  open boundary
+%-    rn_dpnob      =  150.    !    "        "           for the north open boundary
+%-    rn_dpsob      =   15.    !    "        "           for the south open boundary
+%-    ln_obc_clim = .true.   !  climatological obc data files (default T)
+%-    ln_vol_cst  = .true.   !  total volume conserved
+\namdisplay{namobc} 
+
+It is often necessary to implement a model configuration limited to an oceanic 
+region or a basin, which communicates with the rest of the global ocean through 
+''open boundaries''. As stated by \citet{Roed1986}, an open boundary is a 
+computational border where the aim of the calculations is to allow the perturbations 
+generated inside the computational domain to leave it without deterioration of the 
+inner model solution. However, an open boundary also has to let information from 
+the outer ocean enter the model and should support inflow and outflow conditions. 
+
+The open boundary package OBC is the first open boundary option developed in 
+NEMO (originally in OPA8.2). It allows the user to 
+\begin{itemize}
+\item tell the model that a boundary is ''open'' and not closed by a wall, for example 
+by modifying the calculation of the divergence of velocity there;
+\item impose values of tracers and velocities at that boundary (values which may 
+be taken from a climatology): this is the``fixed OBC'' option. 
+\item calculate boundary values by a sophisticated algorithm combining radiation 
+and relaxation (``radiative OBC'' option)
+\end{itemize}
+
+The package resides in the OBC directory. It is described here in four parts: the 
+boundary geometry (parameters to be set in \mdl{obc\_par}), the forcing data at 
+the boundaries (module \mdl{obcdta}),  the radiation algorithm involving the 
+namelist and module \mdl{obcrad}, and a brief presentation of boundary update 
+and restart files.
+
+%----------------------------------------------
+\subsection{Boundary geometry}
+\label{OBC_geom}
+%
+First one has to realize that open boundaries may not necessarily be located 
+at the extremities of the computational domain. They may exist in the middle 
+of the domain, for example at Gibraltar Straits if one wants to avoid including 
+the Mediterranean in an Atlantic domain. This flexibility has been found necessary 
+for the CLIPPER project \citep{Treguier_al_JGR01}. Because of the complexity of the 
+geometry of ocean basins, it may even be necessary to have more than one 
+''west'' open boundary, more than one ''north'', etc. This is not possible with 
+the OBC option: only one open boundary of each kind, west, east, south and 
+north is allowed; these names refer to the grid geometry (not to the direction 
+of the geographical ''west'', ''east'', etc).
+
+The open boundary geometry is set by a series of parameters in the module 
+\mdl{obc\_par}. For an eastern open boundary, parameters are \jp{lp\_obc\_east} 
+(true if an east open boundary exists), \jp{jpieob} the $i$-index along which 
+the eastern open boundary (eob) is located, \jp{jpjed} the $j$-index at which 
+it starts, and \jp{jpjef} the $j$-index where it ends (note $d$ is for ''d\'{e}but'' 
+and $f$ for ''fin'' in French). Similar parameters exist for the west, south and 
+north cases (Table~\ref{Tab_obc_param}).
+
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]     \begin{center}    \begin{tabular}{|l|c|c|c|}
+\hline
+Boundary and  & Constant index  & Starting index (d\'{e}but) & Ending index (fin) \\
+Logical flag  &                 &                            &                     \\
+\hline
+West          & \jp{jpiwob} $>= 2$         &  \jp{jpjwd}$>= 2$          &  \jp{jpjwf}<= \jp{jpjglo}-1 \\
+lp\_obc\_west & $i$-index of a $u$ point   & $j$ of a $T$ point   &$j$ of a $T$ point \\
+\hline
+East            & \jp{jpieob}$<=$\jp{jpiglo}-2&\jp{jpjed} $>= 2$         & \jp{jpjef}$<=$ \jp{jpjglo}-1 \\
+ lp\_obc\_east  & $i$-index of a $u$ point    & $j$ of a $T$ point & $j$ of a $T$ point \\
+\hline
+South           & \jp{jpjsob} $>= 2$         & \jp{jpisd} $>= 2$          & \jp{jpisf}$<=$\jp{jpiglo}-1 \\
+lp\_obc\_south  & $j$-index of a $v$ point   & $i$ of a $T$ point   & $i$ of a $T$ point \\
+\hline
+North           & \jp{jpjnob} $<=$ \jp{jpjglo}-2& \jp{jpind} $>= 2$        & \jp{jpinf}$<=$\jp{jpiglo}-1 \\
+lp\_obc\_north  & $j$-index of a $v$ point      & $i$  of a $T$ point & $i$ of a $T$ point \\
+\hline
+\end{tabular}    \end{center}
+\caption{     \label{Tab_obc_param}
+Names of different indices relating to the open boundaries. In the case 
+of a completely open ocean domain with four ocean boundaries, the parameters 
+take exactly the values indicated.}
+\end{table}
+%------------------------------------------------------------------------------------------------------------
+
+The open boundaries must be along coordinate lines. On the C-grid, the boundary 
+itself is along a line of normal velocity points: $v$ points for a zonal open boundary 
+(the south or north one), and $u$ points for a meridional open boundary (the west 
+or east one). Another constraint is that there still must be a row of masked points 
+all around the domain, as if the domain were a closed basin (unless periodic conditions 
+are used together with open boundary conditions). Therefore, an open boundary 
+cannot be located at the first/last index, namely, 1, \jp{jpiglo} or \jp{jpjglo}. Also, 
+the open boundary algorithm involves calculating the normal velocity points situated 
+just on the boundary, as well as the tangential velocity and temperature and salinity 
+just outside the boundary. This means that for a west/south boundary, normal 
+velocities and temperature are calculated at the same index \jp{jpiwob} and 
+\jp{jpjsob}, respectively. For an east/north boundary, the normal velocity is 
+calculated at index \jp{jpieob} and \jp{jpjnob}, but the ``outside'' temperature is 
+at index \jp{jpieob}+1 and \jp{jpjnob}+1. This means that \jp{jpieob}, \jp{jpjnob} 
+cannot be bigger than \jp{jpiglo}-2, \jp{jpjglo}-2. 
+
+
+The starting and ending indices are to be thought of as $T$ point indices: in many 
+cases they indicate the first land $T$-point, at the extremity of an open boundary 
+(the coast line follows the $f$ grid points, see Fig.~\ref{Fig_obc_north} for an example 
+of a northern open boundary). All indices are relative to the global domain. In the 
+free surface case it is possible to have ``ocean corners'', that is, an open boundary 
+starting and ending in the ocean.
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t]     \begin{center}
+\includegraphics[width=0.70\textwidth]{./TexFiles/Figures/Fig_obc_north.pdf}
+\caption{    \label{Fig_obc_north}
+Localization of the North open boundary points.}
+\end{center}     \end{figure}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+Although not compulsory, it is highly recommended that the bathymetry in the 
+vicinity of an open boundary follows the following rule: in the direction perpendicular 
+to the open line, the water depth should be constant for 4 grid points. This is in 
+order to ensure that the radiation condition, which involves model variables next 
+to the boundary, is calculated in a consistent way. On Fig.\ref{Fig_obc_north} we 
+indicate by an $=$ symbol, the points which should have the same depth. It means 
+that at the 4 points near the boundary, the bathymetry is cylindrical \gmcomment{not sure 
+why cylindrical}. The line behind the open $T$-line must be 0 in the bathymetry file 
+(as shown on Fig.\ref{Fig_obc_north} for example).
+
+%----------------------------------------------
+\subsection{Boundary data}
+\label{OBC_data}
+
+It is necessary to provide information at the boundaries. The simplest case is 
+when this information does not change in time and is equal to the initial conditions 
+(namelist variable \np{nn\_obcdta}=0). This is the case for the standard configuration 
+EEL5 with open boundaries. When (\np{nn\_obcdta}=1), open boundary information 
+is read from netcdf files. For convenience the input files are supposed to be similar 
+to the ''history'' NEMO output files, for dimension names and variable names. 
+Open boundary arrays must be dimensioned according to the parameters of table~
+\ref{Tab_obc_param}: for example, at the western boundary, arrays have a 
+dimension of \jp{jpwf}-\jp{jpwd}+1 in the horizontal and \jp{jpk} in the vertical. 
+
+When ocean observations are used to generate the boundary data (a hydrographic 
+section for example, as in \citet{Treguier_al_JGR01}) it happens often that only the velocity 
+normal to the boundary is known, which is the reason why the initial OBC code 
+assumes that only $T$, $S$, and the normal velocity ($u$ or $v$) needs to be 
+specified. As more and more global model solutions and ocean analysis products 
+become available, it will be possible to provide information about all the variables 
+(including the tangential velocity) so that the specification of four variables at each 
+boundaries will become standard. For the sea surface height, one must distinguish 
+between the filtered free surface case and the time-splitting or explicit treatment of 
+the free surface.
+ In the first case, it is assumed that the user does not wish to represent high 
+ frequency motions such as tides. The boundary condition is thus one of zero 
+ normal gradient of sea surface height at the open boundaries, following \citet{Marchesiello2001}. 
+No information other than the total velocity needs to be provided at the open 
+boundaries in that case. In the other two cases (time splitting or explicit free surface), 
+the user must provide barotropic information (sea surface height and barotropic 
+velocities) and the use of the Flather algorithm for barotropic variables is 
+recommanded. However, this algorithm has not yet been fully tested and bugs 
+remain in NEMO v2.3. Users should read the code carefully before using it. Finally, 
+in the case of the rigid lid approximation the barotropic streamfunction must be 
+provided, as documented in \citet{Treguier_al_JGR01}). This option is no longer 
+recommended but remains in NEMO V2.3.
+
+One frequently encountered case is when an open boundary domain is constructed 
+from a global or larger scale NEMO configuration. Assuming the domain corresponds 
+to indices $ib:ie$, $jb:je$ of the global domain, the bathymetry and forcing of the 
+small domain can be created by using the following netcdf utility on the global files: 
+ncks -F $-d\;x,ib,ie$ $-d\;y,jb,je$ (part of the nco series of utilities, 
+see their \href{http://nco.sourceforge.net}{website}). 
+The open boundary files can be constructed using ncks 
+commands, following table~\ref{Tab_obc_ind}. 
+
+%--------------------------------------------------TABLE--------------------------------------------------
+\begin{table}[htbp]     \begin{center}      \begin{tabular}{|l|c|c|c|c|c|}
+\hline
+OBC  & Variable   & file name      & Index  & Start  & end  \\
+West &  T,S       &   obcwest\_TS.nc &  $ib$+1     &   $jb$+1 &  $je-1$  \\
+     &    U       &   obcwest\_U.nc  &  $ib$+1     &   $jb$+1 &  $je-1$  \\ 
+     &    V       &   obcwest\_V.nc  &  $ib$+1     &   $jb$+1 &  $je-1$  \\       
+\hline
+East &  T,S       &   obceast\_TS.nc &  $ie$-1     &   $jb$+1 &  $je-1$  \\
+     &    U       &   obceast\_U.nc  &  $ie$-2     &   $jb$+1 &  $je-1$  \\ 
+     &    V       &   obceast\_V.nc  &  $ie$-1     &   $jb$+1 &  $je-1$  \\       
+\hline         
+South &  T,S      &   obcsouth\_TS.nc &  $jb$+1     &  $ib$+1 &  $ie-1$  \\
+      &    U      &   obcsouth\_U.nc  &  $jb$+1     &  $ib$+1 &  $ie-1$  \\ 
+      &    V      &   obcsouth\_V.nc  &  $jb$+1     &  $ib$+1 &  $ie-1$  \\    
+\hline
+North &  T,S      &   obcnorth\_TS.nc &  $je$-1     &  $ib$+1 &  $ie-1$  \\
+      &    U      &   obcnorth\_U.nc  &  $je$-1     &  $ib$+1 &  $ie-1$  \\ 
+      &    V      &   obcnorth\_V.nc  &  $je$-2     &  $ib$+1 &  $ie-1$  \\  
+\hline
+\end{tabular}     \end{center}
+\caption{    \label{Tab_obc_ind}
+Requirements for creating open boundary files from a global configuration, 
+appropriate for the subdomain of indices $ib:ie$, $jb:je$. ``Index'' designates the 
+$i$ or $j$ index along which the $u$ of $v$ boundary point is situated in the global 
+configuration, starting and ending with the $j$ or $i$ indices indicated. 
+For example, to generate file obcnorth\_V.nc, use the command ncks 
+$-F$ $-d\;y,je-2$  $-d\;x,ib+1,ie-1$ } 
+\end{table}
+%-----------------------------------------------------------------------------------------------------------
+
+It is assumed that the open boundary files contain the variables for the period of 
+the model integration. If the boundary files contain one time frame, the boundary 
+data is held fixed in time. If the files contain 12 values, it is assumed that the input 
+is a climatology for a repeated annual cycle (corresponding to the case \np{ln\_obc\_clim} 
+=true). The case of an arbitrary number of time frames is not yet implemented 
+correctly; the user is required to write his own code in the module \mdl{obc\_dta} 
+to deal with this situation. 
+
+\subsection{Radiation algorithm}
+\label{OBC_rad}
+
+The art of open boundary management consists in applying a constraint strong 
+enough that the inner domain "feels" the rest of the ocean, but weak enough
+that perturbations are allowed to leave the domain with minimum false reflections 
+of energy. The constraints are specified separately at each boundary as time 
+scales for ''inflow'' and ''outflow'' as defined below. The time scales are set (in days) 
+by namelist parameters such as \np{rn\_dpein}, \np{rn\_dpeob} for the eastern open 
+boundary for example. When both time scales are zero for a given boundary 
+($e.g.$ for the western boundary, \jp{lp\_obc\_west}=true, \np{rn\_dpwob}=0 and 
+\np{rn\_dpwin}=0) this means that the boundary in question is a ''fixed '' boundary 
+where the solution is set exactly by the boundary data. This is not recommended, 
+except in combination with increased viscosity in a ''sponge'' layer next to the 
+boundary in order to avoid spurious reflections.  
+
+
+The radiation\/relaxation \gmcomment{the / doesnt seem to appear in the output} 
+algorithm is applied when either relaxation time (for ''inflow'' or ''outflow'') is 
+non-zero. It has been developed and tested in the SPEM model and its 
+successor ROMS \citep{Barnier1996, Marchesiello2001}, which is an 
+$s$-coordinate model on an Arakawa C-grid. Although the algorithm has 
+been numerically successful in the CLIPPER Atlantic models, the physics 
+do not work as expected \citep{Treguier_al_JGR01}. Users are invited to consider 
+open boundary conditions (OBC hereafter) with some scepticism 
+\citep{Durran2001, Blayo2005}.
+
+The first part of the algorithm calculates a phase velocity to determine 
+whether perturbations tend to propagate toward, or away from, the 
+boundary. Let us consider a model variable $\phi$. 
+The phase velocities ($C_{\phi x}$,$C_{\phi y}$) for the variable $\phi$, 
+in the directions normal and tangential to the boundary are
+\begin{equation} \label{Eq_obc_cphi}
+C_{\phi x} = \frac{ -\phi_{t} }{ ( \phi_{x}^{2} + \phi_{y}^{2}) } \phi_{x} 
+\;\;\;\;\; \;\;\; 
+C_{\phi y} = \frac{ -\phi_{t} }{ ( \phi_{x}^{2} + \phi_{y}^{2}) } \phi_{y}. 
+\end{equation}
+Following \citet{Treguier_al_JGR01} and \citet{Marchesiello2001} we retain only 
+the normal component of the velocity, $C_{\phi x}$, setting $C_{\phi y} =0$ 
+(but unlike the original Orlanski radiation algorithm we retain $\phi_{y}$ in 
+the expression for $C_{\phi x}$).  
+
+The discrete form of (\ref{Eq_obc_cphi}), described by \citet{Barnier1998},
+takes into account the two rows of grid points situated inside the domain 
+next to the boundary, and the three previous time steps ($n$, $n-1$,
+and $n-2$). The same equation can then be discretized at the boundary at
+time steps $n-1$, $n$ and $n+1$ \gmcomment{since the original was three time-level} 
+in order to extrapolate for the new boundary value $\phi^{n+1}$. 
+
+In the open boundary algorithm as implemented in NEMO v2.3, the new boundary 
+values are updated differently depending on the sign of $C_{\phi x}$. Let us take 
+an eastern boundary as an example. The solution for variable $\phi$ at the 
+boundary is given by a generalized wave equation with phase velocity $C_{\phi}$, 
+with the addition of a relaxation term, as:
+\begin{eqnarray}
+\phi_{t} &  =  & -C_{\phi x} \phi_{x} + \frac{1}{\tau_{o}} (\phi_{c}-\phi) 
+                        \;\;\; \;\;\; \;\;\; (C_{\phi x} > 0), \label{Eq_obc_rado} \\
+\phi_{t} &  =  & \frac{1}{\tau_{i}} (\phi_{c}-\phi) 
+\;\;\; \;\;\; \;\;\;\;\;\; (C_{\phi x} < 0), \label{Eq_obc_radi}
+\end{eqnarray}
+where $\phi_{c}$ is the estimate of $\phi$ at the boundary, provided as boundary 
+data. Note that in (\ref{Eq_obc_rado}), $C_{\phi x}$ is bounded by the ratio 
+$\delta x/\delta t$ for stability reasons. When $C_{\phi x}$ is eastward (outward 
+propagation), the radiation condition (\ref{Eq_obc_rado}) is used. 
+When  $C_{\phi x}$ is westward (inward propagation), (\ref{Eq_obc_radi}) is 
+used with a strong relaxation to climatology (usually $\tau_{i}=\np{rn\_dpein}=$1~day).
+Equation (\ref{Eq_obc_radi}) is solved with a Euler time-stepping scheme. As a 
+consequence, setting $\tau_{i}$ smaller than, or equal to the time step is equivalent 
+to a fixed boundary condition. A time scale of one day is usually a good compromise 
+which guarantees that the inflow conditions remain close to climatology while ensuring 
+numerical stability. 
+
+In  the case of a western boundary located in the Eastern Atlantic, \citet{Penduff_al_JGR00} 
+have been able to implement the radiation algorithm without any boundary data, 
+using persistence from the previous time step instead. This solution has not worked 
+in other cases \citep{Treguier_al_JGR01}, so that the use of boundary data is recommended. 
+Even in the outflow condition (\ref{Eq_obc_rado}), we have found it desirable to 
+maintain a weak relaxation to climatology. The time step is usually chosen so as to 
+be larger than typical turbulent scales (of order 1000~days \gmcomment{or maybe seconds?}).
+
+The radiation condition is applied to the model variables: temperature, salinity, 
+tangential and normal velocities. For normal and tangential velocities, $u$ and $v$, 
+radiation is applied with phase velocities calculated from $u$ and $v$ respectively.  
+For the radiation of tracers, we use the phase velocity calculated from the tangential 
+velocity in order to avoid calculating too many independent radiation velocities and 
+because tangential velocities and tracers have the same position along the boundary 
+on a C-grid.  
+
+\subsection{Domain decomposition (\key{mpp\_mpi})}
+\label{OBC_mpp}
+When \key{mpp\_mpi} is active in the code, the computational domain is divided 
+into rectangles that are attributed each to a different processor. The open boundary 
+code is ``mpp-compatible'' up to a certain point. The radiation algorithm will not 
+work if there is an mpp subdomain boundary parallel to the open boundary at the 
+index of the boundary, or the grid point after (outside), or three grid points before 
+(inside). On the other hand, there is no problem if an mpp subdomain boundary 
+cuts the open boundary perpendicularly. These geometrical limitations must be 
+checked for by the user (there is no safeguard in the code).  
+The general principle for the open boundary mpp code is that loops over the open 
+boundaries {not sure what this means} are performed on local indices (nie0, 
+nie1, nje0, nje1 for an eastern boundary for instance) that are initialized in module 
+\mdl{obc\_ini}. Those indices have relevant values on the processors that contain 
+a segment of an open boundary. For processors that do not include an open 
+boundary segment, the indices are such that the calculations within the loops are 
+not performed.
+\gmcomment{I dont understand most of the last few sentences}
+ 
+Arrays of climatological data that are read from files are seen by all processors 
+and have the same dimensions for all (for instance, for the eastern boundary, 
+uedta(jpjglo,jpk,2)). On the other hand, the arrays for the calculation of radiation 
+are local to each processor (uebnd(jpj,jpk,3,3) for instance).  This allowed the 
+CLIPPER model for example, to save on memory where the eastern boundary 
+crossed 8 processors so that \jp{jpj} was much smaller than (\jp{jpjef}-\jp{jpjed}+1). 
+
+\subsection{Volume conservation}
+\label{OBC_vol}
+
+It is necessary to control the volume inside a domain when using open boundaries. 
+With fixed boundaries, it is enough to ensure that the total inflow/outflow has 
+reasonable values (either zero or a value compatible with an observed volume 
+balance). When using radiative boundary conditions it is necessary to have a 
+volume constraint because each open boundary works independently from the 
+others. The methodology used to control this volume is identical to the one 
+coded in the ROMS model \citep{Marchesiello2001}.
+
+
+%---------------------------------------- EXTRAS
+\colorbox{yellow}{Explain obc\_vol{\ldots}}
+
+\colorbox{yellow}{OBC algorithm for update, OBC restart, list of routines where obc key appears{\ldots}}
+
+\colorbox{yellow}{OBC rigid lid? {\ldots}}
+
+% ====================================================================
+% Unstructured open boundaries BDY 
+% ====================================================================
+\section{Unstructured Open Boundary Conditions (\key{bdy}) (BDY)}
+\label{LBC_bdy}
+
+%-----------------------------------------nambdy--------------------------------------------
+\namdisplay{nambdy} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_index--------------------------------------------
+\namdisplay{nambdy_index} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_dta--------------------------------------------
+\namdisplay{nambdy_dta} 
+%-----------------------------------------------------------------------------------------------
+%-----------------------------------------nambdy_dta--------------------------------------------
+\namdisplay{nambdy_dta2} 
+%-----------------------------------------------------------------------------------------------
+
+The BDY module is an alternative 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 and shares many features
+and a similar coding structure \citep{Chanut2005}.
+
+The BDY module is completely rewritten at NEMO 3.4 and there is a new
+set of namelists. 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}
+
+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]{./TexFiles/Figures/Fig_LBC_bdy_geom.pdf}
+\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]{./TexFiles/Figures/Fig_LBC_nc_header.pdf}
+\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} 
+%-----------------------------------------------------------------------------------------------
+
+To be written....
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LDF.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_LDF.tex	(revision 3437)
@@ -0,0 +1,474 @@
+
+% ================================================================
+% 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 space 
+and time variations of the eddy coefficients ; (2) the direction along which the 
+lateral diffusive fluxes are evaluated (model level, geopotential or isopycnal 
+surfaces); and (3) the type of operator used (harmonic, or biharmonic operators, 
+and for tracers only, eddy induced advection on tracers). These three aspects 
+of the lateral diffusion are set through namelist parameters and CPP keys 
+(see the \textit{nam\_traldf} and \textit{nam\_dynldf} below). Note
+that this chapter describes the default 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} 
+%--------------------------------------------------------------------------------------------------------------
+
+
+% ================================================================
+% 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 (\key{orca\_r2}), 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 (\key{antarctic} or \key{arctic} 
+defined, see \hf{ldfdyn\_antarctic} and \hf{ldfdyn\_arctic}).
+
+\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 (\key{orca\_r2} or \key{orca\_r05}). 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.
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_LDF_ZDF1.pdf}
+\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]{./TexFiles/Figures/Fig_eiv_slp.pdf}
+\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}).
+
+
+% ================================================================
+% Eddy Induced Mixing
+% ================================================================
+\section  [Eddy Induced Velocity (\textit{traadv\_eiv}, \textit{ldfeiv})]
+		{Eddy Induced Velocity (\mdl{traadv\_eiv}, \mdl{ldfeiv})}
+\label{LDF_eiv}
+
+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. 
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_MISC.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_MISC.tex	(revision 3437)
@@ -0,0 +1,574 @@
+% ================================================================
+% 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 (search for 
+\key{orca\_r2} or \key{orca\_r05} in the code).
+
+% -------------------------------------------------------------------------------------------------------------
+%       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]{./TexFiles/Figures/Fig_Gibraltar.pdf}
+\includegraphics[width=0.80\textwidth]{./TexFiles/Figures/Fig_Gibraltar2.pdf}
+\caption{	\label{Fig_MISC_strait_hand} 
+Example of the Gibraltar strait defined in a $1\deg \times 1\deg$ 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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+% -------------------------------------------------------------------------------------------------------------
+% Cross Land Advection 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Cross Land Advection (\mdl{tracla})}
+\label{MISC_strait_cla}
+%--------------------------------------------namcla--------------------------------------------------------
+\namdisplay{namcla} 
+%--------------------------------------------------------------------------------------------------------------
+
+\colorbox{yellow}{Add a short description of CLA staff here or in lateral boundary condition chapter?}
+
+%The problem is resolved here by allowing the mixing of tracers and mass/volume between non-adjacent water columns at nominated regions within the model. Momentum is not mixed. The scheme conserves total tracer content, and total volume (the latter in $z*$- or $s*$-coordinate), and maintains compatibility between the tracer and mass/volume budgets.  
+
+% ================================================================
+% 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 (\jp{jpizoom}, \jp{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 \jp{jpidta}, \jp{jpjdta} and \jp{jpkdta} 
+(\mdl{par\_oce} module), while the computational domain is defined through 
+\jp{jpiglo}, \jp{jpjglo} and \jp{jpk} (\mdl{par\_oce} module). When running the 
+model over the whole domain, the user sets \jp{jpiglo}=\jp{jpidta} \jp{jpjglo}=\jp{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, (\jp{jpiglo}, \jp{jpjglo}, \jp{jpkglo}), 
+and the indices of the south western corner as \jp{jpizoom} and \jp{jpjzoom} in 
+the \mdl{par\_oce} module (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}=\jp{jpjglo} 
+and \jp{jpj}=\jp{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
+
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!ht] 	  \begin{center}
+\includegraphics[width=0.90\textwidth]{./TexFiles/Figures/Fig_LBC_zoom.pdf}
+\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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+% ================================================================
+% Accelerating the Convergence 
+% ================================================================
+\section{Accelerating the Convergence (\np{nn\_acc} = 1)}
+\label{MISC_acc}
+%--------------------------------------------namdom-------------------------------------------------------
+\namdisplay{namdom} 
+%--------------------------------------------------------------------------------------------------------------
+
+Searching an equilibrium state with an global ocean model requires a very long time 
+integration period (a few thousand years for a global model). Due to the size of 
+the time step required for numerical stability (less than a few hours), 
+this usually requires a large elapsed time. In order to overcome this problem, 
+\citet{Bryan1984} introduces a technique that is intended to accelerate 
+the spin up to equilibrium. It uses a larger time step in 
+the tracer evolution equations than in the momentum evolution 
+equations. It does not affect the equilibrium solution but modifies the 
+trajectory to reach it.
+
+The acceleration of convergence option is used when \np{nn\_acc}=1. In that case, 
+$\rdt=rn\_rdt$ is the time step of dynamics while $\widetilde{\rdt}=rdttra$ is the 
+tracer time-step. the former is set from the \np{rn\_rdt} namelist parameter while the latter
+is computed using a hyperbolic tangent profile and the following namelist parameters : 
+\np{rn\_rdtmin}, \np{rn\_rdtmax} and \np{rn\_rdth}. Those three parameters correspond 
+to the surface value the deep ocean value and the depth at which the transition occurs, respectively. 
+The set of prognostic equations to solve becomes:
+\begin{equation} \label{Eq_acc}
+\begin{split}
+\frac{\partial \textbf{U}_h }{\partial t} 
+	&\equiv \frac{\textbf{U}_h ^{t+1}-\textbf{U}_h^{t-1} }{2\rdt} = \ldots \\ 
+\frac{\partial T}{\partial t} &\equiv \frac{T^{t+1}-T^{t-1}}{2 \widetilde{\rdt}} = \ldots \\ 
+\frac{\partial S}{\partial t} &\equiv \frac{S^{t+1} -S^{t-1}}{2 \widetilde{\rdt}} = \ldots \\ 
+\end{split}
+\end{equation}
+
+\citet{Bryan1984} has examined the consequences of this distorted physics. 
+Free waves have a slower phase speed, their meridional structure is slightly 
+modified, and the growth rate of baroclinically unstable waves is reduced 
+but with a wider range of instability. This technique is efficient for 
+searching for an equilibrium state in coarse resolution models. However its 
+application is not suitable for many oceanic problems: it cannot be used for 
+transient or time evolving problems (in particular, it is very questionable 
+to use this technique when there is a seasonal cycle in the forcing fields), 
+and it cannot be used in high-resolution models where baroclinically 
+unstable processes are important. Moreover, the vertical variation of 
+$\widetilde{ \rdt}$ implies that the heat and salt contents are no longer 
+conserved due to the vertical coupling of the ocean level through both 
+advection and diffusion. Therefore \np{rn\_rdtmin} = \np{rn\_rdtmax} should be
+a more clever choice.
+
+
+% ================================================================
+% 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*}
+This feature can be found in \mdl{lib\_fortran} module and is effective when \key{mpp\_rep}.
+In that case, all calls to 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). 
+Note 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?}
+
+
+$\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.
+
+3- \key{esopa} (to be rename key\_nemo) : which is another option for model 
+management. When defined, this key forces the activation of all options and 
+CPP keys. For example, all tracer and momentum advection schemes are called! 
+Therefore the model results have no physical meaning. 
+However, this option forces both the compiler and the model to run through 
+all the \textsc{Fortran} lines of the model. This allows the user to check for obvious 
+compilation or execution errors with all CPP options, and errors in namelist options.
+
+4- 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)
+
+$\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. 
+
+
+% ================================================================
+% Elliptic solvers (SOL)
+% ================================================================
+\section{Elliptic solvers (SOL)}
+\label{MISC_sol}
+%--------------------------------------------namdom-------------------------------------------------------
+\namdisplay{namsol} 
+%--------------------------------------------------------------------------------------------------------------
+
+When the filtered sea surface height option is used, the surface pressure gradient is 
+computed in \mdl{dynspg\_flt}. The force added in the momentum equation is solved implicitely.
+It is thus solution of an elliptic equation \eqref{Eq_PE_flt} for which two solvers are available: 
+a Successive-Over-Relaxation scheme (SOR) and a preconditioned conjugate gradient 
+scheme(PCG) \citep{Madec_al_OM88, Madec_PhD90}. The solver is selected trough the
+the value of \np{nn\_solv} (namelist parameter). 
+
+The PCG is a very efficient method for solving elliptic equations on vector computers. 
+It is a fast and rather easy method to use; which are attractive features for a large 
+number of ocean situations (variable bottom topography, complex coastal geometry, 
+variable grid spacing, open or cyclic boundaries, etc ...). It does not require 
+a search for an optimal parameter as in the SOR method. However, the SOR has 
+been retained because it is a linear solver, which is a very useful property when 
+using the adjoint model of \NEMO.
+
+At each time step, the time derivative of the sea surface height at time step $t+1$ 
+(or equivalently the divergence of the \textit{after} barotropic transport) that appears 
+in the filtering forced is the solution of the elliptic equation obtained from the horizontal 
+divergence of the vertical summation of \eqref{Eq_PE_flt}. 
+Introducing the following coefficients:
+\begin{equation}  \label{Eq_sol_matrix}
+\begin{aligned}
+&c_{i,j}^{NS}  &&= {2 \rdt }^2 \; \frac{H_v (i,j) \; e_{1v} (i,j)}{e_{2v}(i,j)}              \\
+&c_{i,j}^{EW} &&= {2 \rdt }^2 \; \frac{H_u (i,j) \; e_{2u} (i,j)}{e_{1u}(i,j)}            \\
+&b_{i,j} &&= \delta_i \left[ e_{2u}M_u \right] - \delta_j \left[ e_{1v}M_v \right]\ ,   \\
+\end{aligned}
+\end{equation}
+the resulting five-point finite difference equation is given by:
+\begin{equation}  \label{Eq_solmat}
+\begin{split}
+       c_{i+1,j}^{NS} D_{i+1,j}  + \;  c_{i,j+1}^{EW} D_{i,j+1}   
+  +   c_{i,j}    ^{NS} D_{i-1,j}   + \;  c_{i,j}    ^{EW} D_{i,j-1}                                          &    \\
+  -    \left(c_{i+1,j}^{NS} + c_{i,j+1}^{EW} + c_{i,j}^{NS} + c_{i,j}^{EW} \right)   D_{i,j}  &=  b_{i,j}
+\end{split}
+\end{equation}
+\eqref{Eq_solmat} is a linear symmetric system of equations. All the elements of 
+the corresponding matrix \textbf{A} vanish except those of five diagonals. With 
+the natural ordering of the grid points (i.e. from west to east and from 
+south to north), the structure of \textbf{A} is block-tridiagonal with 
+tridiagonal or diagonal blocks. \textbf{A} is a positive-definite symmetric 
+matrix of size $(jpi \cdot jpj)^2$, and \textbf{B}, the right hand side of 
+\eqref{Eq_solmat}, is a vector.
+
+Note that in the linear free surface case, the depth that appears in \eqref{Eq_sol_matrix}
+does not vary with time, and thus the matrix can be computed once for all. In non-linear free surface 
+(\key{vvl} defined) the matrix have to be updated at each time step.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Successive Over Relaxation
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Successive Over Relaxation (\np{nn\_solv}=2, \mdl{solsor})}
+\label{MISC_solsor}
+
+Let us introduce the four cardinal coefficients: 
+\begin{align*}
+a_{i,j}^S &= c_{i,j    }^{NS}/d_{i,j}     &\qquad  a_{i,j}^W &= c_{i,j}^{EW}/d_{i,j}       \\
+a_{i,j}^E &= c_{i,j+1}^{EW}/d_{i,j}    &\qquad   a_{i,j}^N &= c_{i+1,j}^{NS}/d_{i,j}   
+\end{align*}
+where $d_{i,j} = c_{i,j}^{NS}+ c_{i+1,j}^{NS} + c_{i,j}^{EW} + c_{i,j+1}^{EW}$ 
+(i.e. the diagonal of the matrix). \eqref{Eq_solmat} can be rewritten as:
+\begin{equation}  \label{Eq_solmat_p}
+\begin{split}
+a_{i,j}^{N}  D_{i+1,j} +\,a_{i,j}^{E}  D_{i,j+1} +\, a_{i,j}^{S}  D_{i-1,j} +\,a_{i,j}^{W} D_{i,j-1}  -  D_{i,j} = \tilde{b}_{i,j}
+\end{split}
+\end{equation}
+with $\tilde b_{i,j} = b_{i,j}/d_{i,j}$. \eqref{Eq_solmat_p} is the equation actually solved 
+with the SOR method. This method used is an iterative one. Its algorithm can be 
+summarised as follows (see \citet{Haltiner1980} for a further discussion):
+
+initialisation (evaluate a first guess from previous time step computations)
+\begin{equation}
+D_{i,j}^0 = 2 \, D_{i,j}^t - D_{i,j}^{t-1}
+\end{equation}
+iteration $n$, from $n=0$ until convergence, do :
+\begin{equation} \label{Eq_sor_algo}
+\begin{split}
+R_{i,j}^n  = &a_{i,j}^{N} D_{i+1,j}^n       +\,a_{i,j}^{E}  D_{i,j+1} ^n	    	
+			+\, a_{i,j}^{S}  D_{i-1,j} ^{n+1}+\,a_{i,j}^{W} D_{i,j-1} ^{n+1}
+                 -  D_{i,j}^n - \tilde{b}_{i,j}                                           \\
+D_{i,j} ^{n+1}  = &D_{i,j} ^{n}   + \omega \;R_{i,j}^n     
+\end{split}
+\end{equation}
+where \textit{$\omega $ }satisfies $1\leq \omega \leq 2$. An optimal value exists for 
+\textit{$\omega$} which significantly accelerates the convergence, but it has to be 
+adjusted empirically for each model domain (except for a uniform grid where an 
+analytical expression for \textit{$\omega$} can be found \citep{Richtmyer1967}). 
+The value of $\omega$ is set using \np{rn\_sor}, a \textbf{namelist} parameter. 
+The convergence test is of the form:
+\begin{equation}
+\delta = \frac{\sum\limits_{i,j}{R_{i,j}^n}{R_{i,j}^n}}
+                    {\sum\limits_{i,j}{ \tilde{b}_{i,j}^n}{\tilde{b}_{i,j}^n}} \leq \epsilon
+\end{equation}
+where $\epsilon$ is the absolute precision that is required. It is recommended 
+that a value smaller or equal to $10^{-6}$ is used for $\epsilon$ since larger 
+values may lead to numerically induced basin scale barotropic oscillations. 
+The precision is specified by setting \np{rn\_eps} (\textbf{namelist} parameter). 
+In addition, two other tests are used to halt the iterative algorithm. They involve 
+the number of iterations and the modulus of the right hand side. If the former 
+exceeds a specified value, \np{nn\_max} (\textbf{namelist} parameter), 
+or the latter is greater than $10^{15}$, the whole model computation is stopped 
+and the last computed time step fields are saved in a abort.nc NetCDF file. 
+In both cases, this usually indicates that there is something wrong in the model 
+configuration (an error in the mesh, the initial state, the input forcing, 
+or the magnitude of the time step or of the mixing coefficients). A typical value of 
+$nn\_max$ is a few hundred when $\epsilon = 10^{-6}$, increasing to a few 
+thousand when $\epsilon = 10^{-12}$.
+The vectorization of the SOR algorithm is not straightforward. The scheme
+contains two linear recurrences on $i$ and $j$. This inhibits the vectorisation. 
+\eqref{Eq_sor_algo} can be been rewritten as:
+\begin{equation} 
+\begin{split}
+R_{i,j}^n
+= &a_{i,j}^{N}  D_{i+1,j}^n +\,a_{i,j}^{E}  D_{i,j+1} ^n
+ +\,a_{i,j}^{S}  D_{i-1,j} ^{n}+\,_{i,j}^{W} D_{i,j-1} ^{n} -  D_{i,j}^n - \tilde{b}_{i,j}      \\
+R_{i,j}^n = &R_{i,j}^n - \omega \;a_{i,j}^{S}\; R_{i,j-1}^n                                             \\
+R_{i,j}^n = &R_{i,j}^n - \omega \;a_{i,j}^{W}\; R_{i-1,j}^n
+\end{split}
+\end{equation}
+This technique slightly increases the number of iteration required to reach the convergence,
+but this is largely compensated by the gain obtained by the suppression of the recurrences.
+
+Another technique have been chosen, the so-called red-black SOR. It consist in solving successively 
+\eqref{Eq_sor_algo} for odd and even grid points. It also slightly reduced the convergence rate
+but allows the vectorisation. In addition, and this is the reason why it has been chosen, it is able to handle the north fold boundary condition used in ORCA configuration ($i.e.$ tri-polar global ocean mesh).
+
+The SOR method is very flexible and can be used under a wide range of conditions, 
+including irregular boundaries, interior boundary points, etc. Proofs of convergence, etc. 
+may be found in the standard numerical methods texts for partial differential equations.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Preconditioned Conjugate Gradient
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Preconditioned Conjugate Gradient  (\np{nn\_solv}=1, \mdl{solpcg}) }
+\label{MISC_solpcg}
+
+\textbf{A} is a definite positive symmetric matrix, thus solving the linear 
+system \eqref{Eq_solmat} is equivalent to the minimisation of a quadratic 
+functional:
+\begin{equation*}
+\textbf{Ax} = \textbf{b} \leftrightarrow \textbf{x} =\text{inf}_{y} \,\phi (\textbf{y})
+\quad , \qquad
+\phi (\textbf{y}) = 1/2 \langle \textbf{Ay},\textbf{y}\rangle - \langle \textbf{b},\textbf{y} \rangle 
+\end{equation*}
+where $\langle , \rangle$ is the canonical dot product. The idea of the 
+conjugate gradient method is to search for the solution in the following 
+iterative way: assuming that $\textbf{x}^n$ has been obtained, $\textbf{x}^{n+1}$ 
+is found from $\textbf {x}^{n+1}={\textbf {x}}^n+\alpha^n{\textbf {d}}^n$ which satisfies:
+\begin{equation*}
+{\textbf{ x}}^{n+1}=\text{inf} _{{\textbf{ y}}={\textbf{ x}}^n+\alpha^n \,{\textbf{ d}}^n} \,\phi ({\textbf{ y}})\;\;\Leftrightarrow \;\;\frac{d\phi }{d\alpha}=0
+\end{equation*}
+and expressing $\phi (\textbf{y})$ as a function of \textit{$\alpha $}, we obtain the 
+value that minimises the functional: 
+\begin{equation*}
+\alpha ^n = \langle{ \textbf{r}^n , \textbf{r}^n} \rangle  / \langle {\textbf{ A d}^n, \textbf{d}^n} \rangle
+\end{equation*}
+where $\textbf{r}^n = \textbf{b}-\textbf{A x}^n = \textbf{A} (\textbf{x}-\textbf{x}^n)$ 
+is the error at rank $n$. The descent vector $\textbf{d}^n$ s chosen to be dependent 
+on the error: $\textbf{d}^n = \textbf{r}^n + \beta^n \,\textbf{d}^{n-1}$. $\beta ^n$ 
+is searched such that the descent vectors form an orthogonal basis for the dot 
+product linked to \textbf{A}. Expressing the condition 
+$\langle \textbf{A d}^n, \textbf{d}^{n-1} \rangle = 0$ the value of $\beta ^n$ is found:
+ $\beta ^n = \langle{ \textbf{r}^n , \textbf{r}^n} \rangle  / \langle {\textbf{r}^{n-1}, \textbf{r}^{n-1}} \rangle$. 
+ As a result, the errors $ \textbf{r}^n$ form an orthogonal 
+base for the canonic dot product while the descent vectors $\textbf{d}^n$ form 
+an orthogonal base for the dot product linked to \textbf{A}. The resulting 
+algorithm is thus the following one:
+
+initialisation :
+\begin{equation*} 
+\begin{split}
+\textbf{x}^0 &= D_{i,j}^0   = 2 D_{i,j}^t - D_{i,j}^{t-1}       \quad, \text{the initial guess }     \\
+\textbf{r}^0 &= \textbf{d}^0 = \textbf{b} - \textbf{A x}^0       \\
+\gamma_0 &= \langle{ \textbf{r}^0 , \textbf{r}^0} \rangle
+\end{split}
+\end{equation*}
+
+iteration $n,$ from $n=0$ until convergence, do :
+\begin{equation} 
+\begin{split}
+\text{z}^n& = \textbf{A d}^n \\
+\alpha_n &= \gamma_n /  \langle{ \textbf{z}^n , \textbf{d}^n} \rangle \\
+\textbf{x}^{n+1} &= \textbf{x}^n + \alpha_n \,\textbf{d}^n \\
+\textbf{r}^{n+1} &= \textbf{r}^n - \alpha_n \,\textbf{z}^n \\
+\gamma_{n+1} &= \langle{ \textbf{r}^{n+1} , \textbf{r}^{n+1}} \rangle \\
+\beta_{n+1} &= \gamma_{n+1}/\gamma_{n}  \\
+\textbf{d}^{n+1} &= \textbf{r}^{n+1} + \beta_{n+1}\; \textbf{d}^{n}\\
+\end{split}
+\end{equation}
+
+
+The convergence test is:
+\begin{equation}
+\delta = \gamma_{n}\; / \langle{ \textbf{b} , \textbf{b}} \rangle \leq \epsilon
+\end{equation}
+where $\epsilon $ is the absolute precision that is required. As for the SOR algorithm, 
+the whole model computation is stopped when the number of iterations, \np{nn\_max}, or 
+the modulus of the right hand side of the convergence equation exceeds a 
+specified value (see \S\ref{MISC_solsor} for a further discussion). The required 
+precision and the maximum number of iterations allowed are specified by setting 
+\np{rn\_eps} and \np{nn\_max} (\textbf{namelist} parameters).
+
+It can be demonstrated that the above algorithm is optimal, provides the exact 
+solution in a number of iterations equal to the size of the matrix, and that 
+the convergence rate is faster as the matrix is closer to the identity matrix,
+$i.e.$ its eigenvalues are closer to 1. Therefore, it is more efficient to solve 
+a better conditioned system which has the same solution. For that purpose, 
+we introduce a preconditioning matrix \textbf{Q} which is an approximation 
+of \textbf{A} but much easier to invert than \textbf{A}, and solve the system:
+\begin{equation} \label{Eq_pmat}
+\textbf{Q}^{-1} \textbf{A x} = \textbf{Q}^{-1} \textbf{b}
+\end{equation}
+
+The same algorithm can be used to solve \eqref{Eq_pmat} if instead of the 
+canonical dot product the following one is used: 
+${\langle{ \textbf{a} , \textbf{b}} \rangle}_Q = \langle{ \textbf{a} , \textbf{Q b}} \rangle$, and 
+if $\textbf{\~{b}} = \textbf{Q}^{-1}\;\textbf{b}$ and $\textbf{\~{A}} = \textbf{Q}^{-1}\;\textbf{A}$ 
+are substituted to \textbf{b} and \textbf{A} \citep{Madec_al_OM88}. 
+In \NEMO, \textbf{Q} is chosen as the diagonal of \textbf{ A}, i.e. the simplest form for 
+\textbf{Q} so that it can be easily inverted. In this case, the discrete formulation of 
+\eqref{Eq_pmat} is in fact given by \eqref{Eq_solmat_p} and thus the matrix and 
+right hand side are computed independently from the solver used.
+
+% ================================================================
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics.tex	(revision 3437)
@@ -0,0 +1,1310 @@
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_I_ocean_bc.pdf}
+\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}.
+
+The filtering of EGWs in models with a free surface is usually a matter of discretisation 
+of the temporal derivatives, using the time splitting method \citep{Killworth_al_JPO91, Zhang_Endoh_JGR92} 
+or the implicit scheme \citep{Dukowicz1994}. In \NEMO, we use a slightly different approach 
+developed by \citet{Roullet_Madec_JGR00}: the damping of EGWs is ensured by introducing an 
+additional force in the momentum equation. \eqref{Eq_PE_dyn} becomes: 
+\begin{equation} \label{Eq_PE_flt}
+\frac{\partial {\rm {\bf U}}_h }{\partial t}= {\rm {\bf M}}
+- g \nabla \left( \tilde{\rho} \ \eta \right) 
+- g \ T_c \nabla \left( \widetilde{\rho} \ \partial_t \eta \right) 
+\end{equation}
+where $T_c$, is a parameter with dimensions of time which characterizes the force, 
+$\widetilde{\rho} = \rho / \rho_o$ is the dimensionless density, and $\rm {\bf M}$ 
+represents the collected contributions of the Coriolis, hydrostatic pressure gradient, 
+non-linear and viscous terms in \eqref{Eq_PE_dyn}.
+
+The new force can be interpreted as a diffusion of vertically integrated volume flux divergence. 
+The time evolution of $D$ is thus governed by a balance of two terms, $-g$ \textbf{A} $\eta$ 
+and $g \, T_c \,$ \textbf{A} $D$, associated with a propagative regime and a diffusive regime 
+in the temporal spectrum, respectively. In the diffusive regime, the EGWs no longer propagate, 
+$i.e.$ they are stationary and damped. The diffusion regime applies to the modes shorter than 
+$T_c$. For longer ones, the diffusion term vanishes. Hence, the temporally unresolved EGWs 
+can be damped by choosing $T_c > \rdt$. \citet{Roullet_Madec_JGR00} demonstrate that 
+(\ref{Eq_PE_flt}) can be integrated with a leap frog scheme except the additional term which 
+has to be computed implicitly. This is not surprising since the use of a large time step has a 
+necessarily numerical cost. Two gains arise in comparison with the previous formulations. 
+Firstly, the damping of EGWs can be quantified through the magnitude of the additional term. 
+Secondly, the numerical scheme does not need any tuning. Numerical stability is ensured as 
+soon as $T_c > \rdt$.
+
+When the variations of free surface elevation are small compared to the thickness of the first 
+model layer, the free surface equation (\ref{Eq_PE_ssh}) can be linearized. As emphasized 
+by \citet{Roullet_Madec_JGR00} the linearization of (\ref{Eq_PE_ssh}) has consequences on the 
+conservation of salt in the model. With the nonlinear free surface equation, the time evolution 
+of the total salt content is 
+\begin{equation} \label{Eq_PE_salt_content}
+    \frac{\partial }{\partial t}\int\limits_{D\eta } {S\;dv} 
+                        =\int\limits_S {S\;(-\frac{\partial \eta }{\partial t}-D+P-E)\;ds}
+\end{equation}
+where $S$ is the salinity, and the total salt is integrated over the whole ocean volume 
+$D_\eta$ bounded by the time-dependent free surface. The right hand side (which is an 
+integral over the free surface) vanishes when the nonlinear equation (\ref{Eq_PE_ssh}) 
+is satisfied, so that the salt is perfectly conserved. When the free surface equation is 
+linearized, \citet{Roullet_Madec_JGR00} show that the total salt content integrated in the fixed 
+volume $D$ (bounded by the surface $z=0$) is no longer conserved:
+\begin{equation} \label{Eq_PE_salt_content_linear}
+         \frac{\partial }{\partial t}\int\limits_D {S\;dv} 
+         		= - \int\limits_S {S\;\frac{\partial \eta }{\partial t}ds} 
+\end{equation}
+
+The right hand side of (\ref{Eq_PE_salt_content_linear}) is small in equilibrium solutions 
+\citep{Roullet_Madec_JGR00}. It can be significant when the freshwater forcing is not balanced and 
+the globally averaged free surface is drifting. An increase in sea surface height \textit{$\eta $} 
+results in a decrease of the salinity in the fixed volume $D$. Even in that case though, 
+the total salt integrated in the variable volume $D_{\eta}$ varies much less, since 
+(\ref{Eq_PE_salt_content_linear}) can be rewritten as 
+\begin{equation} \label{Eq_PE_salt_content_corrected}
+\frac{\partial }{\partial t}\int\limits_{D\eta } {S\;dv} 
+=\frac{\partial}{\partial t} \left[ \;{\int\limits_D {S\;dv} +\int\limits_S {S\eta \;ds} } \right]
+=\int\limits_S {\eta \;\frac{\partial S}{\partial t}ds}
+\end{equation}
+
+Although the total salt content is not exactly conserved with the linearized free surface, 
+its variations are driven by correlations of the time variation of surface salinity with the 
+sea surface height, which is a negligible term. This situation contrasts with the case of 
+the rigid lid approximation in which case freshwater forcing is represented by a virtual 
+salt flux, leading to a spurious source of salt at the ocean surface 
+\citep{Huang_JPO93, Roullet_Madec_JGR00}.
+
+\newpage
+$\ $\newline    % force a new ligne
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_I_earth_referential.pdf}
+\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 = \left\{ \begin{split} 
+\rho \,g \,\eta &                                 \qquad  \qquad  \;   \qquad \text{ standard free surface} \\ 
+\rho \,g \,\eta &+ \rho_o \,\mu \,\frac{\partial \eta }{\partial t}      \qquad \text{ filtered     free surface}    
+\end{split} 
+\right.
+\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:
+
+ \vspace{0.5cm}
+* momentum equation:
+\begin{multline} \label{Eq_PE_sco_u}
+\frac{1}{e_3} \frac{\partial \left(  e_3\,u  \right) }{\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{1}{e_3} \frac{\partial \left(  e_3\,v  \right) }{\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}
+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}
+* 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]{./TexFiles/Figures/Fig_z_zstar.pdf}
+\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_OM10s}.
+It is not available in the current version of \NEMO.
+
+\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. In the $z$-coordinate 
+formulation, five options are offered for active tracers (temperature and 
+salinity): second order geopotential operator, second order isoneutral 
+operator, \citet{Gent1990} parameterisation, fourth order 
+geopotential operator, and various slightly diffusive advection schemes. 
+The same options are available for momentum, except 
+\citet{Gent1990} parameterisation which only involves tracers. In the
+$s$-coordinate formulation, additional options are offered for tracers: second 
+order operator acting along $s-$surfaces, and for momentum: fourth order 
+operator acting along $s-$surfaces (see \S\ref{LDF}).
+
+\subsubsection{Lateral second order tracer diffusive operator}
+
+The lateral second order tracer diffusive operator is defined by (see Appendix~\ref{Apdx_B}):
+\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{geopotential} diffusion, $r_1$ and $r_2 $ are the slopes between the 
+geopotential and computational surfaces: in $z$-coordinates they are zero 
+($r_1 = r_2 = 0$) while in $s$-coordinate (including $\textit{z*}$ case) they are 
+equal to $\sigma _1$ and $\sigma _2$, respectively (see \eqref{Eq_PE_sco_slope} ).
+
+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( {\frac{\partial \rho }{\partial i}} \right)
+						\left( {\frac{\partial \rho }{\partial k}} \right)^{-1} \ , \quad
+r_1 =\frac{e_3 }{e_1 }	\left( {\frac{\partial \rho }{\partial i}} \right)
+						\left( {\frac{\partial \rho }{\partial k}} \right)^{-1},
+\end{equation}
+while in $s$-coordinates $\partial/\partial k$ is replaced by
+$\partial/\partial 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 fourth order tracer diffusive operator}
+
+The lateral fourth order tracer diffusive operator is defined by:
+\begin{equation} \label{Eq_PE_bilapT}
+D^{lT}=\Delta \left( {A^{lT}\;\Delta T} \right) 
+\qquad \text{where} \  D^{lT}=\Delta \left( {A^{lT}\;\Delta T} \right)
+ \end{equation}
+
+It is the second order operator given by \eqref{Eq_PE_iso_tensor} applied twice with 
+the eddy diffusion coefficient correctly placed. 
+
+
+\subsubsection{Lateral second order momentum diffusive operator}
+
+The second order momentum diffusive operator along $z$- or $s$-surfaces is found by 
+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 not 
+available for geopotential diffusion in $s-$coordinates and for isoneutral 
+diffusion in both $z$- and $s$-coordinates ($i.e.$ when a rotation is required). 
+In these two cases, 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( {\Re \;\nabla u} \right) \\ 
+ D_v^{l{\rm {\bf U}}} &= \nabla .\left( {\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 fourth order momentum diffusive operator}
+
+As for tracers, the fourth order momentum diffusive operator along $z$ or $s$-surfaces 
+is a re-entering second order operator \eqref{Eq_PE_lapU} or \eqref{Eq_PE_lapU} 
+with the eddy viscosity coefficient correctly placed:
+
+geopotential diffusion in $z$-coordinate:
+\begin{equation} \label{Eq_PE_bilapU}
+\begin{split}
+{\rm {\bf D}}^{l{\rm {\bf U}}} &=\nabla _h \left\{ {\;\nabla _h {\rm {\bf 
+.}}\left[ {A^{lm}\,\nabla _h \left( \chi \right)} \right]\;} 
+\right\}\;   \\
+&+\nabla _h \times \left\{ {\;{\rm {\bf k}}\cdot \nabla \times 
+\left[ {A^{lm}\,\nabla _h \times \left( {\zeta \;{\rm {\bf k}}} \right)} 
+\right]\;} \right\}
+\end{split}
+\end{equation}
+
+\gmcomment{  change the position of the coefficient, both here and in the code}
+
+geopotential diffusion in $s$-coordinate:
+\begin{equation} \label{Eq_bilapU_iso}
+   \left\{   \begin{aligned}
+         D_u^{l{\rm {\bf U}}} =\Delta \left( {A^{lm}\;\Delta u} \right) \\ 
+         D_v^{l{\rm {\bf U}}} =\Delta \left( {A^{lm}\;\Delta v} \right)
+   \end{aligned}    \right.
+   \quad \text{where} \quad 
+   \Delta \left( \bullet \right) = \nabla \cdot \left( \Re \nabla(\bullet) \right) 
+\end{equation}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_Model_Basics_zstar.tex	(revision 3437)
@@ -0,0 +1,254 @@
+% ================================================================
+% 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} 
+%------------------------------------------------------------------------------------------------------------
+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} (Figure III.3). 
+
+%>   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >   >
+\begin{figure}[!t] 	\begin{center}
+\includegraphics[width=0.90\textwidth]{./Figures/Fig_DYN_dynspg_ts.pdf}
+\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.
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_OBS.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_OBS.tex	(revision 3437)
@@ -0,0 +1,1022 @@
+% ================================================================
+% Chapter observation operator (OBS)
+% ================================================================
+\chapter{Observation and model comparison (OBS)}
+\label{OBS}
+
+Authors: D. Lea, M. Martin, K. Mogensen, A. Vidard, A. Weaver...   % 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 model or  any other data assimilation system.
+
+The OBS code is called from \np{opa.F90} 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 \np{step.F90}. To build with the OBS code active \key{diaobs} must be
+set.
+
+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. Temperature data from moored buoys (TAO, TRITON, PIRATA) in the
+ENACT/ENSEMBLES data-base are available as daily averaged quantities. For this type of
+observation the observation operator will compare such observations to the model temperature
+fields averaged over one day. The relevant observation type may be specified in the namelist
+using \np{endailyavtypes}. 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_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 with \key{diaobs} set.
+
+\item Download some ENSEMBLES EN3 data from 
+\href{http://www.hadobs.org}{http://www.hadobs.org}. 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 Add the following to the NEMO namelist to run the observation
+operator on this data. Set the \np{enactfiles} namelist parameter to the
+observation  file name:
+\end{enumerate}
+
+%------------------------------------------namobs_example-----------------------------------------------------
+\namdisplay{namobs_example}
+%-------------------------------------------------------------------------------------------------------------
+
+The options \np{ln\_t3d} and \np{ln\_s3d} switch on the temperature and salinity
+profile observation operator code. The \np{ln\_ena} switch turns on the reading
+of ENACT/ENSEMBLES type profile data. The filename or array of filenames are
+specified using the \np{enactfiles} 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}.
+
+\section{Technical details}
+\label{OBS_details}
+
+Here we show a more complete example namelist and also show the NetCDF headers
+of the observation
+files that may be used with the observation operator
+
+%------------------------------------------namobs--------------------------------------------------------
+\namdisplay{namobs}
+%-------------------------------------------------------------------------------------------------------------
+
+This name list uses the "feedback" type observation file input format for
+profile, sea level anomaly and sea surface temperature data. 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.]{./TexFiles/Figures/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.]{./TexFiles/Figures/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
+
+\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{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.]{./TexFiles/Figures/Fig_OBS_dataplot_main}
+\includegraphics[width=9cm,angle=-90.]{./TexFiles/Figures/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.]{./TexFiles/Figures/Fig_OBS_dataplot_prof}
+\includegraphics[width=7cm,angle=-90.]{./TexFiles/Figures/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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_SBC.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_SBC.tex	(revision 3437)
@@ -0,0 +1,1098 @@
+% ================================================================
+% Chapter Ñ Surface Boundary Condition (SBC) 
+% ================================================================
+\chapter{Surface Boundary Condition (SBC) }
+\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},\;\textit{emp}_S } \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 variables: an analytical formulation (\np{ln\_ana}~=~true), 
+a flux formulation (\np{ln\_flx}~=~true), a bulk formulae formulation (CORE 
+(\np{ln\_core}~=~true), CLIO (\np{ln\_clio}~=~true) or MFS
+\footnote { Note that MFS bulk formulae compute fluxes only for the ocean component}
+(\np{ln\_mfs}~=~true) bulk formulae) and a coupled 
+formulation (exchanges with a atmospheric model via the OASIS coupler) 
+(\np{ln\_cpl}~=~true). When used, the atmospheric pressure forces both 
+ocean and ice dynamics (\np{ln\_apr\_dyn}~=~true).
+The frequency at which the six or seven fields have to be updated is the \np{nn\_fsbc} 
+namelist parameter. 
+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}).
+In addition, the resulting fields can be further modified using several namelist options. 
+These options control  the rotation of vector components supplied relative to an east-north 
+coordinate system onto the local grid directions in the model; the addition of a surface 
+restoring term to observed SST and/or SSS (\np{ln\_ssr}~=~true); the modification of fluxes 
+below ice-covered areas (using observed ice-cover or a sea-ice model) 
+(\np{nn\_ice}~=~0,1, 2 or 3); the addition of river runoffs as surface freshwater 
+fluxes or lateral inflow (\np{ln\_rnf}~=~true); the addition of a freshwater flux adjustment 
+in order to avoid a mean sea-level drift (\np{nn\_fwb}~=~0,~1~or~2); the 
+transformation of the solar radiation (if provided as daily mean) into a diurnal 
+cycle (\np{ln\_dm2dc}~=~true); and a neutral drag coefficient can be read from an external wave 
+model (\np{ln\_cdgw}~=~true). The latter option is possible only in case core or mfs bulk formulas are selected.
+
+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.
+
+
+% ================================================================
+% 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. The two components of stress are assumed to be interpolated 
+onto the ocean mesh, $i.e.$ resolved onto the model (\textbf{i},\textbf{j}) direction 
+at $u$- and $v$-points They are applied as a surface boundary condition of the 
+computation of the momentum vertical mixing trend (\mdl{dynzdf} module) :
+\begin{equation} \label{Eq_sbc_dynzdf}
+\left.{\left( {\frac{A^{vm} }{e_3 }\ \frac{\partial \textbf{U}_h}{\partial k}} \right)} \right|_{z=1}
+	 = \frac{1}{\rho _o} \binom{\tau _u}{\tau _v }
+\end{equation}
+where $(\tau _u ,\;\tau _v )=(utau,vtau)$ are the two components of the wind 
+stress vector in the $(\textbf{i},\textbf{j})$ coordinate system.
+
+The surface heat flux is decomposed into two parts, a non solar and a solar heat 
+flux, $Q_{ns}$ and $Q_{sr}$, respectively. The former is the non penetrative part 
+of the heat flux ($i.e.$ the sum of sensible, latent and long wave heat fluxes). 
+It is applied as a surface boundary condition trend of the first level temperature 
+time evolution equation (\mdl{trasbc} module). 
+\begin{equation} \label{Eq_sbc_trasbc_q}
+\frac{\partial T}{\partial t}\equiv \cdots \;+\;\left. {\frac{Q_{ns} }{\rho 
+_o \;C_p \;e_{3t} }} \right|_{k=1} \quad
+\end{equation}
+$Q_{sr}$ is the penetrative part of the heat flux. It is applied as a 3D 
+trends of the temperature equation (\mdl{traqsr} module) when \np{ln\_traqsr}=True.
+
+\begin{equation} \label{Eq_sbc_traqsr}
+\frac{\partial T}{\partial t}\equiv \cdots \;+\frac{Q_{sr} }{\rho_o C_p \,e_{3t} }\delta _k \left[ {I_w } \right]
+\end{equation}
+where $I_w$ is a non-dimensional function that describes the way the light 
+penetrates inside the water column. It is generally a sum of decreasing 
+exponentials (see \S\ref{TRA_qsr}).
+
+The surface freshwater budget is provided by fields: \textit{emp} and $\textit{emp}_S$ which 
+may or may not be identical. Indeed, a surface freshwater flux has two effects: 
+it changes the volume of the ocean and it changes the surface concentration of 
+salt (and other tracers). Therefore it appears in the sea surface height as a volume 
+flux, \textit{emp} (\textit{dynspg\_xxx} modules), and in the salinity time evolution equations 
+as a concentration/dilution effect, 
+$\textit{emp}_{S}$ (\mdl{trasbc} module). 
+\begin{equation} \label{Eq_trasbc_emp}
+\begin{aligned}
+&\frac{\partial \eta }{\partial t}\equiv \cdots \;+\;\textit{emp}\quad  \\ 
+\\
+ &\frac{\partial S}{\partial t}\equiv \cdots \;+\left. {\frac{\textit{emp}_S \;S}{e_{3t} }} \right|_{k=1} \\ 
+ \end{aligned}
+\end{equation} 
+
+In the real ocean, $\textit{emp}=\textit{emp}_S$ and the ocean salt content is conserved, 
+but it exist several numerical reasons why this equality should be broken. 
+For example, when the ocean is coupled to a sea-ice model, the water exchanged between 
+ice and ocean is slightly salty (mean sea-ice salinity is $\sim $\textit{4 psu}). In this case, 
+$\textit{emp}_{S}$ take into account both concentration/dilution effect associated with 
+freezing/melting and the salt flux between ice and ocean, while \textit{emp} is 
+only the volume flux. In addition, in the current version of \NEMO, the sea-ice is 
+assumed to be above the ocean (the so-called levitating sea-ice). Freezing/melting does 
+not change the ocean volume (no impact on \textit{emp}) but it modifies the SSS.
+%gm  \colorbox{yellow}{(see {\S} on LIM sea-ice model)}.
+
+Note that SST can also be modified by a freshwater flux. Precipitation (in 
+particular solid precipitation) may have a temperature significantly different from 
+the SST. Due to the lack of information about the temperature of 
+precipitation, we assume it is equal to the SST. Therefore, no 
+concentration/dilution term appears in the temperature equation. It has to 
+be emphasised that this absence does not mean that there is no heat flux 
+associated with precipitation! Precipitation can change the ocean volume and thus the
+ocean heat content. It is therefore associated with a heat flux (not yet  
+diagnosed in the model) \citep{Roullet_Madec_JGR00}).
+
+%\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}.
+%
+%\colorbox{yellow}{End Miss }
+
+The ocean model provides the surface currents, temperature and salinity 
+averaged over \np{nf\_sbc} time-step (\ref{Tab_ssm}).The computation of the 
+mean is done in \mdl{sbcmod} module.
+
+%-------------------------------------------------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 nf{\_}sbc 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 two 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 ! 
+!             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+\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' and 'pairing rotation' 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.
+
+\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).
+
+
+% ================================================================
+% 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 
+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 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}. 
+
+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.
+
+% -------------------------------------------------------------------------------------------------------------
+%        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. 
+
+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 parameterized according to \citet{Kondo1975}.
+Details on the bulk formulae used can be found in \citet{Maggiore_al_PCE98} and \citet{Castellari_al_JMS1998}.
+
+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
+(\key{oasis3}) and does not support OASIS 4
+\footnote{The \key{oasis4} exist. It activates portion of the code that are still under development.}. 
+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 namsbc{\_}cpl).
+
+The new 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{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.
+
+% ================================================================
+%        Tidal Potential
+% ================================================================
+\section   [Tidal Potential (\textit{sbctide})]
+                        {Tidal Potential (\mdl{sbctide})}
+\label{SBC_tide}
+
+A module is available to use the tidal potential forcing and is activated with with \key{tide}.
+
+
+%------------------------------------------nam_tide----------------------------------------------------
+\namdisplay{nam_tide}
+%-------------------------------------------------------------------------------------------------------------
+
+Concerning the tidal potential, some parameters are available in namelist:
+
+- \texttt{ln\_tide\_pot} activate the tidal potential forcing
+
+- \texttt{nb\_harmo} is the number of constituent used
+
+- \texttt{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 parametrized the astronomical tidal land,
+and $h$ a number of Love to 0.3 which parametrized the parametrization 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 options, \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:
+
+%}
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_SBC_diurnal.pdf}
+\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{namsbc} namelist parameter) 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]{./TexFiles/Figures/Fig_SBC_dcy.pdf}
+\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} 
+%-------------------------------------------------------------------------------------------------------------
+
+In 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.  
+\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 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}
+%-------------------------------------------------------------------------------------------------------------
+\begin{description}
+
+\item [??] In order to read a neutral drag coeff, from an external data source (i.e. a wave model), the 
+logical variable \np{ln\_cdgw}
+ in $namsbc$ namelist must be defined ${.true.}$. 
+The \mdl{sbcwave} module containing the routine \np{sbc\_wave} reads the
+namelist ${namsbc\_wave}$ (for external data names, locations, frequency, interpolation and all 
+the miscellanous options allowed by Input Data generic Interface see \S\ref{SBC_input}) 
+and a 2D field of neutral drag coefficient. Then using the routine 
+TURB\_CORE\_1Z or TURB\_CORE\_2Z, and starting from the neutral drag coefficent provided, the drag coefficient is computed according 
+to stable/unstable conditions of the air-sea interface following \citet{Large_Yeager_Rep04}.
+
+\end{description}
+
+% 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. 
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_STP.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_STP.tex	(revision 3437)
@@ -0,0 +1,424 @@
+
+% ================================================================
+% 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. 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} 
+
+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}).
+
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        Hydrostatic Pressure gradient
+% -------------------------------------------------------------------------------------------------------------
+\section{Hydrostatic Pressure Gradient --- semi-implicit scheme}
+\label{STP_hpg_imp}
+
+%\gmcomment{ 
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=0.7\textwidth]{./TexFiles/Figures/Fig_TimeStepping_flowchart.pdf}
+\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 range of stability of the Leap-Frog scheme can be extended by a factor of two
+by introducing a semi-implicit computation of the hydrostatic pressure gradient term
+\citep{Brown_Campana_MWR78}. Instead of evaluating the pressure at $t$, a linear 
+combination of values at $t-\rdt$, $t$ and $t+\rdt$ is used (see \S~\ref{DYN_hpg_imp}).  
+This technique, controlled by the \np{nn\_dynhpg\_rst} namelist parameter, does not 
+introduce a significant additional computational cost when tracers and thus density 
+is time stepped before the dynamics. This time step ordering is used in \NEMO 
+(Fig.\ref{Fig_TimeStep_flowchart}).
+
+
+This technique, used in several GCMs (\NEMO, POP or MOM for instance), 
+makes the Leap-Frog scheme as efficient 
+\footnote{The efficiency is defined as the maximum allowed Courant number of the time 
+stepping scheme divided by the number of computations of the right-hand side per time step.} 
+as the Forward-Backward scheme used in MOM \citep{Griffies_al_OS05} and more 
+efficient than the LF-AM3 scheme (leapfrog time stepping combined with a third order
+Adams-Moulthon interpolation for the predictor phase) used in ROMS 
+\citep{Shchepetkin_McWilliams_OM05}. 
+
+In fact, this technique is efficient when the physical phenomenon that 
+limits the time-step is internal gravity waves (IGWs). Indeed, it is 
+equivalent to applying a time filter to the pressure gradient to eliminate high 
+frequency IGWs. Obviously, 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, diffusion or Coriolis terms. For example, it is inefficient in low resolution
+global ocean configurations, since inertial oscillations in the vicinity of the North Pole 
+are the limiting factor for the time step. It is also often inefficient in very high 
+resolution configurations where strong currents and small grid cells exert 
+the strongest constraint on the time step.
+
+% -------------------------------------------------------------------------------------------------------------
+%        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]{./TexFiles/Figures/Fig_MLF_forcing.pdf}
+\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. 
+%%%
+\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}         
+%--------------------------------------------------------------------------------------------------------------
+
+
+ \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*}
+
+%%
+}
+%%
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_TRA.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_TRA.tex	(revision 3437)
@@ -0,0 +1,1392 @@
+% ================================================================
+% 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 
+(temporarily) located in the NEMO/OPA/TRA directory, is described with the 
+model vertical physics (ZDF).
+%%%
+\gmcomment{change the position of eosbn2 in the reference code}
+%%%
+
+In the present chapter we also describe the diagnostic equations used to compute 
+the sea-water properties (density, Brunt-Vais\"{a}l\"{a} frequency, specific heat and 
+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 (\key{trdtra} is defined), as described in Chap.~\ref{MISC}.
+
+$\ $\newline    % force a new ligne
+% ================================================================
+% Tracer Advection
+% ================================================================
+\section  [Tracer Advection (\textit{traadv})]
+		{Tracer Advection (\mdl{traadv})}
+\label{TRA_adv}
+%------------------------------------------namtra_adv-----------------------------------------------------
+\namdisplay{namtra_adv}
+%-------------------------------------------------------------------------------------------------------------
+
+The advection tendency of a tracer in flux form is 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, $\nabla \cdot \vect{U}=0$ or 
+$ \partial _t e_3 + e_3\;\nabla \cdot \vect{U}=0$ in constant volume or variable volume case, respectively. 
+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 replacing $\tau$ by the number 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]{./TexFiles/Figures/Fig_adv_scheme.pdf}
+\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:] 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:] (\key{vvl} is defined) 
+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 both rigid-lid and non-linear free surface 
+cases, but not in the linear free surface case. Nevertheless, in the latter
+case, it is achieved to a good approximation since the non-conservative 
+term is the product of the time derivative of the tracer and the free surface 
+height, two quantities that are not correlated (see \S\ref{PE_free_surface}, 
+and also \citet{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{eulerian} ocean velocity (see Chap.~\ref{DYN}). 
+When eddy induced velocity (\textit{eiv}) parameterisation is used it is the \textit{now} 
+\textit{effective} velocity ($i.e.$ the sum of the eulerian and eiv velocities) which is used.
+
+The choice of an advection scheme is made in the \textit{nam\_traadv} namelist, by 
+setting to \textit{true} one and only 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. Details 
+of the advection schemes are given below. The choice of 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. 
+
+Note that 
+(1) cen2, cen4 and TVD schemes require an explicit diffusion 
+operator while the other schemes are diffusive enough so that they do not 
+require additional diffusion ; 
+(2) cen2, cen4, MUSCL2, and UBS are not \textit{positive} schemes
+\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 order centred scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [$2^{nd}$ order centred scheme (cen2) (\np{ln\_traadv\_cen2})]
+			{$2^{nd}$ order centred scheme (cen2) (\np{ln\_traadv\_cen2}=true)}
+\label{TRA_adv_cen2}
+
+In the centred second order formulation, 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}
+
+The scheme 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. The centered second 
+order advection is computed in the \mdl{traadv\_cen2} module. In this module,
+it is advantageous to combine the \textit{cen2} scheme with an upstream scheme
+in specific areas which require a strong diffusion in order to avoid the generation 
+of false extrema. These areas are the vicinity of large river mouths, some straits 
+with coarse resolution, and the vicinity of ice cover area ($i.e.$ when the ocean 
+temperature is close to the freezing point).
+This combined scheme has been included for specific grid points in the ORCA2 
+and ORCA4 configurations only. This is an obsolescent feature as the recommended 
+advection scheme for the ORCA configuration is TVD (see  \S\ref{TRA_adv_tvd}).
+
+Note that using the cen2 scheme, 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. \gmcomment{Note also that ... blah, blah}
+
+% -------------------------------------------------------------------------------------------------------------
+%        4nd order centred scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [$4^{nd}$ order centred scheme (cen4) (\np{ln\_traadv\_cen4})]
+		     {$4^{nd}$ order centred scheme (cen4) (\np{ln\_traadv\_cen4}=true)}
+\label{TRA_adv_cen4}
+
+In the $4^{th}$ order formulation (to be implemented), tracer values are 
+evaluated at velocity points as a $4^{th}$ order interpolation, and thus depend on 
+the four neighbouring $T$-points. For example, in the $i$-direction:
+\begin{equation} \label{Eq_tra_adv_cen4}
+\tau _u^{cen4} 
+=\overline{   T - \frac{1}{6}\,\delta _i \left[ \delta_{i+1/2}[T] \,\right]   }^{\,i+1/2}
+\end{equation}
+
+Strictly speaking, the cen4 scheme is not a $4^{th}$ order advection scheme 
+but a $4^{th}$ order evaluation of advective fluxes, since the divergence of 
+advective fluxes \eqref{Eq_tra_adv} is kept at $2^{nd}$ order. The phrase ``$4^{th}$ 
+order scheme'' used in oceanographic literature is usually associated 
+with the scheme presented here. Introducing a \textit{true} $4^{th}$ order advection 
+scheme is feasible but, for consistency reasons, it requires changes in the 
+discretisation of the tracer advection together with changes in both the 
+continuity equation and the momentum advection terms.  
+
+A direct consequence of the pseudo-fourth order nature of the scheme is that 
+it is not non-diffusive, i.e. the global variance of a tracer is not preserved using 
+\textit{cen4}. Furthermore, it must be used in conjunction with an explicit 
+diffusion operator to produce a sensible solution. The time-stepping is also 
+performed using a leapfrog scheme in conjunction with an Asselin time-filter, 
+so $T$ in (\ref{Eq_tra_adv_cen4}) is the \textit{now} tracer.
+
+At a $T$-grid cell adjacent to a boundary (coastline, bottom and surface), an 
+additional hypothesis must be made to evaluate $\tau _u^{cen4}$. This 
+hypothesis usually reduces the order of the scheme. Here we choose to set 
+the gradient of $T$ across the boundary to zero. Alternative conditions can be 
+specified, such as a reduction to a second order scheme for these near boundary 
+grid points.
+
+% -------------------------------------------------------------------------------------------------------------
+%        TVD scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Total Variance Dissipation scheme (TVD) (\np{ln\_traadv\_tvd})]
+			{Total Variance Dissipation scheme (TVD) (\np{ln\_traadv\_tvd}=true)}
+\label{TRA_adv_tvd}
+
+In the Total Variance Dissipation (TVD) 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_tvd}
+\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^{tvd}&=\tau _u^{ups} +c_u \;\left( {\tau _u^{cen2} -\tau _u^{ups} } \right)
+\end{split}
+\end{equation}
+where $c_u$ is a flux limiter function taking values between 0 and 1. 
+There exist many ways to define $c_u$, each corresponding to a different 
+total variance decreasing 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. 
+This scheme is tested and compared with MUSCL and the MPDATA scheme in 
+\citet{Levy_al_GRL01}; note that in this paper it is referred to as "FCT" (Flux corrected 
+transport) rather than TVD. The TVD scheme is implemented in the \mdl{traadv\_tvd} module.
+
+For stability reasons (see \S\ref{DOM_nxt}),
+$\tau _u^{cen2}$ is evaluated  in (\ref{Eq_tra_adv_tvd}) 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\_muscl})]
+	{Monotone Upstream Scheme for Conservative Laws (MUSCL) (\np{ln\_traadv\_muscl}=T)}
+\label{TRA_adv_muscl}
+
+The Monotone Upstream Scheme for Conservative Laws (MUSCL) has been 
+implemented 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_muscl}
+   \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, two choices are available: an upstream flux 
+(\np{ln\_traadv\_muscl}=true) or a second order flux 
+(\np{ln\_traadv\_muscl2}=true). Note that the latter choice does not ensure 
+the \textit{positive} character of the scheme. Only the former can be used 
+on both active and passive tracers. The two MUSCL schemes are implemented 
+in the \mdl{traadv\_tvd} and \mdl{traadv\_tvd2} modules.
+
+% -------------------------------------------------------------------------------------------------------------
+%        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 UBS advection scheme is an upstream-biased third order scheme based on 
+an upstream-biased parabolic interpolation. It is also known as the Cell 
+Averaged QUICK scheme (Quadratic Upstream Interpolation for Convective 
+Kinematics). 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. 
+It is not a \emph{positive} scheme, meaning that false extrema are permitted, 
+but the amplitude of such are significantly reduced over the centred second 
+order method. Nevertheless 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. 
+Therefore the vertical flux is evaluated using the TVD scheme when 
+\np{ln\_traadv\_ubs}=true.
+
+For stability reasons  (see \S\ref{DOM_nxt}),
+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.
+
+Four different options are possible for the vertical 
+component used in the UBS scheme. $\tau _w^{ubs}$ can 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 the \citet{Shchepetkin_McWilliams_OM05} 
+implementation of UBS in ROMS, or  \textit{(d)} a UBS. The $3^{rd}$ case 
+has dispersion properties similar to an eighth-order accurate conventional scheme.
+The current reference version uses method b)
+
+Note that :
+
+(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. Such a technique has been 
+implemented and validated in ORCA05 with 301 levels. It is not available 
+in the current reference version. 
+
+(2) 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 that NEMO v3.4 still uses 
+ \eqref{Eq_tra_adv_ubs}, not \eqref{Eq_traadv_ubs2}.
+ %%%
+ \gmcomment{the change in UBS scheme has to be done}
+ %%%
+
+% -------------------------------------------------------------------------------------------------------------
+%        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 the third order Godunov scheme. It 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 TVD in the vertical 
+direction (as for the UBS case) should be implemented to restore this property.
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        PPM scheme  
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Piecewise Parabolic Method (PPM) (\np{ln\_traadv\_ppm})]
+			{Piecewise Parabolic Method (PPM) (\np{ln\_traadv\_ppm}=true)}
+\label{TRA_adv_ppm}
+
+The Piecewise Parabolic Method (PPM) proposed by Colella and Woodward (1984) 
+\sgacomment{reference?}
+is based on a quadradic piecewise construction. Like the QCK scheme, it is associated 
+with the ULTIMATE QUICKEST limiter \citep{Leonard1991}. It has been implemented 
+in \NEMO by G. Reffray (MERCATOR-ocean) but is not yet offered in the reference 
+version 3.3.
+
+% ================================================================
+% Tracer Lateral Diffusion
+% ================================================================
+\section  [Tracer Lateral Diffusion (\textit{traldf})]
+		{Tracer Lateral Diffusion (\mdl{traldf})}
+\label{TRA_ldf}
+%-----------------------------------------nam_traldf------------------------------------------------------
+\namdisplay{namtra_ldf}
+%-------------------------------------------------------------------------------------------------------------
+ 
+The options available for lateral diffusion are a laplacian (rotated or not) 
+or a biharmonic operator, the latter being more scale-selective (more 
+diffusive at small scales). The specification of eddy diffusivity 
+coefficients (either constant or variable in space and time) as well as the 
+computation of the slope along which the operators act, are performed in the 
+\mdl{ldftra} and \mdl{ldfslp} modules, respectively. This is 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 term is solved implicitly together with the 
+vertical diffusion term (see \S\ref{DOM_nxt}).
+
+% -------------------------------------------------------------------------------------------------------------
+%        Iso-level laplacian operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Iso-level laplacian operator (lap) (\np{ln\_traldf\_lap})]
+			{Iso-level laplacian operator (lap) (\np{ln\_traldf\_lap}=true) }
+\label{TRA_ldf_lap}
+
+A laplacian diffusion operator ($i.e.$ a harmonic operator) acting along the model 
+surfaces is given by: 
+\begin{equation} \label{Eq_tra_ldf_lap}
+D_T^{lT} =\frac{1}{b_tT} \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. 
+It is implemented in the \mdl{traadv\_lap} module.
+
+This lateral operator is computed in \mdl{traldf\_lap}. 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}=true, we have 
+\np{ln\_traldf\_level}=true or \np{ln\_traldf\_hor}=\np{ln\_zco}=true. 
+In both cases, it significantly contributes to diapycnal mixing. 
+It is therefore not recommended.
+
+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   [Rotated laplacian operator (iso) (\np{ln\_traldf\_lap})]
+			{Rotated laplacian operator (iso) (\np{ln\_traldf\_lap}=true)}
+\label{TRA_ldf_iso}
+
+If the Griffies trad scheme is not employed
+(\np{ln\_traldf\_grif}=true; see App.\ref{sec:triad}) 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}. 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}.
+
+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}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Iso-level bilaplacian operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Iso-level bilaplacian operator (bilap) (\np{ln\_traldf\_bilap})]
+			{Iso-level bilaplacian operator (bilap) (\np{ln\_traldf\_bilap}=true)}
+\label{TRA_ldf_bilap}
+
+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. It is used when, in addition to \np{ln\_traldf\_bilap}=true, 
+we have \np{ln\_traldf\_level}=true, or both \np{ln\_traldf\_hor}=true and 
+\np{ln\_zco}=false. In both cases, it can contribute diapycnal mixing, 
+although less than in the laplacian case. It is therefore not recommended.
+
+Note that in the code, the bilaplacian routine does not call the laplacian 
+routine twice but is rather a separate routine that can be found in the
+\mdl{traldf\_bilap} module. This is due to the fact that we introduce the 
+eddy diffusivity coefficient, A, in the operator as: 
+$\nabla \cdot \nabla \left( {A\nabla \cdot \nabla T} \right)$, 
+instead of 
+$-\nabla \cdot a\nabla \left( {\nabla \cdot a\nabla T} \right)$ 
+where $a=\sqrt{|A|}$ and $A<0$. This was a mistake: both formulations 
+ensure the total variance decrease, but the former requires a larger 
+number of code-lines.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Rotated bilaplacian operator
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Rotated bilaplacian operator (bilapg) (\np{ln\_traldf\_bilap})]
+			{Rotated bilaplacian operator (bilapg) (\np{ln\_traldf\_bilap}=true)}
+\label{TRA_ldf_bilapg}
+
+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. It can be found in the
+\mdl{traldf\_bilapg}.
+
+It is used when, in addition to \np{ln\_traldf\_bilap}=true, we have 
+\np{ln\_traldf\_iso}= .true, or both \np{ln\_traldf\_hor}=true and \np{ln\_zco}=true. 
+This rotated bilaplacian operator has never been seriously 
+tested. There are no guarantees that it is either free of bugs or correctly formulated. 
+Moreover, the stability range of such an operator will be probably quite 
+narrow, requiring a significantly smaller time-step than the one used with an
+unrotated operator.
+
+% ================================================================
+% Tracer Vertical Diffusion
+% ================================================================
+\section  [Tracer Vertical Diffusion (\textit{trazdf})]
+		{Tracer Vertical Diffusion (\mdl{trazdf})}
+\label{TRA_zdf}
+%--------------------------------------------namzdf---------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+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.
+\sgacomment{ the following does not apply to the release to which this documentation is 
+attached and so should not be included ....
+In a forthcoming release, these two parts, computed in the surface module (SBC), will be included directly
+in $Q_{ns}$, the surface heat flux and $F_{salt}$, the surface salt flux.
+The specification of these fluxes is further detailed in the SBC chapter (see \S\ref{SBC}). 
+This change will provide a forcing formulation which is the same for any tracer (including temperature and salinity).
+ 
+In the current version, the situation is a little bit more complicated. }
+
+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})
+
+$\bullet$ \textit{emp}, the mass flux exchanged with the atmosphere (evaporation minus precipitation)
+
+$\bullet$ $\textit{emp}_S$, an equivalent mass flux taking into account the effect of ice-ocean mass exchange
+
+$\bullet$ \textit{rnf}, the mass flux associated with runoff (see \S\ref{SBC_rnf} for further detail of how it acts on temperature and salinity tendencies)
+
+The $\textit{emp}_S$ field is not simply the budget of evaporation-precipitation+freezing-melting because 
+the sea-ice is not currently embedded in the ocean but levitates above it. There is no mass
+exchanged between the sea-ice and the ocean. Instead we only take into account the salt
+flux associated with the non-zero salinity of sea-ice, and the concentration/dilution effect
+due to the freezing/melting (F/M) process. These two parts of the forcing are then converted into 
+an equivalent mass flux given by $\textit{emp}_S - \textit{emp}$. As a result of this mess, 
+the surface boundary condition on temperature and salinity is applied as follows:
+
+In the nonlinear free surface case (\key{vvl} is defined):
+\begin{equation} \label{Eq_tra_sbc}
+\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{emp}_S - \textit{emp})\;\left. S \right|_{k=1}  \right) }^t   & \\   
+ \end{aligned}
+\end{equation} 
+
+In the linear free surface case (\key{vvl} not defined):
+\begin{equation} \label{Eq_tra_sbc_lin}
+\begin{aligned}
+ &F^T = \frac{ 1 }{\rho _o \;C_p \,\left. e_{3t} \right|_{k=1} }  &\overline{ Q_{ns} }^t  & \\ 
+%
+& F^S =\frac{ 1 }{\rho _o \,\left. e_{3t} \right|_{k=1} } 
+           &\overline{ \left( \textit{emp}_S\;\left. S \right|_{k=1}  \right) }^t   & \\   
+ \end{aligned}
+\end{equation} 
+where $\overline{x }^t$ means that $x$ is averaged over two consecutive time steps 
+($t-\rdt/2$ and $t+\rdt/2$). Such time averaging prevents the 
+divergence of odd and even time step (see \S\ref{STP}).
+
+The two set of equations, \eqref{Eq_tra_sbc} and \eqref{Eq_tra_sbc_lin}, are obtained 
+by assuming that the temperature of precipitation and evaporation are equal to
+the ocean surface temperature and that their salinity is zero. Therefore, the heat content
+of the \textit{emp} budget must be added to the temperature equation in the variable volume case, 
+while it does not appear in the constant volume case. Similarly, the \textit{emp} budget affects 
+the ocean surface salinity in the constant volume case (through the concentration dilution effect)
+while it does not appears explicitly in the variable volume case since salinity change will be
+induced by volume change. In both constant and variable volume cases, surface salinity 
+will change with ice-ocean salt flux and F/M flux (both contained in $\textit{emp}_S - \textit{emp}$) without mass exchanges.
+
+Note that the concentration/dilution effect due to F/M is computed using
+a constant ice salinity as well as a constant ocean salinity. 
+This approximation suppresses the correlation between \textit{SSS} 
+and F/M flux, allowing the ice-ocean salt exchanges to be conservative.
+Indeed, if this approximation is not made, even if the F/M budget is zero 
+on average over the whole ocean domain and over the seasonal cycle, 
+the associated salt flux is not zero, since sea-surface salinity and F/M flux are 
+intrinsically correlated (high \textit{SSS} are found where freezing is 
+strong whilst low \textit{SSS} is usually associated with high melting areas).
+
+Even using this approximation, an exact conservation of heat and salt content 
+is only achieved in the variable volume case. In the constant volume case, 
+there is a small imbalance associated with the product $(\partial_t\eta - \textit{emp}) * \textit{SSS}$.
+Nevertheless, the salt content variation is quite small and will not induce
+a long term drift as there is no physical reason for $(\partial_t\eta - \textit{emp})$ 
+and \textit{SSS} to be correlated \citep{Roullet_Madec_JGR00}. 
+Note that, while quite small, the imbalance in the constant volume case is larger 
+than the imbalance associated with the Asselin time filter \citep{Leclair_Madec_OM09}. 
+This is the reason why the modified filter is not applied in the constant volume case.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Solar Radiation Penetration 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Solar Radiation Penetration (\textit{traqsr})]
+			{Solar Radiation Penetration (\mdl{traqsr})}
+\label{TRA_qsr}
+%--------------------------------------------namqsr--------------------------------------------------------
+\namdisplay{namtra_qsr}
+%--------------------------------------------------------------------------------------------------------------
+
+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). Three types of chlorophyll can be chosen in the RGB formulation:
+(1) a constant 0.05 g.Chl/L value everywhere (\np{nn\_chdta}=0) ; (2) an observed 
+time varying chlorophyll (\np{nn\_chdta}=1) ; (3) simulated time varying chlorophyll
+by TOP biogeochemical model (\np{ln\_qsr\_bio}=true). In the latter case, the RGB 
+formulation is used to calculate both the phytoplankton light limitation in PISCES 
+or LOBSTER and the oceanic heating rate. 
+
+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]{./TexFiles/Figures/Fig_TRA_Irradiance.pdf}
+\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{namtra_bbc}
+%--------------------------------------------------------------------------------------------------------------
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+\begin{figure}[!t] 	  \begin{center}
+\includegraphics[width=1.0\textwidth]{./TexFiles/Figures/Fig_TRA_geoth.pdf}
+\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}. 
+
+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}
+%--------------------------------------------------------------------------------------------------------------
+
+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]{./TexFiles/Figures/Fig_BBL_adv.pdf}
+\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). 
+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 initialized by the 
+user in routine \rou{dtacof} also located in module \mdl{tradmp}. 
+
+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 time scale 
+associated with $S_o$ is generally not a constant but spatially varying 
+in order to respect other properties. For example, it is usually set to zero 
+in the mixed layer (defined either on a density or $S_o$ criterion) 
+\citep{Madec_al_JPO96} and in the equatorial region 
+\citep{Reverdin1991, Fujio1991, Marti_PhD92} since these two regions 
+have a short time scale of adjustment; while smaller $\gamma$ are used 
+in the deep ocean where the typical time scale is long \citep{Sarmiento1982}. 
+In addition the time scale is reduced (even to zero) along the western 
+boundary to allow the model to reconstruct its own western boundary 
+structure in equilibrium with its physics. 
+The choice of the shape of the Newtonian damping is controlled by two 
+namelist parameters \np{nn\_hdmp} and \np{nn\_zdmp}. The former allows us to specify: the 
+width of the equatorial band in which no damping is applied; a decrease 
+in the vicinity of the coast; and a damping everywhere in the Red and Med Seas.
+The latter sets whether damping should act in the mixed layer or not. 
+The time scale associated with the damping depends on the depth as
+a hyperbolic tangent, with \np{rn\_surf} as surface value, \np{rn\_bot} as 
+bottom value and a transition depth of \np{rn\_dep}.  
+
+The 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.
+
+An example of the computation of $\gamma$ for a robust diagnostic experiment 
+with the ORCA2 model is provided in the \mdl{tradmp} module 
+(subroutines \rou{dtacof} and \rou{cofdis} which compute the coefficient 
+and the distance to the bathymetry, respectively). These routines are 
+provided as examples and can be customised by the user. 
+
+% ================================================================
+% Tracer time evolution
+% ================================================================
+\section  [Tracer time evolution (\textit{tranxt})]
+		{Tracer time evolution (\mdl{tranxt})}
+\label{TRA_nxt}
+%--------------------------------------------namdom-----------------------------------------------------
+\namdisplay{namdom}
+%--------------------------------------------------------------------------------------------------------------
+
+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 State (\np{nn\_eos} = 0, 1 or 2)}
+\label{TRA_eos}
+
+It is necessary to know the equation of state for the ocean very accurately 
+to determine stability properties (especially the Brunt-Vais\"{a}l\"{a} frequency), 
+particularly in the deep ocean. The ocean seawater volumic mass, $\rho$, 
+abusively called density, is a non linear empirical function of \textit{in situ} 
+temperature, salinity and pressure. The reference equation of state is that 
+defined by the Joint Panel on Oceanographic Tables and Standards 
+\citep{UNESCO1983}. It was the standard equation of state used in early 
+releases of OPA. However, even though this computation is fully vectorised, 
+it is quite time consuming ($15$ to $20${\%} of the total CPU time) since 
+it requires the prior computation of the \textit{in situ} temperature from the 
+model \textit{potential} temperature using the \citep{Bryden1973} polynomial 
+for adiabatic lapse rate and a $4^th$ order Runge-Kutta integration scheme. 
+Since OPA6, we have used the \citet{JackMcD1995} equation of state for 
+seawater instead. It allows the computation of the \textit{in situ} ocean density 
+directly as a function of \textit{potential} temperature relative to the surface 
+(an \NEMO variable), the practical salinity (another \NEMO variable) and the 
+pressure (assuming no pressure variation along geopotential surfaces, $i.e.$ 
+the pressure in decibars is approximated by the depth in meters). 
+Both the \citet{UNESCO1983} and \citet{JackMcD1995} equations of state 
+have exactly the same except that the values of the various coefficients have 
+been adjusted by \citet{JackMcD1995} in order to directly use the \textit{potential} 
+temperature instead of the \textit{in situ} one. This reduces the CPU time of the 
+\textit{in situ} density computation to about $3${\%} of the total CPU time, 
+while maintaining a quite accurate equation of state.
+
+In the computer code, a \textit{true} density anomaly, $d_a= \rho / \rho_o - 1$, 
+is computed, with $\rho_o$ a reference volumic mass. Called \textit{rau0} 
+in the code, $\rho_o$ is defined in \mdl{phycst}, and a value of $1,035~Kg/m^3$. 
+This is a sensible choice for the reference density used in a Boussinesq ocean 
+climate model, as, with the exception of only a small percentage of the ocean, 
+density in the World Ocean varies by no more than 2$\%$ from $1,035~kg/m^3$ 
+\citep{Gill1982}.
+
+The default option (namelist parameter \np{nn\_eos}=0) is the \citet{JackMcD1995} 
+equation of state. Its use is highly recommended. However, for process studies, 
+it is often convenient to use a linear approximation of the density.
+With such an equation of state there is no longer a distinction between 
+\textit{in situ} and \textit{potential} density and both cabbeling and thermobaric
+effects are removed.
+Two linear formulations are available: a function of $T$ only (\np{nn\_eos}=1) 
+and a function of both $T$ and $S$ (\np{nn\_eos}=2):
+\begin{equation} \label{Eq_tra_eos_linear}
+\begin{split}
+  d_a(T)       &=  \rho (T)      /  \rho_o   - 1     =  \  0.0285         -  \alpha   \;T     \\ 
+  d_a(T,S)    &=  \rho (T,S)   /  \rho_o   - 1     =  \  \beta \; S       -  \alpha   \;T    
+\end{split}
+\end{equation} 
+where $\alpha$ and $\beta$ are the thermal and haline expansion 
+coefficients, and $\rho_o$, the reference volumic mass, $rau0$. 
+($\alpha$ and $\beta$ can be modified through the \np{rn\_alpha} and 
+\np{rn\_beta} namelist parameters). Note that when $d_a$ is a function 
+of $T$ only (\np{nn\_eos}=1), the salinity is a passive tracer and can be 
+used as such.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Brunt-Vais\"{a}l\"{a} Frequency
+% -------------------------------------------------------------------------------------------------------------
+\subsection{Brunt-Vais\"{a}l\"{a} Frequency (\np{nn\_eos} = 0, 1 or 2)}
+\label{TRA_bn2}
+
+An accurate computation of the ocean stability (i.e. of $N$, the brunt-Vais\"{a}l\"{a}
+ frequency) is of paramount importance as it is used in several ocean 
+ parameterisations (namely TKE, KPP, Richardson number dependent 
+ vertical diffusion, enhanced vertical diffusion, non-penetrative convection, 
+ iso-neutral diffusion). In particular, one must be aware that $N^2$ has to 
+ be computed with an \textit{in situ} reference. The expression for $N^2$ 
+ depends on the type of equation of state used (\np{nn\_eos} namelist parameter).
+
+For \np{nn\_eos}=0 (\citet{JackMcD1995} equation of state), the \citet{McDougall1987} 
+polynomial expression is used (with the pressure in decibar approximated by 
+the depth in meters): 
+\begin{equation} \label{Eq_tra_bn2}
+N^2 = \frac{g}{e_{3w}} \; \beta   \ 
+	   \left(  \alpha / \beta \ \delta_{k+1/2}[T]     - \delta_{k+1/2}[S]   \right) 
+\end{equation} 
+where $\alpha$ and $\beta$ are the thermal and haline expansion coefficients. 
+They are a function of  $\overline{T}^{\,k+1/2},\widetilde{S}=\overline{S}^{\,k+1/2} - 35.$, 
+and  $z_w$, with $T$ the \textit{potential} temperature and $\widetilde{S}$ a salinity anomaly. 
+Note that both $\alpha$ and $\beta$ depend on \textit{potential} 
+temperature and salinity which are averaged at $w$-points prior 
+to the computation instead of being computed at $T$-points and 
+then averaged to $w$-points.
+
+When a linear equation of state is used (\np{nn\_eos}=1 or 2, 
+\eqref{Eq_tra_bn2} reduces to:
+\begin{equation} \label{Eq_tra_bn2_linear}
+N^2 =	\frac{g}{e_{3w}} \left(   \beta \;\delta_{k+1/2}[S] - \alpha \;\delta_{k+1/2}[T]   \right)
+\end{equation} 
+where $\alpha$ and $\beta $ are the constant coefficients used to 
+defined the linear equation of state \eqref{Eq_tra_eos_linear}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        Specific Heat
+% -------------------------------------------------------------------------------------------------------------
+\subsection   	[Specific Heat (\textit{phycst})]
+			{Specific Heat (\mdl{phycst})}
+\label{TRA_adv_ldf}
+
+The specific heat of sea water, $C_p$, is a function of temperature, salinity 
+and pressure \citep{UNESCO1983}. It is only used in the model to convert 
+surface heat fluxes into surface temperature increase and so the pressure 
+dependence is neglected. The dependence on $T$ and $S$ is weak. 
+For example, with $S=35~psu$, $C_p$ increases from $3989$ to $4002$ 
+when $T$ varies from -2~\degres C to 31~\degres C. Therefore, $C_p$ has 
+been chosen as a constant: $C_p=4.10^3~J\,Kg^{-1}\,\degres K^{-1}$. 
+Its value is set in \mdl{phycst} module. 
+
+
+% -------------------------------------------------------------------------------------------------------------
+%        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{tfreez}, a \textsc{Fortran} function that can be found 
+in \mdl{eosbn2}.  
+
+% ================================================================
+% 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 bottom cells (\np{ln\_zps}=true), in general, tracers in horizontally 
+adjacent cells live at different depths. Horizontal gradients of tracers are needed 
+for horizontal diffusion (\mdl{traldf} module) and for the hydrostatic pressure 
+gradient (\mdl{dynhpg} module) to be active. 
+\gmcomment{STEVEN from gm : question: not sure of  what -to be active- means}
+Before taking horizontal gradients between the tracers next to the bottom, a linear 
+interpolation in the vertical is used to approximate the deeper tracer as if it actually 
+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]{./TexFiles/Figures/Partial_step_scheme.pdf}
+\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}
+%%%
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ZDF.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Chap_ZDF.tex	(revision 3437)
@@ -0,0 +1,1242 @@
+% ================================================================
+% 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 KPP formulation). The computation of these coefficients is initialized 
+in the \mdl{zdfini} module and performed in the \mdl{zdfric}, \mdl{zdftke} or 
+\mdl{zdfkpp} modules. The trends due to the vertical momentum and tracer 
+diffusion, including the surface forcing, are computed and added to the 
+general trend in the \mdl{dynzdf} and \mdl{trazdf} modules, respectively. 
+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}
+%--------------------------------------------------------------------------------------------------------------
+
+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. 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 dendity $ \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*}
+The choice of $P_{rt}$ is controlled by the \np{nn\_pdl} namelist parameter.
+
+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]{./TexFiles/Figures/Fig_mixing_length.pdf}
+\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\_lmin0} namelist 
+parameter. Usually the surface scale is given by $l_o = \kappa \,z_o$ 
+where $\kappa = 0.4$ is von Karman's constant and $z_o$ the roughness 
+parameter of the surface. Assuming $z_o=0.1$~m \citep{Craig_Banner_JPO94} 
+leads to a 0.04~m, the default value of \np{rn\_lsurf}. In the ocean interior 
+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\_lsurf} to true applies \eqref{ZDF_Lsbc} 
+as surface boundary condition on length scale, with $\beta$ hard coded to the Stacet'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}
+%--------------------------------------------------------------%
+
+To be add here a description of "penetration of TKE" and the associated namelist parameters
+ \np{nn\_etau}, \np{rn\_efr} and \np{nn\_htau}.
+
+% 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]{./TexFiles/Figures/Fig_ZDF_TKE_time_scheme.pdf}
+\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 parameter.}
+\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}.
+
+% -------------------------------------------------------------------------------------------------------------
+%        K Profile Parametrisation (KPP) 
+% -------------------------------------------------------------------------------------------------------------
+\subsection{K Profile Parametrisation (KPP) (\key{zdfkpp}) }
+\label{ZDF_kpp}
+
+%--------------------------------------------namkpp--------------------------------------------------------
+\namdisplay{namzdf_kpp}
+%--------------------------------------------------------------------------------------------------------------
+
+The KKP scheme has been implemented by J. Chanut ...
+
+\colorbox{yellow}{Add a description of KPP here.}
+
+
+% ================================================================
+% 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]{./TexFiles/Figures/Fig_npc.pdf}
+\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}
+%>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+The non-penetrative convective adjustment is used when \np{ln\_zdfnpc}=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 potential 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}.
+
+Note that in the current implementation of this algorithm presents several 
+limitations. First, potential density referenced to the sea surface is used to 
+check whether the density profile is stable or not. This is a strong 
+simplification which leads to large errors for realistic ocean simulations. 
+Indeed, many water masses of the world ocean, especially Antarctic Bottom
+Water, are unstable when represented in surface-referenced potential density. 
+The scheme will erroneously mix them up. Second, the mixing of potential 
+density is assumed to be linear. This assures the convergence of the algorithm 
+even when the equation of state is non-linear. Small static instabilities can thus 
+persist due to cabbeling: they will be treated at the next time step. 
+Third, temperature and salinity, and thus density, are mixed, but the 
+corresponding velocity fields remain unchanged. When using a Richardson 
+Number dependent eddy viscosity, the mixing of momentum is done through 
+the vertical diffusion: after a static adjustment, the Richardson Number is zero 
+and thus the eddy viscosity coefficient is at a maximum. When this convective 
+adjustment algorithm is used with constant vertical eddy viscosity, spurious 
+solutions can occur since the vertical momentum diffusion remains small even 
+after a static adjustment. In that case, we recommend the addition of momentum 
+mixing in a manner that mimics the mixing in temperature and salinity 
+\citep{Speich_PhD92, Speich_al_JPO96}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       Enhanced Vertical Diffusion 
+% -------------------------------------------------------------------------------------------------------------
+\subsection   [Enhanced Vertical Diffusion (\np{ln\_zdfevd})]
+			{Enhanced Vertical Diffusion (\np{ln\_zdfevd}=true)}
+\label{ZDF_evd}
+
+%--------------------------------------------namzdf--------------------------------------------------------
+\namdisplay{namzdf}
+%--------------------------------------------------------------------------------------------------------------
+
+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}
+%--------------------------------------------------------------------------------------------------------------
+
+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]{./TexFiles/Figures/Fig_zdfddm.pdf}
+\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 Friction (\textit{zdfbfr})]   {Bottom Friction (\mdl{zdfbfr} module)}
+\label{ZDF_bfr}
+
+%--------------------------------------------nambfr--------------------------------------------------------
+\namdisplay{nambfr}
+%--------------------------------------------------------------------------------------------------------------
+
+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\_bfric1} (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\_bfric1}. 
+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\_bfric1}.
+
+% -------------------------------------------------------------------------------------------------------------
+%       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\_bfric2} 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). 
+See previous section for details.
+
+% -------------------------------------------------------------------------------------------------------------
+%       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}
+
+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]{./TexFiles/Figures/Fig_ZDF_M2_K1_tmx.pdf}
+\caption{  \label{Fig_ZDF_M2_K1_tmx} 
+(a) M2 and (b) K2 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 \ref{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. \ref{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 sugnificant impact on the behaviour 
+of global coupled GCMs \citep{Koch-Larrouy_al_CD10}.
+
+
+% ================================================================
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Introduction.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Introduction.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Chapters/Introduction.tex	(revision 3437)
@@ -0,0 +1,218 @@
+
+% ================================================================
+% 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.locean-ipsl.upmc.fr/NEMO). 
+
+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 atmosphere. A complete list of references is found on the 
+\NEMO web site. 
+
+This manual is organised in as follows. Chapter~\ref{PE} presents the model basics, 
+$i.e.$ the equations and their assumptions, the vertical coordinates used, and the 
+subgrid scale physics. This part deals with the continuous equations of the model 
+(primitive equations, with potential temperature, salinity and an equation of state). 
+The equations are written in a curvilinear coordinate system, with a choice of vertical 
+coordinates ($z$ or $s$, with the rescaled height coordinate formulation \textit{z*}, or  
+\textit{s*}). Momentum equations are formulated in the vector invariant form or in the 
+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}) is now 
+available although this is currently only designed for global domains, without the use of AGRIF.
+
+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{Large_al_RG94}, \citet{Pacanowski_Philander_JPO81}, 
+or \citet{Umlauf_Burchard_JMS03} mixing schemes.
+
+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}
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/NEMO.ist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/NEMO.ist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/NEMO.ist	(revision 3437)
@@ -0,0 +1,3 @@
+delim_0 "\\dotfill"
+delim_1 "\\dotfill"
+delim_2 "\\dotfill"
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nam_tide
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nam_tide	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nam_tide	(revision 3437)
@@ -0,0 +1,22 @@
+!-----------------------------------------------------------------------
+!       nam_tide       tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+!  ln_tide_pot    = use tidal potential forcing
+!  nb_harmo    = number of constituents used
+!  name(1)     = 'M2', 'K1', etc name of constituent
+
+&nam_tide
+   ln_tide_pot           = .true.
+   nb_harmo    = 11
+   clname(1)     =   'M2'
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namagrif
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namagrif	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namagrif	(revision 3437)
@@ -0,0 +1,8 @@
+!-----------------------------------------------------------------------
+&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]
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namasm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namasm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namasm	(revision 3437)
@@ -0,0 +1,20 @@
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    ndivdmp   = 0          !  Number of iterations of divergence damping operator
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambbl
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambbl	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambbl	(revision 3437)
@@ -0,0 +1,8 @@
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy	(revision 3437)
@@ -0,0 +1,23 @@
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 2                               !  number of open boundary sets       
+    ln_coords_file = .true.,.false.          !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc','' !  bdy coordinates files
+    ln_mask_file = .false.                   !  =T : read mask from file
+    cn_mask_file = ''                        !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2, 0                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3, 0                    !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+                                             !  = 2, use tidal harmonic forcing data from files
+                                             !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0, 0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0, 0                    !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1, 1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1, 1                    !  = 0, bdy data are equal to the initial state
+                                             !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10, 5                     !  width of the relaxation zone
+    ln_vol     = .false.                     !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                           !  = 0, the total water flux across open boundaries is zero
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   cn_dir  =    'bdydta/'
+   ln_full_vel = .false.
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_dta2	(revision 3437)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   bn_tem  =    'amm12_bdyT_clim' ,         -1        , 'votemper' ,     .true.     , .true. ,  'daily'  ,    ''    ,   ''
+   bn_sal  =    'amm12_bdyT_clim' ,         -1        , 'vosaline' ,     .true.     , .true. ,  'daily'  ,    ''    ,   ''
+   cn_dir  =    'bdydta/'
+   ln_full_vel = .false.
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_index
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_index	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_index	(revision 3437)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&nambdy_index    !  open boundaries - definition           ("key_bdy")
+!-----------------------------------------------------------------------
+    nbdysege = 0
+    nbdysegw = 1
+    jpiwob = 2
+    jpjwdt = 2
+    jpjwft = 191
+    nbdysegn = 1
+    jpjnob = 191
+    jpindt = 2
+    jpinft = 146
+    nbdysegs = 1
+    jpjsob = 2
+    jpisdt = 2
+    jpisft = 43
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_tide
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_tide	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambdy_tide	(revision 3437)
@@ -0,0 +1,36 @@
+!-----------------------------------------------------------------------
+&nambdy_tide     ! tidal forcing at open boundaries              
+!-----------------------------------------------------------------------
+   filtide      = 'bdydta/amm12_bdytide_'         !  file name root of tidal forcing files
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambfr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambfr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nambfr	(revision 3437)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .false.   !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namcla
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namcla	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namcla	(revision 3437)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namctl
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namctl	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namctl	(revision 3437)
@@ -0,0 +1,14 @@
+!-----------------------------------------------------------------------
+&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)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdct
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdct	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdct	(revision 3437)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    nn_dct      = 15       !  time step frequency for transports computing
+    nn_dctwri   = 15       !  time step frequency for transports writing
+    nn_secdebug =  0       !      0 : no section to debug
+                           !     -1 : debug all section
+                           !  0 < n : debug section number n
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdia_harm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdia_harm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdia_harm	(revision 3437)
@@ -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=105         ! Last time step used for harmonic analysis
+    nstep_han=1            ! Time step frequency for harmonic analysis
+    nb_ana=1               ! Number of harmonics to analyse
+    tname(1)='M2'          ! Name of tidal constituents
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdom
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdom	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdom	(revision 3437)
@@ -0,0 +1,19 @@
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_adv
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_adv	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_adv	(revision 3437)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&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 
+/  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_hpg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_hpg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_hpg	(revision 3437)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_ldf
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_ldf	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_ldf	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_nept
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_nept	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_nept	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&nam_dynnept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_spg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_spg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_spg	(revision 3437)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+!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")
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_vor
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_vor	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namdyn_vor	(revision 3437)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&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  
+   ln_dynvor_con = .false. !  consistency of BC with analytical eqs.
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nameos
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nameos	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nameos	(revision 3437)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namflo
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namflo	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namflo	(revision 3437)
@@ -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_ascii   = .true.     !  Output with Ariane tool netcdf convention(T) or ascii file (F)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namhsb
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namhsb	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namhsb	(revision 3437)
@@ -0,0 +1,5 @@
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namlbc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namlbc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namlbc	(revision 3437)
@@ -0,0 +1,6 @@
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp	(revision 3437)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&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
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp_dyndist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp_dyndist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/nammpp_dyndist	(revision 3437)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+   jpni        =    1      !  jpni   number of processors following i
+   jpnj        =    1      !  jpnj   number of processors following j
+   jpnij       =    1      !  jpnij  number of local domains
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namnc4
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namnc4	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namnc4	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobc	(revision 3437)
@@ -0,0 +1,21 @@
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs	(revision 3437)
@@ -0,0 +1,63 @@
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs_example
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs_example	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namobs_example	(revision 3437)
@@ -0,0 +1,63 @@
+!-----------------------------------------------------------------------
+!       namobs    observation usage switch
+!-----------------------------------------------------------------------
+!
+!  ln_t3d                  Logical switch for T profile observations         
+!  ln_s3d                  Logical switch for S profile observations          
+!  ln_ena                  Logical switch for ENACT insitu data set           
+!  ln_cor                  Logical switch for Coriolis insitu data set       
+!  ln_profb                Logical switch for feedback insitu data set     
+!  ln_sla                  Logical switch for SLA observations               
+!  ln_sladt                Logical switch for AVISO SLA data              
+!  ln_slafb                Logical switch for feedback SLA data            
+!  ln_ssh                  Logical switch for SSH observations              
+!  ln_sst                  Logical switch for SST observations              
+!  ln_reysst               Logical switch for Reynolds observations       
+!  ln_ghrsst               Logical switch for GHRSST observations          
+!  ln_sstfb                Logical switch for feedback SST data          
+!  ln_sss                  Logical switch for SSS observations              
+!  ln_seaice               Logical switch for Sea Ice observations        
+!  ln_vel3d                Logical switch for velocity observations         
+!  ln_velavcur             Logical switch for velocity daily av. cur.    
+!  ln_velhrcur             Logical switch for velocity high freq. cur.   
+!  ln_velavadcp            Logical switch for velocity daily av. ADCP  
+!  ln_velhradcp            Logical switch for velocity high freq. ADCP
+!  ln_velfb                Logical switch for feedback velocity data       
+!  ln_grid_global          Global distribtion of observations         
+!  ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+!  grid_search_file        Grid search lookup file header 
+!  enactfiles              ENACT input observation file names 
+!  coriofiles              Coriolis input observation file name  
+!  profbfiles              Profile feedback input observation file name 
+!  ln_profb_enatim         Enact feedback input time setting switch    
+!  slafilesact             Active SLA input observation file name
+!  slafilespas             Passive SLA input observation file name 
+!  slafbfiles              Feedback SLA input observation file name 
+!  sstfiles                GHRSST input observation file name       
+!  sstfbfiles              Feedback SST input observation file name 
+!  seaicefiles             Sea Ice input observation file name 
+!  velavcurfiles           Vel. cur. daily av. input file name  
+!  velhvcurfiles           Vel. cur. high freq. input file name  
+!  velavadcpfiles          Vel. ADCP daily av. input file name    
+!  velhvadcpfiles          Vel. ADCP high freq. input file name 
+!  velfbfiles              Vel. feedback input observation file name 
+!  dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+!  dobsend                 Final date in window YYYYMMDD.HHMMSS         
+!  n1dint                  Type of vertical interpolation method        
+!  n2dint                  Type of horizontal interpolation method       
+!  ln_nea                  Rejection of observations near land switch    
+!  nmsshc                  MSSH correction scheme                         
+!  mdtcorr                 MDT  correction                               
+!  mdtcutoff               MDT cutoff for computed correction          
+!  ln_altbias              Logical switch for alt bias                
+!  ln_ignmis               Logical switch for ignoring missing files   
+!  endailyavtypes          ENACT daily average types                    
+ &namobs
+   ln_t3d = .true.
+   ln_s3d = .true.
+   ln_ena = .true.
+   enactfiles = 'enact.1.nc'
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .true.
+   ln_ignmis = .true.  
+/ 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namptr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namptr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namptr	(revision 3437)
@@ -0,0 +1,11 @@
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namrun
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namrun	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namrun	(revision 3437)
@@ -0,0 +1,25 @@
+!-----------------------------------------------------------------------
+&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_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+       !  = 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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc	(revision 3437)
@@ -0,0 +1,24 @@
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_alb
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_alb	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_alb	(revision 3437)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ana
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ana	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ana	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_apr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_apr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_apr	(revision 3437)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_clio
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_clio	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_clio	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_core
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_core	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_core	(revision 3437)
@@ -0,0 +1,20 @@
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_cpl
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_cpl	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_cpl	(revision 3437)
@@ -0,0 +1,23 @@
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_flx
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_flx	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_flx	(revision 3437)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_mfs
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_mfs	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_mfs	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     =   'ecmwf'   ,        6          , 'u10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_wndj     =   'ecmwf'   ,        6          , 'v10'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_clc      =   'ecmwf'   ,        6          , 'clc'     ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_msl      =   'ecmwf'   ,        6          , 'msl'     ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_tair     =   'ecmwf'   ,        6          , 't2'      ,    .true.    , .false. , 'daily'  ,'bicubic.nc' , ''
+   sn_rhm      =   'ecmwf'   ,        6          , 'rh'      ,    .true.    , .false. , 'daily'  ,'bilinear.nc', ''
+   sn_prec     =   'precip'  ,        6          , 'precip'  ,    .true.    , .false. , 'daily'  ,'bicubic'    , ''
+
+   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_rnf
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_rnf	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_rnf	(revision 3437)
@@ -0,0 +1,21 @@
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ssr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ssr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_ssr	(revision 3437)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+/      
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_wave
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_wave	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsbc_wave	(revision 3437)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.    , .false. , 'daily'  , ''       , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsol
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsol	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namsol	(revision 3437)
@@ -0,0 +1,13 @@
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_adv
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_adv	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_adv	(revision 3437)
@@ -0,0 +1,10 @@
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_bbc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_bbc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_bbc	(revision 3437)
@@ -0,0 +1,9 @@
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_dmp
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_dmp	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_dmp	(revision 3437)
@@ -0,0 +1,15 @@
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_ldf
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_ldf	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_ldf	(revision 3437)
@@ -0,0 +1,24 @@
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_qsr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_qsr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtra_qsr	(revision 3437)
@@ -0,0 +1,17 @@
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      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
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtrd
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtrd	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtrd	(revision 3437)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtsd
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtsd	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namtsd	(revision 3437)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&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  !
+   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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ddm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ddm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ddm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_gls
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_gls	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_gls	(revision 3437)
@@ -0,0 +1,18 @@
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_kpp
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_kpp	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_kpp	(revision 3437)
@@ -0,0 +1,13 @@
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ric
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ric	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_ric	(revision 3437)
@@ -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 mized layer depth param.
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tke
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tke	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tke	(revision 3437)
@@ -0,0 +1,27 @@
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
+   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
+   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tmx
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tmx	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzdf_tmx	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr	(revision 3437)
@@ -0,0 +1,7 @@
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr_sco
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr_sco	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/Namelist/namzgr_sco	(revision 3437)
@@ -0,0 +1,12 @@
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/ametsoc.bst
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/ametsoc.bst	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/ametsoc.bst	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/clean.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/clean.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/clean.sh	(revision 3437)
@@ -0,0 +1,2 @@
+rm -f $( ls -1 NEMO_book.* | egrep -v "(tex|pdf)" ) *mpgraph*
+rm -f Chapters/*.aux Chapters/*.log
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/math_abbrev.sty
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/math_abbrev.sty	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/DOC/TexFiles/math_abbrev.sty	(revision 3437)
@@ -0,0 +1,32 @@
+\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{\degres}                            % degrees  (NB: \r{} can % % also be used)
+\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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ALTIX_JADE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ALTIX_JADE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ALTIX_JADE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-BG_BABEL.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-BG_BABEL.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-BG_BABEL.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-IA64_PLATINE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-IA64_PLATINE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-IA64_PLATINE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6MONO_VARGAS.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6MONO_VARGAS.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6MONO_VARGAS.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6_VARGAS.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6_VARGAS.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-PW6_VARGAS.fcm	(revision 3437)
@@ -0,0 +1,29 @@
+# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/pub/NetCDF/3.6.2/include
+%NCDF_LIB            -L /usr/local/pub/NetCDF/3.6.2/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qfree=f90 -O3 -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                  mpxlf90_r
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             rs
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_BRODIE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_BRODIE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_BRODIE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_MERCURE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_MERCURE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX8_MERCURE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_ES2.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_ES2.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_ES2.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_MERCURE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_MERCURE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-SX9_MERCURE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-TX7_ULAM.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-TX7_ULAM.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-TX7_ULAM.fcm	(revision 3437)
@@ -0,0 +1,29 @@
+# ulam IBM X3950 M2 at french IDRIS, http://www.idris.fr/su/Scalaire/ulam/hw-ulam.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/TXlocal/pub/netcdf/netcdf-3.6.2/include
+%NCDF_LIB            -L/TXlocal/pub/netcdf/netcdf-3.6.2/lib -lnetcdf
+%FC                  gfortran
+%FCFLAGS             -fdefault-real-8
+%FFLAGS              %FCFLAGS 
+%LD                  gfortran
+%LDFLAGS    
+%FPPFLAGS            -P -C
+%AR                  ar  
+%ARFLAGS             -r
+%MK                  gmake 
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_CURIE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_CURIE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_CURIE.fcm	(revision 3437)
@@ -0,0 +1,31 @@
+# Curie BULL at french TGCC, http://www-hpc.cea.fr/en/complexe/tgcc-curie.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
+# for Curie Fat Node
+%FCFLAGS             -i4 -r8 -fast -xSSE4.2 -automatic
+# for Curie Thin Node
+#%FCFLAGS             -i4 -r8 -fast -xAVX   -automatic
+%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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_TITANE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_TITANE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X64_TITANE.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X86_CESIUM.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X86_CESIUM.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-X86_CESIUM.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ifort_CICLAD.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ifort_CICLAD.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-ifort_CICLAD.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-macport_osx.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-macport_osx.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/CNRS/arch-macport_osx.fcm	(revision 3437)
@@ -0,0 +1,36 @@
+# generic gfortran compiler options for OSX installed with macport
+#
+# port packages needed:
+#    sudo port install netcdf +gcc45 +openmpi
+#    sudo port install p5-uri
+# add to your PATH /opt/local/lib/openmpi/bin
+#
+# 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/local/include
+%NCDF_LIB            -L/opt/local/lib -lnetcdf -lnetcdff
+%FC	             mpif90 
+%FCFLAGS             -fdefault-real-8 -O3 -funroll-all-loops -fcray-pointer 
+%FFLAGS              %FCFLAGS
+%LD                  %FC
+%LDFLAGS
+%FPPFLAGS            -P -C -traditional
+%AR                  libtool
+%ARFLAGS             -c -s -o
+%MK                  make
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_MPT.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_MPT.fcm	(revision 3437)
@@ -0,0 +1,38 @@
+# ifort compiler options for NOCS ALTIX cluster nautilus using NetCDF4 libraries
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_HOME           /noc/users/jeff/packages/netcdf4/netcdf-4.1.1/x86_64/intel10.1
+%HDF5_HOME           /noc/users/jeff/packages/hdf5/hdf5-1.8.4-patch1/x86_64/intel10.1
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+# Note use of -Bstatic because the library root directories are not accessible to the back-end compute nodes
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -Bdynamic -lz
+%FC                  ifort
+%FCFLAGS             -r8 -O3 -xT -ip -vec-report0
+%FFLAGS              -r8 -O3 -xT -ip -vec-report0
+%LD                  ifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -lmpi
+%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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_SETTE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_SETTE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-ALTIX_NAUTILUS_SETTE.fcm	(revision 3437)
@@ -0,0 +1,34 @@
+# ifort compiler options for NOCS ALTIX cluster nautilus using NetCDF4 libraries and minimal optimisation for the purposes of SETTE testing
+# NCDF_HOME   root directory containing lib and include subdirectories for netcdf4
+# HDF5_HOME   root directory containing lib and include subdirectories for HDF5
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir>
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_HOME           /noc/users/jeff/packages/netcdf4/netcdf-4.1.1/x86_64/intel10.1
+%HDF5_HOME           /noc/users/jeff/packages/hdf5/hdf5-1.8.4-patch1/x86_64/intel10.1
+%NCDF_INC            -I%NCDF_HOME/include -I%HDF5_HOME/include
+# Note use of -Bstatic because the library root directories are not accessible to the back-end compute nodes
+%NCDF_LIB            -L%HDF5_HOME/lib -L%NCDF_HOME/lib -Bstatic -lnetcdf -lhdf5_fortran -lhdf5_hl -lhdf5 -Bdynamic -lz
+%FC                  ifort
+%FCFLAGS             -r8 -O0
+%FFLAGS              -r8 -O0
+%LD                  ifort
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -lmpi
+%AR                  ar 
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-XT6_HECTORcrayftn.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-XT6_HECTORcrayftn.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-XT6_HECTORcrayftn.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-pgf90_mobius.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-pgf90_mobius.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/NOC/arch-pgf90_mobius.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_C1A.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_C1A.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_C1A.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_CALYPSO.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_CALYPSO.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_CALYPSO.fcm	(revision 3437)
@@ -0,0 +1,29 @@
+# vargas IBM POWER6 at french IDRIS, http://www.idris.fr/su/Scalaire/vargas/hw-vargas.html
+# NCDF_INC    netcdf include file
+# NCDF_LIB    netcdf library
+# FC          Fortran compiler command
+# FCFLAGS     Fortran compiler flags
+# FFLAGS      Fortran 77 compiler flags
+# LD          linker
+# LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
+# FPPFLAGS    pre-processing flags
+# AR          assembler
+# ARFLAGS     assembler flags
+# MK          make  
+# USER_INC    additional include files for the compiler,  e.g. -I<include dir> 
+# USER_LIB    additional libraries to pass to the linker, e.g. -l<library>
+
+
+%NCDF_INC            -I/usr/local/netcdf-3.6.3/include
+%NCDF_LIB            -L/usr/local/netcdf-3.6.3/lib -lnetcdf
+%FC                  mpxlf90_r
+%FCFLAGS             -qstrict -qfree=f90 -g -O3 -qrealsize=8 -qextname -qsource -q64 -qlargepage -qmaxmem=-1
+%FFLAGS              -qstrict -qfixed -g -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_METO.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_METO.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-PW6_METO.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-XT6_HECTOR.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_osx.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_osx.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-g95_osx.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_osx.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_osx.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-gfortran_osx.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_MERCATOR_CLUSTER.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_MERCATOR_CLUSTER.fcm	(revision 3437)
@@ -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>
+# debug: -g  -check bounds -check uninit -check pointers -traceback 
+
+%NCDF_INC            -I$(NETCDF_INC)
+%NCDF_LIB            -L $(NETCDF_LIB) -lnetcdf
+%FC                  mpif90
+%FCFLAGS             -assume byterecl  -convert big_endian -i4 -r8 -automatic -align all -O3
+%FFLAGS              %FCFLAGS
+%LD                  mpif90
+%FPPFLAGS            -P -C -traditional
+%LDFLAGS             -O2 -shared-intel 
+%AR                  ar
+%ARFLAGS             -r
+%MK                  gmake
+%USER_INC            %NCDF_INC
+%USER_LIB            %NCDF_LIB
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux_omp.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux_omp.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_linux_omp.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_osx.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_osx.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-ifort_osx.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-lahey_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-lahey_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-lahey_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-mpxlf_aix.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-mpxlf_aix.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-mpxlf_aix.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-nag_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-nag_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-nag_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pathscale_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pathscale_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pathscale_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pgf90_linux.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pgf90_linux.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-pgf90_linux.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_aix.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_aix.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_aix.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_osx.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_osx.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_osx.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_pwr6.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_pwr6.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/ARCH/arch-xlf_pwr6.fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,1226 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+	<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+	<field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+
+        <!-- tidal composante -->
+        <field id="M2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="M2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="S2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="S2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="N2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="N2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="K1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="K1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="O1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="O1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="Q1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="Q1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="M4x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="M4y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="K2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="K2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="P1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="P1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="Mfx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="Mfy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+        <field id="Mmx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+        <field id="Mmy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+
+        <field id="M2x_u"          description="M2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="M2y_u"          description="M2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="S2x_u"          description="S2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="S2y_u"          description="S2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="N2x_u"          description="N2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="N2y_u"          description="N2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="K1x_u"          description="K1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="K1y_u"          description="K1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="O1x_u"          description="O1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="O1y_u"          description="O1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Q1x_u"          description="Q1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="Q1y_u"          description="Q1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="M4x_u"          description="M4 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="M4y_u"          description="M4 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="K2x_u"          description="K2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="K2y_u"          description="K2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="P1x_u"          description="P1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="P1y_u"          description="P1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Mfx_u"          description="Mf current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="Mfy_u"          description="Mf current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Mmx_u"          description="Mm current barotrope along i-axis harmonic real part "      unit="m/s"        />
+        <field id="Mmy_u"          description="Mm current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+
+        <field id="M2x_v"          description="M2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="M2y_v"          description="M2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="S2x_v"          description="S2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="S2y_v"          description="S2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="N2x_v"          description="N2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="N2y_v"          description="N2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="K1x_v"          description="K1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="K1y_v"          description="K1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="O1x_v"          description="O1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="O1y_v"          description="O1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Q1x_v"          description="Q1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="Q1y_v"          description="Q1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="M4x_v"          description="M4 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="M4y_v"          description="M4 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="K2x_v"          description="K2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="K2y_v"          description="K2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="P1x_v"          description="P1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="P1y_v"          description="P1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Mfx_v"          description="Mf current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="Mfy_v"          description="Mf current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+        <field id="Mmx_v"          description="Mm current barotrope along j-axis harmonic real part "      unit="m/s"        />
+        <field id="Mmy_v"          description="Mm current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"   operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   operation="inst(X)"  />
+        <field id="traj_dep"   description="floats depth"       unit="m"     operation="inst(X)"  />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  operation="inst(X)"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   operation="inst(X)"  />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" operation="inst(X)"  />
+        <field id="traj_group" description="floats group"       unit="none"  operation="inst(X)"  />
+      </group>
+
+    </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+	<!-- automatic definition of the name based on id="1d_grid_T" 
+	     => this name is used as the radical for all file names of this group
+	     => add a suffix to be sure that all files names of this group are different   -->
+	<group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+	  <!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
+	  <file id="0n180wT" name_suffix="auto" >
+	    <group id="0n180wT" zoom_ref="0n180wT" >    <!-- group of variables sharing the same zoom -->
+	      <field ref="toce" name="votemper"  />
+	      <field ref="uoce" name="vozocrtx"  />     <!-- include a U-grid variable in the list => switch to T-grid -->
+	    </group>
+	  </file>
+	  <!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
+	  <file id="EqT" name_suffix="auto" >
+	    <group id="EqT" zoom_ref="EqT" >
+	      <field ref="toce" name="votemper"  />
+	    </group>
+	  </file>
+	  <!-- global file with different operations on data   -->
+	  <file id="global" >
+	    <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+	    <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+            <field ref="M2x"     name="M2_x_elev"  />
+            <field ref="M2y"     name="M2_y_elev"  />
+	  </file>
+	</group>
+
+        <!-- variables available with key_float, instantaneous fields -->
+        <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>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+	
+	<file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+	
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+	<file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+	</file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m"       positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m"       positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m"       positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m"       positive=".false." />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+    </grid_definition>    
+    
+  </context>
+  <context id="1_nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+	<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+	<field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+	<!-- automatic definition of the name based on id="1d_grid_T" 
+	     => this name is used as the radical for all file names of this group
+	     => add a suffix to be sure that all files names of this group are different   -->
+	<group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+	  <!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
+	  <file id="0n180wT" name_suffix="auto" >
+	    <group id="0n180wT" zoom_ref="0n180wT" >    <!-- group of variables sharing the same zoom -->
+	      <field ref="toce" name="votemper"  />
+	      <field ref="uoce" name="vozocrtx"  />     <!-- include a U-grid variable in the list => switch to T-grid -->
+	    </group>
+	  </file>
+	  <!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
+<!--
+	  <file id="EqT" name_suffix="auto" >
+	    <group id="EqT" zoom_ref="EqT" >
+	      <field ref="toce" name="votemper"  />
+	    </group>
+	  </file>
+-->	  
+	  <!-- global file with different operations on data   -->
+	  <file id="global" >
+	    <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+	    <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+	  </file>
+	</group>
+
+      </group>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+	
+<!--	
+      <file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+-->	
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+	<file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+	</file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+    </grid_definition>    
+    
+  </context>
+
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/namelist	(revision 3437)
@@ -0,0 +1,990 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "AMM12"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =     576   !  last  time step (std 1 day = 576)
+   nn_date0    =  20070101 !  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   =  .false.  !  start from rest (F) or from a restart file (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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =     576   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      12   !  frequency of write in the output file   (modulo referenced to nit000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   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
+!-----------------------------------------------------------------------
+   rn_sbot_min =   10.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_thetb    =    1.00   !  bottom control parameter  (0<=thetb<= 1)
+   rn_rmax     =    0.30   !  maximum cut-off r-value allowed (0<r_max<1)
+   ln_s_sigma  = .true.    !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      =  150.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   30      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   =   300.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   =   300.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  300.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   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   = .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)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false    !  analytical formulation (T => fill namsbc_ana )
+   ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  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
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = '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
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
+   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = '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'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .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 interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = '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_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =  -27.7    !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+/      
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   nb_harmo      =    11    !  number of constituents used
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  2                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    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    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&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                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =    50.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator
+                           !  Direction of action  :
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+                           !  Coefficient 
+   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =  0.0      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     = -1.0e+10  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   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")
+   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   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative 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 mized 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]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   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   =    1      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namgap       !   level mean model-data gap                             ('key_diagap')
+!-----------------------------------------------------------------------
+   nn_gap     =  15        !  time-step frequency of model-data gap computation
+   nn_prg     =  10        !  time-step frequency of gap print in model output
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions
+   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .false.    !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&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 sections
+!-----------------------------------------------------------------------
+    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
+/
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12/cpp_AMM12.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys  key_bdy key_vectopt_loop key_amm_12km  key_dynspg_ts key_ldfslp  key_zdfgls  key_vvl key_diainstant key_mpp_mpi
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,748 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+	
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"     description="Effective ocean transport along i-axis"    unit="m3/s"                 />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"     description="Effective ocean tra,sport along j-axis"    unit="m3/s"                 />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"  operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   />
+        <field id="traj_dep"   description="floats depth"       unit="m"     />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" />
+        <field id="traj_group" description="floats group"       unit="none"  />
+      </group>
+     
+      <!-- ptrc on T grid -->
+
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="Alkalini" description="Total Alkalinity Concentration"           unit="mmol/m3"    />
+       <field id="O2"       description="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="Si"       description="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="mmol/m3" />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="mmol/m3" />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="DSi"      description="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="GSi"      description="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="mg/m3" />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="mg/m3" />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="mmol/m3" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="mmol/m3" />
+     </group>
+
+      <!-- diad on T grid : variables available with key_diatrc -->
+
+     <group id="diad_T" axis_ref="none" grid_ref="grid_T">
+       <field id="PH"          description="PH"                                       unit="-"          axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/m3"     axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/m3"     axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"       axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="Mumax"       description="Maximum growth rate"                      unit="s-1"        axis_ref="deptht" />
+       <field id="MuN"         description="Realized growth rate for nanophyto"       unit="s-1"        axis_ref="deptht" />
+       <field id="MuD"         description="Realized growth rate for diatomes"        unit="s-1"        axis_ref="deptht" />
+       <field id="MuNlight"    description="Light limited growth rate for nanophyto"  unit="s-1"        axis_ref="deptht" />
+       <field id="MuDlight"    description="Light limited growth rate for diatomes"   unit="s-1"        axis_ref="deptht" />
+       <field id="LNnut"       description="Nutrient limitation term in Nanophyto"    unit="-"          axis_ref="deptht" />
+       <field id="LDnut"       description="Nutrient limitation term in Diatoms"      unit="-"          axis_ref="deptht" />
+       <field id="LNFe"        description="Iron limitation term in Nanophyto"        unit="-"          axis_ref="deptht" />
+       <field id="LDFe"        description="Iron limitation term in Diatoms"          unit="-"          axis_ref="deptht" />
+       <field id="LNlight"     description="Light limitation term in Nanophyto"       unit="-"          axis_ref="deptht" />
+       <field id="LDlight"     description="Light limitation term in Diatoms"         unit="-"          axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="mol/m2/s"                     />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="mol/m2/s"                     />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="mol/m2/s"                     />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="mol/m2/s"                     />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="mol/m2/s"                     />
+       <field id="Cflx"        description="DIC flux"                                 unit="mol/m2/s"                     />
+       <field id="Oflx"        description="Oxygen flux"                              unit="mol/m2/s"                     />
+       <field id="Kg"          description="Gas transfer"                             unit="mol/m2/s/uatm"                />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"                         />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"                         />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"                            />
+       <field id="Irondep"     description="Iron deposition"                          unit="mol/m2/s"                     />
+     </group>
+       
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+        <!-- automatic definition of the name based on id="1d_grid_T" 
+             => this name is used as the radical for all file names of this group
+             => add a suffix to be sure that all files names of this group are different   -->
+        <group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+          <!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
+          <file id="0n180wT" name_suffix="auto" >
+            <group id="0n180wT" zoom_ref="0n180wT" >    <!-- group of variables sharing the same zoom -->
+              <field ref="toce" name="votemper"  />
+              <field ref="uoce" name="vozocrtx"  />     <!-- include a U-grid variable in the list => switch to T-grid -->
+            </group>
+          </file>
+          <!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
+          <file id="EqT" name_suffix="auto" >
+            <group id="EqT" zoom_ref="EqT" >
+              <field ref="toce" name="votemper"  />
+            </group>
+          </file>
+          <!-- global file with different operations on data   -->
+          <file id="global" >
+            <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+            <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+          </file>
+        </group>
+
+      </group>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+
+
+	<file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+
+        <!-- variables available with key_float, instantaneous fields -->
+        <file id="floats"  description="floats variables">
+            <field ref="traj_lon"   name="floats_longitude"   freq_op="432000" />
+            <field ref="traj_lat"   name="floats_latitude"    freq_op="432000" />
+            <field ref="traj_dep"   name="floats_depth"       freq_op="432000" />
+            <field ref="traj_temp"  name="floats_temperature" freq_op="432000" />
+            <field ref="traj_salt"  name="floats_salinity"    freq_op="432000" />
+            <field ref="traj_dens"  name="floats_density"     freq_op="432000" />
+            <field ref="traj_group" name="floats_group"       freq_op="432000" />
+        </file>
+
+       <file id="5d_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+       </file>
+
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+        <file id="1m_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="DOC"      />
+          <field ref="Fer"      />
+          <field ref="NO3"      />
+       </file>
+	
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+        <file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+          <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+        </file>
+
+        <file id="1y_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="CaCO3"    />
+          <field ref="PO4"      />
+          <field ref="POC"      />
+          <field ref="Si"       />
+          <field ref="PHY"      />
+          <field ref="ZOO"      />
+          <field ref="DOC"      />
+          <field ref="PHY2"     />
+          <field ref="ZOO2"     />
+          <field ref="DSi"      />
+          <field ref="Fer"      />
+          <field ref="BFe"      />
+          <field ref="GOC"      />
+          <field ref="SFe"      />
+          <field ref="DFe"      />
+          <field ref="GSi"      />
+          <field ref="NFe"      />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="NO3"      />
+          <field ref="NH4"      />
+       </file>
+
+       <file id="1y_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="PH"       />
+          <field ref="CO3"      />
+          <field ref="CO3sat"   />
+          <field ref="PAR"      />
+          <field ref="PPPHY"    />
+          <field ref="PPPHY2"   />
+          <field ref="PPNEWN"   />
+          <field ref="PPNEWD"   />
+          <field ref="PBSi"     />
+          <field ref="PFeN"     />
+          <field ref="PFeD"     />
+          <field ref="PCAL"     />
+          <field ref="DCAL"     />
+          <field ref="GRAZ"     />
+          <field ref="Mumax"    />
+          <field ref="MuN"      />
+          <field ref="MuD"      />
+          <field ref="MuNlight" />
+          <field ref="MuDlight" />
+          <field ref="LNnut"    />
+          <field ref="LDnut"    />
+          <field ref="LNFe"     />
+          <field ref="LDFe"     />
+          <field ref="LNlight"  />
+          <field ref="LDlight"  />
+          <field ref="EPC100"   />
+          <field ref="EPFE100"  />
+          <field ref="EPSI100"  />
+          <field ref="EPCAL100" />
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Kg"       />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+          <field ref="Irondep"  />
+          <field ref="Nfix"     />
+       </file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+        <zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+        <zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+        <zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+        <zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+        <zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+        <zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+        <zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+        <zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+        <zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+        <zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+        <zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+        <zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+        <zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+        <zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+        <zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+        <zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+        <zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+        <zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+        <zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+        <zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+        <zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+        <zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+        <zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+        <zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+        <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+
+    </grid_definition>    
+    
+  </context>
+  
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist	(revision 3437)
@@ -0,0 +1,991 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "AMM12"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =     576   !  last  time step (std 1 day = 576)
+   nn_date0    =  20070101 !  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   =  .false.  !  start from rest (F) or from a restart file (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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =     576   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      12   !  frequency of write in the output file   (modulo referenced to nit000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   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
+!-----------------------------------------------------------------------
+   rn_sbot_min =   10.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 7000.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=theta<=20)
+   rn_thetb    =    1.00   !  bottom control parameter  (0<=thetb<= 1)
+   rn_rmax     =    0.30   !  maximum cut-off r-value allowed (0<r_max<1)
+   ln_s_sigma  = .true.    !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      =  150.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   30      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   =   300.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   =   300.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  300.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   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   = .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)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false    !  analytical formulation (T => fill namsbc_ana )
+   ln_flx      = .true.    !  flux formulation       (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  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
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = '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
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
+   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = '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'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .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 interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = '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_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
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =     0     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   nb_harmo      =    11    !  number of constituents used
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    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    =    2.5e-3 !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    0.0e0  !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  0      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&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                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .true.   !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .false.  !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =    50.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .true.    !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator
+                           !  Direction of action  :
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+                           !  Coefficient 
+   rn_ahm_0_lap     = 60.0      !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =  0.0      !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     = -1.0e+10  !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   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")
+   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   = .false.   !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative 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 mized 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]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn =  100000.     !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .FALSE.   !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   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   =    1      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namgap       !   level mean model-data gap                             ('key_diagap')
+!-----------------------------------------------------------------------
+   nn_gap     =  15        !  time-step frequency of model-data gap computation
+   nn_prg     =  10        !  time-step frequency of gap print in model output
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .false.    !  Add zonal means and meridional stream functions
+   ln_subbas  = .false.    !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .false.    !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&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 sections
+!-----------------------------------------------------------------------
+    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
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_pisces
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_pisces	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_pisces	(revision 3437)
@@ -0,0 +1,230 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :    1  - air-sea exchange                         (nampisext)
+!! namelists    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)
+!!              9  - parameters for Kriest parameterization   (nampiskrp, nampiskrs)
+!!              10 - additional 2D/3D  diagnostics            (nampisdia)
+!!              11 - Damping                                  (nampisdmp)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisext     !   air-sea exchange
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_co2int  =  .false. ! read atm pco2 from a file (T) or constant (F)
+   atcco2     =  287.    ! 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 !
+!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   cn_dir      = './'     !  root directory for the location of the dynamical files
+!
+   ln_presatm  = .true.   ! constant atmopsheric pressure (F) or from a file (T)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nrdttrc    =  1        ! time step frequency for biology
+   wsbio      =  2.       ! POC sinking speed
+   xkmort     =  1.E-7    ! half saturation constant for mortality
+   ferat3     =  10.E-6   ! Fe/C in zooplankton 
+   wsbio2     =  30.      ! Big particles sinking speed
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   conc0      =  2.e-6    ! Phosphate half saturation
+   conc1      =  8E-6     ! Phosphate half saturation for diatoms
+   conc2      =  2E-9     ! Iron half saturation for phyto
+   conc2m     =  4E-9     ! Max iron half saturation for phyto
+   conc3      =  3E-9     ! Iron half saturation for diatoms
+   conc3m     =  9E-9     ! Maxi iron half saturation for diatoms
+   xsizedia   =  5.E-7    ! Minimum size criteria for diatoms
+   xsizephy   =  1.E-6    ! Minimum size criteria for phyto
+   concnnh4   =  1.E-7    ! NH4 half saturation for phyto
+   concdnh4   =  4.E-7    ! NH4 half saturation for diatoms
+   xksi1      =  2.E-6    ! half saturation constant for Si uptake
+   xksi2      =  3.33E-6  ! half saturation constant for Si/C
+   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
+   concfebac  =  3.E-11   ! Half-saturation for Fe limitation of Bacteria
+   qnfelim    =  7.E-6    ! Optimal quota of phyto
+   qdfelim    =  7.E-6    ! Optimal quota of diatoms
+   caco3r     =  0.16     ! mean rain ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   pislope    =  3.       ! P-I slope
+   pislope2   =  2.       ! P-I slope  for diatoms
+   excret     =  0.05     ! excretion ratio of phytoplankton
+   excret2    =  0.05     ! excretion ratio of diatoms
+   ln_newprod =  .false.  ! Enable new parame. of production (T/F) 
+   bresp      =  0.00333  ! Basal respiration rate
+   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton
+   chlcdm     =  0.04     ! Minimum Chl/C in diatoms
+   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton
+   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton
+   fecdm      =  40E-6    ! Minimum Fe/C in diatoms
+   grosip     =  0.151    ! mean Si/C ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   wchl       =  0.001    ! quadratic mortality of phytoplankton
+   wchld      =  0.02     ! maximum quadratic mortality of diatoms
+   mprat      =  0.01     ! phytoplankton mortality rate
+   mprat2     =  0.01     ! Diatoms mortality rate
+   mpratm     =  0.01     ! Phytoplankton minimum mortality rate
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts
+   grazrat2   =  0.7      ! maximal mesozoo grazing rate
+   resrat2    =  0.005    ! exsudation rate of mesozooplankton
+   mzrat2     =  0.03     ! mesozooplankton mortality rate
+   xprefc     =  1.       ! zoo preference for phyto
+   xprefp     =  0.3      ! zoo preference for POC
+   xprefz     =  1.       ! zoo preference for zoo
+   xprefpoc   =  0.3      ! zoo preference for poc
+   xthresh2zoo = 1E-8     ! zoo feeding threshold for mesozooplankton 
+   xthresh2dia = 1E-8     ! diatoms feeding threshold for mesozooplankton 
+   xthresh2phy = 2E-7     ! nanophyto feeding threshold for mesozooplankton 
+   xthresh2poc = 1E-8     ! poc feeding threshold for mesozooplankton 
+   xthresh2   =  0.       ! Food threshold for grazing
+   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing
+   epsher2    =  0.33     ! Efficicency of Mesozoo growth
+   sigma2     =  0.6      ! Fraction of mesozoo excretion as DOM
+   unass2     =  0.3      ! non assimilated fraction of P by mesozoo
+   grazflux   =  3.e3     ! flux-feeding rate
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa
+   grazrat    =  3.0      ! maximal zoo grazing rate
+   resrat     =  0.03     ! exsudation rate of zooplankton
+   mzrat      =  0.0      ! zooplankton mortality rate
+   xpref2c    =  0.1      ! Microzoo preference for POM
+   xpref2p    =  1.       ! Microzoo preference for Nanophyto
+   xpref2d    =  0.6      ! Microzoo preference for Diatoms
+   xthreshdia =  1.E-8    ! Diatoms feeding threshold for microzooplankton 
+   xthreshphy =  2.E-7    ! Nanophyto feeding threshold for microzooplankton 
+   xthreshpoc =  1.E-8    ! POC feeding threshold for microzooplankton 
+   xthresh    =  0.       ! Food threshold for feeding
+   xkgraz     =  20.E-6   ! half sturation constant for grazing
+   epsher     =  0.33     ! Efficiency of microzoo growth
+   sigma1     =  0.6      ! Fraction of microzoo excretion as DOM
+   unass      =  0.3      ! non assimilated fraction of phyto by zoo
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xremik    =  0.25      ! remineralization rate of DOC
+   xremip    =  0.025     ! remineralisation rate of POC
+   nitrif    =  0.05      ! NH4 nitrification rate
+   xsirem    =  0.003     ! remineralization rate of Si
+   xsiremlab =  0.025     ! fast remineralization rate of Si
+   xsilab    =  0.31      ! Fraction of labile biogenic silica
+   xlam1     =  0.005     ! scavenging rate of Iron
+   oxymin    =  1.E-6     ! Half-saturation constant for anoxia
+   ligand    =  0.6E-9    ! Ligands concentration
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   kdca       =  6.       ! calcite dissolution rate constant (1/time)
+   nca        =  1.       ! order of dissolution reaction (dimensionless)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissed     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .false.     , .true. ,   'yearly'  , ''       , ''
+!
+   cn_dir      = './'      !  root directory for the location of the dynamical files
+   ln_dust     =  .false.   ! boolean for dust input from the atmosphere
+   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
+   sedfeinput  =  1E-9     ! Coastal release of Iron
+   dustsolub   =  0.02     ! Solubility of the dust
+   wdust       =  2.0      ! Dust sinking speed
+   nitrfix     =  1E-7     ! Nitrogen fixation rate
+   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2)
+   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrp     !   Kriest parameterization : parameters     "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_eta      = 1.17    ! Sinking  exponent
+   xkr_zeta     = 2.28    ! N content exponent
+   xkr_mass_min = 0.0002  ! Minimum mass for Aggregates
+   xkr_mass_max = 1.      ! Maximum mass for Aggregates
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrs     !   Kriest parameterization : size classes  "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_sfact    = 942.    ! Sinking factor
+   xkr_stick    = 0.5     ! Stickiness
+   xkr_nnano    = 2.337   ! Nbr of cell in nano size class
+   xkr_ndiat    = 3.718   ! Nbr of cell in diatoms size class
+   xkr_nmeso    = 7.147   ! Nbr of cell in mesozoo size class
+   xkr_naggr    = 9.877   ! Nbr of cell in aggregates  size class
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdia     !   additional 2D/3D tracers diagnostics 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !    name   !           title of the field          !     units      !
+!              !           !                                       !                !  
+   pisdia2d(1)  = 'Cflx     ' , 'DIC flux                          ',  'molC/m2/s    '
+   pisdia2d(2)  = 'Oflx     ' , 'Oxygen flux                       ',  'molC/m2/s    '
+   pisdia2d(3)  = 'Kg       ' , 'Gas transfer                      ',  'mol/m2/s/uatm'
+   pisdia2d(4)  = 'Delc     ' , 'Delta CO2                         ',  'uatm         '
+   pisdia2d(5)  = 'PMO      ' , 'POC export                        ',  'molC/m2/s    '
+   pisdia2d(6)  = 'PMO2     ' , 'GOC export                        ',  'molC/m2/s    '
+   pisdia2d(7)  = 'ExpFe1   ' , 'Nano iron export                  ',  'molFe/m2/s   '
+   pisdia2d(8)  = 'ExpFe2   ' , 'Diatoms iron export               ',  'molFe/m2/s   '
+   pisdia2d(9)  = 'ExpSi    ' , 'Silicate export                   ',  'molSi/m2/s   '
+   pisdia2d(10) = 'ExpCaCO3 ' , 'Calcite export                    ',  'molC/m2/s    '
+   pisdia2d(11) = 'heup     ' , 'euphotic layer depth              ',  'm            '
+   pisdia2d(12) = 'Fedep    ' , 'Iron dep                          ',  'molFe/m2/s   '
+   pisdia2d(13) = 'Nfix     ' , 'Nitrogen Fixation                 ',  'molN/m2/s    '
+   pisdia3d(1)  = 'PH       ' , 'PH                                ',  '-            '
+   pisdia3d(2)  = 'CO3      ' , 'Bicarbonates                      ',  'mol/l        '
+   pisdia3d(3)  = 'CO3sat   ' , 'CO3 saturation                    ',  'mol/l        '
+   pisdia3d(4)  = 'PAR      ' , 'light penetration                 ',  'W/m2         '
+   pisdia3d(5)  = 'PPPHY    ' , 'Primary production of nanophyto   ',  'molC/m3/s    '
+   pisdia3d(6)  = 'PPPHY2   ' , 'Primary production of diatoms     ',  'molC/m3/s    '
+   pisdia3d(7)  = 'PPNEWN   ' , 'New Primary production of nano    ',  'molC/m3/s    '
+   pisdia3d(8)  = 'PPNEWD   ' , 'New Primary production of diat    ',  'molC/m3/s    '
+   pisdia3d(9)  = 'PBSi     ' , 'Primary production of Si diatoms  ',  'molSi/m3/s   '
+   pisdia3d(10) = 'PFeN     ' , 'Primary production of nano iron   ',  'molFe/m3/s   '
+   pisdia3d(11) = 'PFeD     ' , 'Primary production of diatoms iron',  'molFe/m3/s   '
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value
+   nn_pisdmp    =  210240     !  Frequency of Relaxation 
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_check_mass =  .false.    !  Check mass conservation
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_top
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_top	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/namelist_top	(revision 3437)
@@ -0,0 +1,146 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!!              2 - tracer data initialisation            (namtrc_dta)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
+!!              7 - dynamical tracer trends               (namtrc_trd)
+!!              8 - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers      
+   nn_writetrc   =  576     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                           !                  = 1 do not use the value in the restart file
+                           !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   ln_trcdta     =   .true. !  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' ,  .false.    ,  .true.
+   sn_tracer(11)  = 'PHY2    ' , 'Diatoms Concentration                  ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(12)  = 'ZOO2    ' , 'Mesozooplankton Concentration          ',  'mol-C/L' ,  .false.    ,  .true.
+   sn_tracer(13)  = '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 !
+!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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'  , ''       , ''
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+   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_cen2   =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd    =  .false.  !  TVD scheme
+   ln_trcadv_muscl  =  .true.   !  MUSCL scheme
+   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
+   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
+   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc  =  576      !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(23) =   .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F)
+   nn_writedia   =  576     !  time step frequency for diagnostics
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/cpp_AMM12_PISCES.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/cpp_AMM12_PISCES.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/AMM12_PISCES/cpp_AMM12_PISCES.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_top key_pisces key_bdy key_vectopt_loop key_amm_12km  key_dynspg_ts key_ldfslp  key_zdfgls  key_vvl key_diainstant key_mpp_mpi
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/AA_job
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/AA_job	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/AA_job	(revision 3437)
@@ -0,0 +1,140 @@
+#-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
+#- 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
+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
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,371 @@
+<?xml version="1.0"?>
+<simulation>
+  
+  <context id="nemo"> 
+    
+    <!-- $id$ -->
+
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+	
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                 />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                 />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"  operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   />
+        <field id="traj_dep"   description="floats depth"       unit="m"     />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" />
+        <field id="traj_group" description="floats group"       unit="none"  />
+      </group>
+
+
+    </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+      </group>
+
+      <group id="2d" output_freq="172800" output_level="10" enabled=".TRUE.">                      <!-- 2d files -->
+      </group>
+
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+     
+        <file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+        </file>
+
+        <file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+          <field ref="uoce"         name="vozocrtx"  />
+          <field ref="uoce_eiv"     name="vozoeivu"  />
+          <field ref="utau"         name="sozotaux"  />
+        </file>
+
+        <file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+          <field ref="voce"         name="vomecrty"  /> 
+          <field ref="voce_eiv"     name="vomeeivv"  />
+          <field ref="vtau"         name="sometauy"  /> 
+        </file>
+
+        <file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+          <field ref="woce"         name="vovecrtz" />
+          <field ref="woce_eiv"     name="voveeivw" />
+          <field ref="avt"          name="votkeavt" />
+          <field ref="avt_evd"      name="votkeevd" />
+          <field ref="avm"          name="votkeavm" />
+          <field ref="avm_evd"      name="votkeevm" />
+          <field ref="avs"          name="voddmavs" />
+          <field ref="aht2d"        name="soleahtw" />
+          <field ref="aht2d_eiv"    name="soleaeiw" />
+        </file>
+
+        <!-- variables available with key_float, instantaneous fields -->
+        <file id="floats"  description="floats variables">
+            <field ref="traj_lon"   name="floats_longitude"   freq_op="432000" />
+            <field ref="traj_lat"   name="floats_latitude"    freq_op="432000" />
+            <field ref="traj_dep"   name="floats_depth"       freq_op="432000" />
+            <field ref="traj_temp"  name="floats_temperature" freq_op="432000" />
+            <field ref="traj_salt"  name="floats_salinity"    freq_op="432000" />
+            <field ref="traj_dens"  name="floats_density"     freq_op="432000" />
+            <field ref="traj_group" name="floats_group"       freq_op="432000" />
+        </file>
+
+      </group>
+
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+
+   </file_definition>
+
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+
+  <axis_definition>  
+     <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+     <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+     <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+     <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+     <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+     <axis id="none" description="axe non defini" unit="none" size="1" />
+  </axis_definition> 
+
+  <grid_definition>
+    <grid id="grid_T" description="grid T" />
+    <grid id="grid_U" description="grid U" />
+    <grid id="grid_V" description="grid V" />
+    <grid id="grid_W" description="grid W" />
+    <grid id="scalarpoint" description="scalar" >
+      <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+    </grid>
+  </grid_definition>    
+
+</context>
+
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/namelist	(revision 3437)
@@ -0,0 +1,982 @@
+!.!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "GYRE"   !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =    4320   !  last  time step
+   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_leapy    =      30   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => 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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    4320   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =      60   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .true.    !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .false.   !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    0      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 7200.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   60      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 7200.           !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 7200.           !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   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   = .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)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .true.    !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .false.   !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   100     !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.1e0   !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+ 
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .false.   !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .true.    !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0)
+   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
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .false.   !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+    
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     0     !  add a damping     term in the surface freshwater flux (=2)
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .false. !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+/      
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    0.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+!       nam_tide       tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+!  ln_tide_pot    = use tidal potential forcing
+!  nb_harmo    = number of constituents used
+!  name(1)     = 'M2', 'K1', etc name of constituent
+
+&nam_tide
+   ln_tide_pot           = .true.
+   nb_harmo    = 11
+   clname(1)     =   'M2'
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    2      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m^2/s^2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d = .true.)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   2       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUICKEST scheme                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    1      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .true.  !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .false. !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .true.    !  z-coordinate - full steps                   
+   ln_hpg_zps  = .false.   !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 100000.   !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s]
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    1      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative 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 mized 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]
+   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     =   0       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscelaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      2    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    210    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.96     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  '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   =    1      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&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
+                           !     -1 : debug all section
+                           !  0 < n : debug section number n
+/ 
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/AA_job	(revision 3437)
@@ -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_LOBSTER
+#- 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_lobster namelist_lobster
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,445 @@
+<?xml version="1.0"?>
+<simulation>
+  
+  <context id="nemo"> 
+    
+    <!-- $id$ -->
+
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl_adv -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"                  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl_adv -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"                  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"  operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   />
+        <field id="traj_dep"   description="floats depth"       unit="m"     />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" />
+        <field id="traj_group" description="floats group"       unit="none"  />
+      </group>
+
+
+      <!-- ptrc on T grid -->
+
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">
+       <field id="DET"      description="Detritus"                                      unit="mmole-N/m3" />
+       <field id="ZOO"      description="Zooplankton Concentration"                     unit="mmole-N/m3" />
+       <field id="PHY"      description="Phytoplankton Concentration"                   unit="mmole-N/m3" />
+       <field id="NO3"      description="Nitrate Concentration"                         unit="mmole-N/m3" />
+       <field id="NH4"      description="Ammonium Concentration"                        unit="mmole-N/m3" />
+       <field id="DOM"      description="Dissolved Organic Matter"                      unit="mmole-N/m3" />
+     </group>
+
+     <!-- diad on T grid -->
+
+     <group id="diad_T" axis_ref="none" grid_ref="grid_T">  
+       <field id="FNO3PHY"  description="FNO3PHY"                             unit="-"  axis_ref="deptht" /> 
+       <field id="FNH4PHY"  description="FNH4PHY"                             unit="-"  axis_ref="deptht" /> 
+       <field id="FNH4NO3"  description="FNH4NO3"                             unit="-"  axis_ref="deptht" /> 
+       <field id="TNO3PHY"  description="TNO3PHY"                             unit="-"  /> 
+       <field id="TNH4PHY"  description="TNH4PHY"                             unit="-"  /> 
+       <field id="TPHYDOM"  description="TPHYDOM"                             unit="-"  /> 
+       <field id="TPHYNH4"  description="TPHYNH4"                             unit="-"  /> 
+       <field id="TPHYZOO"  description="TPHYZOO"                             unit="-"  /> 
+       <field id="TPHYDET"  description="TPHYDET"                             unit="-"  /> 
+       <field id="TDETZOO"  description="TDETZOO"                             unit="-"  /> 
+       <field id="TDETSED"  description="TDETSED"                             unit="-"  /> 
+       <field id="TZOODET"  description="TZOODET"                             unit="-"  /> 
+       <field id="TZOOBOD"  description="TZOOBOD"                             unit="-"  /> 
+       <field id="TZOONH4"  description="TZOONH4"                             unit="-"  /> 
+       <field id="TZOODOM"  description="TZOODOM"                             unit="-"  /> 
+       <field id="TNH4NO3"  description="TNH4NO3"                             unit="-"  /> 
+       <field id="TDOMNH4"  description="TDOMNH4"                             unit="-"  /> 
+       <field id="TDETNH4"  description="TDETNH4"                             unit="-"  /> 
+       <field id="TPHYTOT"  description="TPHYTOT"                             unit="-"  /> 
+       <field id="TZOOTOT"  description="TZOOTOT"                             unit="-"  /> 
+       <field id="TDETDOM"  description="TDETDOM"                             unit="-"  /> 
+       <field id="SEDPOC"   description="SEDPOC"                              unit="-"  /> 
+     </group>
+
+  </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+
+  <file_definition output_level="10" enabled=".TRUE.">
+
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+      </group>
+
+      <group id="2d" output_freq="172800" output_level="10" enabled=".TRUE.">                      <!-- 2d files -->
+      </group>
+
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+        <file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+          <field ref="toce"         name="votemper"  />
+          <field ref="soce"         name="vosaline"  />
+          <field ref="sst"          name="sosstsst"  />
+          <field ref="sss"          name="sosaline"  />
+          <field ref="ssh"          name="sossheig"  />
+          <field ref="empmr"        name="sowaflup"  />
+          <field ref="qsr"          name="soshfldo"  />
+          <field ref="empsmr"       name="sowaflcd"  />
+          <field ref="qt"           name="sohefldo"  />
+          <field ref="mldr10_1"     name="somxl010"  />
+          <field ref="mldkz5"       name="somixhgt"  />
+          <field ref="wspd"         name="sowindsp"  />
+          <field ref="qrp"          name="sohefldp"  />
+          <field ref="erp"          name="sowafldp"  />
+          <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+          <field ref="mlddzt"       name="sothedep"  />
+          <field ref="20d"          name="so20chgt"  />
+          <field ref="28d"          name="so28chgt"  />
+          <field ref="hc300"        name="sohtc300"  />
+        </file>
+
+        <file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+          <field ref="uoce"         name="vozocrtx"  />
+          <field ref="uoce_eiv"     name="vozoeivu"  />
+          <field ref="utau"         name="sozotaux"  />
+        </file>
+
+        <file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+          <field ref="voce"         name="vomecrty"  />
+          <field ref="voce_eiv"     name="vomeeivv"  />
+          <field ref="vtau"         name="sometauy"  />
+        </file>
+
+        <file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+          <field ref="woce"         name="vovecrtz" />
+          <field ref="woce_eiv"     name="voveeivw" />
+          <field ref="avt"          name="votkeavt" />
+          <field ref="avt_evd"      name="votkeevd" />
+          <field ref="avm"          name="votkeavm" />
+          <field ref="avm_evd"      name="votkeevm" />
+          <field ref="avs"          name="voddmavs" />
+          <field ref="aht2d"        name="soleahtw" />
+          <field ref="aht2d_eiv"    name="soleaeiw" />
+        </file>
+ 
+       <!-- variables available with key_float, instantaneous fields -->
+        <file id="floats"  description="floats variables">
+            <field ref="traj_lon"   name="floats_longitude"   freq_op="432000" />
+            <field ref="traj_lat"   name="floats_latitude"    freq_op="432000" />
+            <field ref="traj_dep"   name="floats_depth"       freq_op="432000" />
+            <field ref="traj_temp"  name="floats_temperature" freq_op="432000" />
+            <field ref="traj_salt"  name="floats_salinity"    freq_op="432000" />
+            <field ref="traj_dens"  name="floats_density"     freq_op="432000" />
+            <field ref="traj_group" name="floats_group"       freq_op="432000" />
+        </file>
+
+       <file id="5d_ptrc_T" name="auto" description="lobster sms variables" >
+         <field ref="DET"      />
+         <field ref="ZOO"      />
+         <field ref="PHY"      />
+         <field ref="NO3"      />
+         <field ref="NH4"      />
+         <field ref="DOM"      />
+       </file>
+
+       <file id="5d_diad_T" name="auto" description="additional lobster diagnostics" >  
+         <field ref="FNO3PHY"   /> 
+         <field ref="FNH4PHY"   /> 
+         <field ref="FNH4NO3"   /> 
+         <field ref="TNO3PHY"   /> 
+         <field ref="TNH4PHY"   /> 
+         <field ref="TPHYDOM"   /> 
+         <field ref="TPHYNH4"   /> 
+         <field ref="TPHYZOO"   /> 
+         <field ref="TPHYDET"   /> 
+         <field ref="TDETZOO"   /> 
+         <field ref="TDETSED"   /> 
+         <field ref="TZOODET"   /> 
+         <field ref="TZOOBOD"   /> 
+         <field ref="TZOONH4"   /> 
+         <field ref="TZOODOM"   /> 
+         <field ref="TNH4NO3"   /> 
+         <field ref="TDOMNH4"   /> 
+         <field ref="TDETNH4"   /> 
+         <field ref="TPHYTOT"   /> 
+         <field ref="TZOOTOT"   /> 
+         <field ref="TDETDOM"   /> 
+         <field ref="SEDPOC"    /> 
+       </file>
+
+      </group>
+
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+ 
+  </file_definition>
+
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+
+  <axis_definition>  
+     <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+     <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+     <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+     <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+     <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+     <axis id="none" description="axe non defini" unit="none" size="1" />
+  </axis_definition> 
+
+  <grid_definition>
+    <grid id="grid_T" description="grid T" />
+    <grid id="grid_U" description="grid U" />
+    <grid id="grid_V" description="grid V" />
+    <grid id="grid_W" description="grid W" />
+    <grid id="scalarpoint" description="scalar" >
+      <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+    </grid>
+  </grid_definition>    
+
+</context>
+
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../GYRE/EXP00/namelist
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_lobster
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_lobster	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_lobster	(revision 3437)
@@ -0,0 +1,149 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! LOBSTER :    1  - biological parameters for phytoplankton    (namlobphy)
+!! namelists    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)
+!!              9  - additional 2D/3D  diagnostics              (namlobdia)
+!!              10 - biological diagnostics trends              (namlobdbi) 
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobphy     !   biological parameters for phytoplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   apmin   =  0.        ! fixed phytoplancton concentration            [mmol/m3]
+   tmumax  =  1.21e-5   ! maximal phytoplankton growth rate            [s-1] 
+   rgamma  =  0.05      ! phytoplankton exudation fraction             [%]
+   fphylab =  0.75      ! NH4 fraction of phytoplankton exsudation     
+   tmmaxp  =  0.0       ! maximal phytoplancton mortality rate         [s-1] 
+   tmminp  =  5.8e-7    ! minimal phytoplancton mortality rate         [0.05/86400 s-1=20 days] 
+   rcchl   =  60.       ! Carbone/Chlorophyl ratio                     [mgC.mgChla-1]
+   aki     =  33.       ! light photosynthesis half saturation constant[W/m2]
+   toptp   =  0.        ! optimal photosynthesis temperature
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobnut     !   biological parameters for nutrients
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   anmin   =  0.        ! minimum nutrients concentration              [mmol/m3]
+   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
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   azmin   = 0.         ! minimum zooplancton concentration                      [mmol/m3]
+   eggzoo  = 0.0        ! minimum for zooplankton concentration, egg effect      [mmolN.m-3]
+   rgz     = 0.         ! ivlev coeff for zoo mortality
+   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
+   tmmaxz  = 0.         ! maximal zooplankton mortality rate
+   tmminz  = 2.31e-6    ! minimal zooplankton mortality rate                     [(mmolN/m3)-1 d-1]
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobdet     !   biological parameters for detritus
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   admin   = 0.         ! minimum detritus concentration                 [mmol/m3]
+   taudn   = 5.80e-7    ! detritus breakdown rate                        [0.1/86400 s-1=10 days]
+   fdetlab = 0.         ! NH4 fraction of detritus dissolution           
+   vsed    = 3.47e-5    ! detritus sedimentation speed                   [m/s]
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobrat     !   general coefficients
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   redf    = 6.56       ! redfield ratio (C:N) for phyto
+   reddom  = 6.56       ! redfield ratio (C:N) for DOM
+   slopet  = 0.         ! van t Hoff "coefficient"
+   tmaxr   = 0.         ! maximal damping coeff under euphotic layer
+   tminr   = 5.80e-7    ! minimal damping coeff under euphotic layer
+   xhr     = -0.858     ! coeff for martin''s remineralisation profile
+   filmax  = 0.         ! ????
+   toptgz  = 0.         ! ???? 
+   tmaxgz  = 0.         ! ???? 
+   anumin  = 0.         ! ???? 
+   afdmin  = 0.         ! ???? 
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobdia     !   additional 2D/3D tracers diagnostics
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !    name   ! title of   ! units !
+!              !           ! the field  !       !  
+   lobdia2d(1)   = 'TNO3PHY' , 'TNO3PHY',  '-'
+   lobdia2d(2)   = 'TNH4PHY' , 'TNH4PHY',  '-'
+   lobdia2d(3)   = 'TPHYDOM' , 'TPHYDOM',  '-'
+   lobdia2d(4)   = 'TPHYNH4' , 'TPHYNH4',  '-'
+   lobdia2d(5)   = 'TPHYZOO' , 'TPHYZOO',  '-'
+   lobdia2d(6)   = 'TPHYDET' , 'TPHYDET',  '-'
+   lobdia2d(7)   = 'TDETZOO' , 'TDETZOO',  '-'
+   lobdia2d(8)   = 'TDETSED' , 'TDETSED',  '-'
+   lobdia2d(9)   = 'TZOODET' , 'TZOODET',  '-'
+   lobdia2d(10)  = 'TZOOBOD' , 'TZOOBOD',  '-'
+   lobdia2d(11)  = 'TZOONH4' , 'TZOONH4',  '-'
+   lobdia2d(12)  = 'TZOODOM' , 'TZOODOM',  '-'
+   lobdia2d(13)  = 'TNH4NO3' , 'TNH4NO3',  '-'
+   lobdia2d(14)  = 'TDOMNH4' , 'TDOMNH4',  '-'
+   lobdia2d(15)  = 'TDETNH4' , 'TDETNH4',  '-'
+   lobdia2d(16)  = 'TPHYTOT' , 'TPHYTOT',  '-'
+   lobdia2d(17)  = 'TZOOTOT' , 'TZOOTOT',  '-'
+   lobdia2d(18)  = 'TDETDOM' , 'TDETDOM',  '-'
+   lobdia2d(19)  = 'SEDPOC ' , 'SEDPOC ',  '-'
+   lobdia3d(1)   = 'FNO3PHY' , 'FNO3PHY',  '-'
+   lobdia3d(2)   = 'FNH4PHY' , 'FNH4PHY',  '-'
+   lobdia3d(3)   = 'FNH4NO3' , 'FNH4NO3',  '-'
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namlobdbi     !   biological diagnostics trends     
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!                !  2D bio diagnostics   units : mmole/m2/s   ("key_trdmld_trc")
+!                !  name    !       title of the field      !     units      !
+   lobdiabio(1)  = 'NO3PHY' , 'Flux from NO3 to PHY          ',  'mmole/m3/s'
+   lobdiabio(2)  = 'NH4PHY' , 'Flux from NH4 to PHY          ',  'mmole/m3/s'
+   lobdiabio(3)  = 'PHYNH4' , 'Flux from PHY to NH4          ',  'mmole/m3/s'
+   lobdiabio(4)  = 'PHYDOM' , 'Flux from PHY to DOM          ',  'mmole/m3/s'
+   lobdiabio(5)  = 'PHYZOO' , 'Flux from PHY to ZOO          ',  'mmole/m3/s'
+   lobdiabio(6)  = 'PHYDET' , 'Flux from PHY to DET          ',  'mmole/m3/s'
+   lobdiabio(7)  = 'DETZOO' , 'Flux from DET to ZOO          ',  'mmole/m3/s'
+   lobdiabio(8)  = 'DETSED' , 'Flux from DET to SED          ',  'mmole/m3/s'
+   lobdiabio(9)  = 'ZOODET' , 'Flux from ZOO to DET          ',  'mmole/m3/s'
+   lobdiabio(10)  = 'ZOOBOD' , 'Zooplankton closure          ',  'mmole/m3/s'
+   lobdiabio(11)  = 'ZOONH4' , 'Flux from ZOO to NH4         ',  'mmole/m3/s'
+   lobdiabio(12)  = 'ZOODOM' , 'Flux from ZOO to DOM         ',  'mmole/m3/s'
+   lobdiabio(13)  = 'NH4NO3' , 'Flux from NH4 to NO3         ',  'mmole/m3/s'
+   lobdiabio(14)  = 'DOMNH4' , 'Flux from DOM to NH4         ',  'mmole/m3/s'
+   lobdiabio(15)  = 'DETNH4' , 'Flux from DET to NH4         ',  'mmole/m3/s'
+   lobdiabio(16)  = 'DETDOM' , 'Flux from DET to DOM         ',  'mmole/m3/s'
+   lobdiabio(17)  = 'SEDNO3' , 'NO3 remineralization from SED',  'mmole/m3/s'
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist_top	(revision 3437)
@@ -0,0 +1,112 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP2 namelits :  1 - tracer definition                     (namtrc    )
+!!                       2 - tracer advection                      (namtrc_adv)
+!!                       3 - tracer lateral diffusion              (namtrc_ldf)
+!!                       4 - tracer vertical physics               (namtrc_zdf)
+!!                       5 - tracer newtonian damping              (namtrc_dmp)
+!!                       6 - dynamical tracer trends               (namtrc_trd)
+!!                       7 - tracer output                         (namtrc_wri)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers
+   nn_writetrc   =  60      !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   1       !  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.nc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   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)   = 'DET'   , 'Detritus                   ',  'mmole-N/m3' ,  .false.     ,  .false.
+   sn_tracer(2)   = 'ZOO'   , 'Zooplankton concentration  ',  'mmole-N/m3' ,  .false.     ,  .false.
+   sn_tracer(3)   = 'PHY'   , 'Phytoplankton concentration',  'mmole-N/m3' ,  .false.     ,  .false.
+   sn_tracer(4)   = 'NO3'   , 'Nitrate concentration      ',  'mmole-N/m3' ,  .false.     ,  .true.
+   sn_tracer(5)   = 'NH4'   , 'Ammonium concentration     ',  'mmole-N/m3' ,  .false.     ,  .false.
+   sn_tracer(6)   = 'DOM'   , 'Dissolved organic matter   ',  'mmole-N/m3' ,  .false.     ,  .false.
+/
+!-----------------------------------------------------------------------
+&namtrc_dta      !    Initialisation from data input file (T) or not (F)
+!-----------------------------------------------------------------------
+!
+!                !  file name  ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!                !             !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_trcdta(4)  = 'NO3_R1'    ,        -12        ,  'NO3'     ,    .false.   , .true. , 'yearly'  , ''       , ''
+
+   cn_dir        =     './'    !  root directory for the location of the runoff files
+   rn_trfac(4)   =    1.0      !   -       -       -       -      -
+/
+!-----------------------------------------------------------------------
+&namtrc_adv    !   advection scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd    =  .true.   !  TVD scheme
+   ln_trcadv_muscl  =  .false.  !  MUSCL scheme
+   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .false.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping  
+!-----------------------------------------------------------------------
+   ln_trcdmp   =  .false.  !  add a damping termn (T) or not (F)
+   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
+   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
+   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&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.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F)
+   nn_writedia   =  60     !  time step frequency for diagnostics
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/GYRE_LOBSTER/cpp_GYRE_LOBSTER.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys  key_gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_lobster key_iomput 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist	(revision 3437)
@@ -0,0 +1,922 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      = "Agulhas" !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =   10950   !  last  time step
+   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_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+                           !    = 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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =   10950   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =   10950   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namdta_tem   data: temperature                                     ("key_dtatem")
+!!   namdta_sal   data: salinity                                        ("key_dtasal")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 2880.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 14400.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 14400.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' '
+   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' '
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulea formulation
+!!   namsbc_core     CORE bulk formulea formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 0         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .false.   !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .false.   !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulea
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi = 'u_10.15JUNE2009_orca2'       ,  6  , 'U_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_bicub.nc'       , ''
+   sn_wndj = 'v_10.15JUNE2009_orca2'       ,  6  , 'V_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_bicub.nc'       , ''
+   sn_qsr  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_qlw  = 'ncar_rad.15JUNE2009_orca2'   , 24  , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_tair = 't_10.15JUNE2009_orca2'       ,  6  , 'T_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_humi = 'q_10.15JUNE2009_orca2'       ,  6  , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_prec = 'ncar_precip.15JUNE2009_orca2', -1  , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_snow = 'ncar_precip.15JUNE2009_orca2', -1  , 'SNOW'    ,   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+   sn_tdif = 'taudif_core'                 , 24  , 'taudif'  ,   .false.    , .true. , 'yearly'  , 'weights_bilin.nc'       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&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'       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      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
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',    -1    , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',     0    , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,    24    , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,    24    , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,     0    , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =   -27.7   !  magnitude of the damping on salinity   [mm/day]
+   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2)
+   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day]
+/      
+!-----------------------------------------------------------------------
+&namsbc_alb    !   albedo parameters
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    nn_dmp2d_in  = 0                      !
+    nn_dmp2d_out = 0                      !
+    nn_dmp2d_in  = 0                      !
+    nn_dmp2d_out = 0                      !
+    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 interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                              ("key_tradmp")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&namtra_adv    !   advection scheme for tracer 
+!-----------------------------------------------------------------------
+   ln_traadv_cen2   =  .false.  !  2nd order centered scheme   
+   ln_traadv_tvd    =  .true.   !  TVD scheme                
+   ln_traadv_muscl  =  .false.  !  MUSCL scheme             
+   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries  
+   ln_traadv_ubs    =  .false.  !  UBS scheme                 
+   ln_traadv_qck    =  .false.  !  QUCIKEST scheme                 
+/
+!-----------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracer 
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_traldf_lap    =  .true.   !  laplacian operator       
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator     
+   !                       !  Direction of action  :
+   ln_traldf_level  =  .false.  !  iso-level                
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)            (require "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                          (require "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  griffies skew flux formulation       (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   ln_traldf_gdia   =  .false.  !  griffies operator strfn diagnostics  (require "key_ldfslp")  ! UNDER TEST, DO NOT USE
+   !                       !  Coefficient
+   rn_aht_0         =  1000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   rn_aeiv_0        =     0.    !  eddy induced velocity coefficient [m2/s]    (require "key_traldf_eiv")
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp')
+!-----------------------------------------------------------------------
+   nn_hdmp     =   90      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .false.  !  laplacian operator         
+   ln_dynldf_bilap  =  .true.   !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     = -8.5e+11  !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   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
+/
+!-----------------------------------------------------------------------
+&namzdf_tke    !   turbulent eddy kinetic dependent vertical diffusion  ("key_zdftke")
+!-----------------------------------------------------------------------
+   rn_ediff    =   0.1     !  coef. for vertical eddy coef. (avt=rn_ediff*mxl*sqrt(e) )
+   rn_ediss    =   0.7     !  coef. of the Kolmogoroff dissipation
+   rn_ebb      =  67.83    !  coef. of the surface input of tke (=67.83 suggested when ln_mxl0=T)
+   rn_emin     =   1.e-6   !  minimum value of tke [m2/s2]
+   rn_emin0    =   1.e-4   !  surface minimum value of tke [m2/s2]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .false.   !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscelaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   nammpp_dyndist    Massively Parallel domain decomposition          ("key_agrif" && "key_mpp_dyndist")
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+/
+!-----------------------------------------------------------------------
+&nammpp_dyndist !   Massively Parallel Distribution for AGRIF zoom      ("key_agrif" && "key_mpp_dyndist")
+!-----------------------------------------------------------------------
+   jpni        =    1      !  jpni   number of processors following i
+   jpnj        =    1      !  jpnj   number of processors following j
+   jpnij       =    1      !  jpnij  number of local domains
+/
+!-----------------------------------------------------------------------
+&namctl        !   Control prints & Benchmark
+!-----------------------------------------------------------------------
+   ln_ctl      = .false.   !  trends control print (expensive!)
+   nn_print    =    0      !  level of print (0 no extra print)
+   nn_ictls    =    0      !  start i indice of control sum (use to compare mono versus
+   nn_ictle    =    0      !  end   i indice of control sum        multi processor runs
+   nn_jctls    =    0      !  start j indice of control               over a subdomain)
+   nn_jctle    =    0      !  end   j indice of control
+   nn_isplt    =    1      !  number of processors in i-direction
+   nn_jsplt    =    1      !  number of processors in j-direction
+   nn_bench    =    0      !  Bench mode (1/0): CAUTION use zero except for bench
+                           !     (no physical validity of the results)
+   nn_timing =      0
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_ice_lim2	(revision 3437)
@@ -0,0 +1,138 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM2 :  1 - dynamics/advection/thermo          (namicerun)
+!! namelists    2 - ice intialisation                  (namiceini)
+!!              3 - ice dynamic                        (namicedyn)
+!!              5 - ice advection                      (namicetrp)
+!!              6 - thermodynamic                      (namicethd)
+!!              7 - ice salinity                       (namicesal)
+!!              8 - mechanical redistribution of ice   (namiceitdme)
+!!              3 - ice diagnostics                    (namicedia)
+!!              9 - ice outputs                        (namiceout)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
+   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
+   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
+   ln_limdmp   = .false.   !  restoring ice thickness and fraction leads (T) or not (F)
+   acrit       = 1.0e-06   , 1.0e-06   ! minimum fraction for leads in the Northern (Southern) Hemisphere
+   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
+   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
+/
+!-----------------------------------------------------------------------
+&namiceini     !   ice initialisation
+!-----------------------------------------------------------------------
+   ln_limini   = .false.   !  read the ice initial state in the file 'Ice_initialization.nc' (T) or not (F)
+   ttest       =  2.0      !  threshold water temperature for initial sea ice
+   hninn       =  0.5      !  initial snow thickness in the north
+   hginn       =  3.0      !  initial ice  thickness in the north
+   alinn       =  0.05     !  initial leads area     in the north
+   hnins       =  0.1      !  same  three parameter  in the south
+   hgins       =  1.0      !        "                 "     south   
+   alins       =  0.1      !        "                 "     south
+/
+!-----------------------------------------------------------------------
+&namicedyn     !   ice dynamic
+!-----------------------------------------------------------------------
+   epsd        =   1.0e-20 !  tolerance parameter
+   alpha       =   0.5     !  coefficient for semi-implicit coriolis
+   dm          =   0.6e+03 !  diffusion constant for dynamics
+   nbiter      =   1       !  number of sub-time steps for relaxation
+   nbitdr      = 100       !  maximum number of iterations for relaxation
+   om          =   0.5     !  relaxation constant 
+   resl        =   5.0e-05 !  maximum value for the residual of relaxation
+   cw          =   5.0e-03 !  drag coefficient for oceanic stress
+   angvg       =   0.0     !  turning angle for oceanic stress
+   pstar       =   1.0e+04 !  1st bulk-rheology parameter
+   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
+   etamn       =   0.0e+07 !  minimun value for viscosity
+   creepl      =   2.0e-08 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nevp        =   360     !  number of EVP subcycling iterations
+   telast      =   3600    !  timescale for EVP elastic waves
+   alphaevp    =   1.0     !  coefficient for the solution of EVP int. stresses
+/
+!-----------------------------------------------------------------------
+&namicetrp     !   ice transport
+!-----------------------------------------------------------------------
+   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+!  hmelt       : maximum melting at the bottom
+!  hiccrit(1/2): ice thickness for lateral accretion in the Northern (Southern) Hemisphere
+!                caution 1.0, 1.0 best value to be used!!! (gilles G.)
+!  hicmin      : ice thickness corr. to max. energy stored in brine pocket
+!  hiclim      : minimum ice thickness
+!  amax        : maximum lead fraction
+!  swiqst      : energy stored in brine pocket (=1) or not (=0)	
+!  sbeta       : numerical caracteritic of the scheme for diffusion in ice
+!               Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
+!  parlat      : percentage of energy used for lateral ablation
+!  hakspl      : slope of distr. for Hakkinen-Mellor's lateral melting
+!  hibspl      : slope of distribution for Hibler's lateral melting
+!  exld        : exponent for leads-closure rate
+!  hakdif      : coefficient for diffusions of ice and snow
+!  thth         : threshold thickness for comp. of eq. thermal conductivity
+!  hnzst       : thickness of the surf. layer in temp. computation
+!  parsub      : switch for snow sublimation or not
+!  alphs       : coefficient for snow density when snow ice formation
+! 
+&namicethd
+   hmelt       = -0.15     !  maximum melting at the bottom
+   hiccrit     = 0.3 , 0.3 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
+   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
+   hiclim      = 0.05      !  minimum ice thickness
+   amax        = 0.999     !  maximum lead fraction
+   swiqst      = 1.        !  energy stored in brine pocket (=1) or not (=0)	
+   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice
+                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
+   parlat      = 0.0       !  percentage of energy used for lateral ablation
+   hakspl      = 0.5       !  slope of distr. for Hakkinen-Mellor's lateral melting
+   hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting
+   exld        = 2.0       !  exponent for leads-closure rate
+   hakdif      = 1.0       !  coefficient for diffusions of ice and snow
+   thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity
+   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
+   parsub      = 1.0       !  switch for snow sublimation or not
+   alphs       = 1.0       !  coefficient for snow density when snow ice formation
+/
+!-----------------------------------------------------------------------
+&namicedia     !   ice diagnostics
+!-----------------------------------------------------------------------
+   fmtinf      ='1PE13.5 ' !  format of the output values
+   nfrinf      = 4         !  number of variables written in one line
+   ntmoy       = 1         !  instantaneous values of ice evolution or averaging
+   ninfo       = 1         !  frequency of ouputs on file ice_evolu in case of averaging
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namiceout     !   parameters for outputs
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   noumef      =   19      !  number of fields
+!
+!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
+!           !                                      !           !           ! or not !  factor  !  factor  !
+   field_1  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
+   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
+   field_3  = 'Ice produced                       ', 'iiceprod', 'm/kt    ',    1   ,  1.0     ,    0.0
+   field_4  = 'Ice concentration                  ', 'ileadfra', '%       ',    1   , -1.0     ,    1.0
+   field_5  = 'Ice temperature                    ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
+   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
+   field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
+   field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_14 = 'Salt flux at ocean surface         ', 'iocesafl', 'kg/m2/kt',    1   ,  1.0     ,    0.0
+   field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
+   field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
+   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
+/      
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AA_job	(revision 3437)
@@ -0,0 +1,171 @@
+#-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 1:00:00                # Max total CPU time
+#-Q- sxnec #@$-lt 0:59:00                # Max CPU time per process
+#-Q- sxnec #@$-lM 2Gb                    # 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= 5000
+#-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=3.6gb      # Max memory
+#-Q- sx8mercure #PBS -l cputim_job=0:40: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_LIM
+#- 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 ocean and ice
+cp ${R_EXPER}/namelist_ice_lim2 namelist_ice 
+cp ${R_EXPER}/namelist namelist
+
+#- Namelist for ocean and ice (agrif fine grid)
+cp ${R_EXPER}/1_namelist_ice_lim2 1_namelist_ice 
+cp ${R_EXPER}/1_namelist 1_namelist
+cp ${R_EXPER}/AGRIF_FixedGrids.in AGRIF_FixedGrids.in
+
+#- Files for the configuration and ocean dynamics
+Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.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 *_grid_*.nc
+do
+$DPUT ${file_netcdf} ${R_SORTIE_OCE}/${file_netcdf}
+done
+#
+#- Save ice output files
+for file_netcdf in *icemod*
+do
+$DPUT ${file_netcdf} ${R_SORTIE_OCE}/${file_netcdf} 
+done
+$DPUT ice.evolu ${R_SORTIE_OCE}/ice.evolu 
+#
+#- 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AGRIF_FixedGrids.in
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AGRIF_FixedGrids.in	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/AGRIF_FixedGrids.in	(revision 3437)
@@ -0,0 +1,3 @@
+1
+125 170 36 63 4 4 2
+0
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/EMPave_old.dat
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/EMPave_old.dat	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/EMPave_old.dat	(revision 3437)
@@ -0,0 +1,1 @@
+                               0  0.0000000000000000E+00  0.0000000000000000E+00
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,1305 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+    <!-- tidal composante -->
+    <field id="M2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="S2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="S2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="N2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="N2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="O1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="O1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Q1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Q1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="M4x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M4y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="P1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="P1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mfx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mfy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mmx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mmy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+
+    <field id="M2x_u"          description="M2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_u"          description="M2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_u"          description="S2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_u"          description="S2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_u"          description="N2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_u"          description="N2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_u"          description="K1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_u"          description="K1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_u"          description="O1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_u"          description="O1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_u"          description="Q1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_u"          description="Q1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_u"          description="M4 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_u"          description="M4 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_u"          description="K2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_u"          description="K2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_u"          description="P1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_u"          description="P1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_u"          description="Mf current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_u"          description="Mf current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_u"          description="Mm current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_u"          description="Mm current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+
+    <field id="M2x_v"          description="M2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_v"          description="M2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_v"          description="S2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_v"          description="S2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_v"          description="N2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_v"          description="N2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_v"          description="K1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_v"          description="K1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_v"          description="O1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_v"          description="O1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_v"          description="Q1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_v"          description="Q1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_v"          description="M4 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_v"          description="M4 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_v"          description="K2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_v"          description="K2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_v"          description="P1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_v"          description="P1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_v"          description="Mf current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_v"          description="Mf current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_v"          description="Mm current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_v"          description="Mm current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+	<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+	<field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"   operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   operation="inst(X)"  />
+        <field id="traj_dep"   description="floats depth"       unit="m"     operation="inst(X)"  />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  operation="inst(X)"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   operation="inst(X)"  />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" operation="inst(X)"  />
+        <field id="traj_group" description="floats group"       unit="none"  operation="inst(X)"  />
+      </group>
+
+    </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+	<!-- automatic definition of the name based on id="1d_grid_T" 
+	     => this name is used as the radical for all file names of this group
+	     => add a suffix to be sure that all files names of this group are different   -->
+	<group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+	  <!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
+	  <file id="0n180wT" name_suffix="auto" >
+	    <group id="0n180wT" zoom_ref="0n180wT" >    <!-- group of variables sharing the same zoom -->
+	      <field ref="toce" name="votemper"  />
+	      <field ref="uoce" name="vozocrtx"  />     <!-- include a U-grid variable in the list => switch to T-grid -->
+	    </group>
+	  </file>
+	  <!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
+	  <file id="EqT" name_suffix="auto" >
+	    <group id="EqT" zoom_ref="EqT" >
+	      <field ref="toce" name="votemper"  />
+	    </group>
+	  </file>
+	  <!-- global file with different operations on data   -->
+	  <file id="global" >
+	    <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+	    <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+            <field ref="M2x"     name="M2_x_elev"  />
+            <field ref="M2y"     name="M2_y_elev"  />
+	  </file>
+	</group>
+
+        <!-- variables available with key_float, instantaneous fields -->
+<!--
+        <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>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+	
+	<file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+	
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+	<file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+	</file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m"       positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m"       positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m"       positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m"       positive=".false." />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+    </grid_definition>    
+    
+  </context>
+  <context id="1_nemo">
+    
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+    <!-- tidal composante -->
+    <field id="M2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="S2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="S2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="N2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="N2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="O1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="O1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Q1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Q1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="M4x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="M4y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="K2x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="K2y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="P1x"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="P1y"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mfx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mfy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+    <field id="Mmx"          description="M2 Elevation harmonic real part "                             unit="m"        />
+    <field id="Mmy"          description="M2 Elevation harmonic imaginary part"                         unit="m"        />
+
+    <field id="M2x_u"          description="M2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_u"          description="M2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_u"          description="S2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_u"          description="S2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_u"          description="N2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_u"          description="N2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_u"          description="K1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_u"          description="K1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_u"          description="O1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_u"          description="O1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_u"          description="Q1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_u"          description="Q1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_u"          description="M4 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_u"          description="M4 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_u"          description="K2 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_u"          description="K2 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_u"          description="P1 current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_u"          description="P1 current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_u"          description="Mf current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_u"          description="Mf current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_u"          description="Mm current barotrope along i-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_u"          description="Mm current barotrope along i-axis harmonic imaginary part " unit="m/s"        />
+
+    <field id="M2x_v"          description="M2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M2y_v"          description="M2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="S2x_v"          description="S2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="S2y_v"          description="S2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="N2x_v"          description="N2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="N2y_v"          description="N2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K1x_v"          description="K1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K1y_v"          description="K1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="O1x_v"          description="O1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="O1y_v"          description="O1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Q1x_v"          description="Q1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Q1y_v"          description="Q1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="M4x_v"          description="M4 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="M4y_v"          description="M4 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="K2x_v"          description="K2 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="K2y_v"          description="K2 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="P1x_v"          description="P1 current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="P1y_v"          description="P1 current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mfx_v"          description="Mf current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mfy_v"          description="Mf current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+    <field id="Mmx_v"          description="Mm current barotrope along j-axis harmonic real part "      unit="m/s"        />
+    <field id="Mmy_v"          description="Mm current barotrope along j-axis harmonic imaginary part " unit="m/s"        />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+	
+	<!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+	<field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"   operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   operation="inst(X)"  />
+        <field id="traj_dep"   description="floats depth"       unit="m"     operation="inst(X)"  />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  operation="inst(X)"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   operation="inst(X)"  />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" operation="inst(X)"  />
+        <field id="traj_group" description="floats group"       unit="none"  operation="inst(X)"  />
+      </group>
+
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+        <!-- automatic definition of the name based on id="1d_grid_T"
+             => this name is used as the radical for all file names of this group
+             => add a suffix to be sure that all files names of this group are different   -->
+        <group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+          <!-- global file with different operations on data   -->
+          <file id="global" >
+            <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+            <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+            <field ref="M2x"     name="M2_x_elev"  />
+            <field ref="M2y"     name="M2_y_elev"  />
+          </file>
+        </group>
+
+        <!-- variables available with key_float, instantaneous fields -->
+<!--
+        <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>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+	
+<!--	
+      <file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+-->	
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+	<file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+	</file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+    </grid_definition>    
+    
+  </context>
+
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef_ar5.xml	(revision 3437)
@@ -0,0 +1,634 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+
+    <!-- $id$ -->
+    
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="0" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+	
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                 />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                                                                                          =
+=                                           output files definition                                        =
+=                                                                                                          =
+=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Oclim                 =
+=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Omon                  =
+=                  http://www2-pcmdi.llnl.gov/svn/repository/cmor/trunk/Tables/CMIP5_Oimon                 =              
+=          http://www.clivar.org/organization/wgomd/references/WGOMD_CMIP5_ocean_fields.June2009.pdf       =
+=                                                                                                          =
+============================================================================================================
+    -->
+    
+    <file_definition output_level="10" >
+      <!--
++++++++++++++++++++++++++++++++++++++++++++++++   daily   ++++++++++++++++++++++++++++++++++++++++++++++++++
+        -->
+      <group id="1d" output_freq="86400"  enabled=".TRUE.">                      <!-- 1d files -->
+	<file id="1d_grid_T" name="auto" name_suffix="_table2.2" description="table 2.2" >         <!-- grid T  -->
+	  <field ref="sst"          name='tos'      description="sea_surface_temperature"                              level="2"                      />
+	  <field ref="sst2"         name='tossq'    description="square_of_sea_surface_temperature"                    level="2"                      />
+	  <field ref="mldkz5"       name='omldamax' description="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="t_max(X)" />
+	</file>   
+      </group>
+	<!--
+++++++++++++++++++++++++++++++++++++++++++++++   monthly   +++++++++++++++++++++++++++++++++++++++++++++++++
+	  -->
+      <group id="1m" output_freq="-1"     enabled=".TRUE.">                      <!-- real monthly files -->
+	<!--
+..............................................    grid T   .................................................
+	  -->
+	<group id="1m_grid_T" name="auto" >                                                        <!-- grid T -->
+	  
+	  <file id="1m grid_T table 2.2" name_suffix="_table2.2" >
+	    <field ref="botpres"      name="pbo"      description="sea_water_pressure_at_sea_floor"                               />
+	    <!-- pso : sea_water_pressure_at_sea_water_surface = 0 -->
+	    <field ref="ssh"          name="zos"      description="sea_surface_height_above_geoid"                                 />
+	    <field ref="ssh2"         name="zossq"    description="square_of_sea_surface_height_above_geoid"             level="2" />
+	    <!-- masscello : sea_water_mass_per_unit_area = cellthc*rau0                                          no time changes -->
+	    <field ref="cellthc"      name="thkcello" description="cell_thickness"                                                 /> <!-- no time changes -->
+	    <field ref="toce"         name="thetao"   description="sea_water_potential_temperature"                                />
+	    <field ref="sst"          name="tos"      description="sea_surface_temperature"                              level="1" />
+	    <field ref="sst2"         name="tossq"    description="square_of_sea_surface_temperature"                    level="2" />
+	    <field ref="soce"         name="so"       description="sea_water_salinity"                                             />
+	    <field ref="sss"          name="sos"      description="sea_surface_salinity"                                 level="1" />
+	    <field ref="rhop"         name="rhopoto"  description="sea_water_potential_density"                          level="2" />
+	    <!-- no agessc : sea_water_age_since_surface_contact -->
+	    <!-- no cfc11  : moles_per_unit_mass_of_cfc11_in_sea_water -->
+	    <!-- msftbarot : ocean_barotropic_mass_streamfunction : offline -->
+	    <!-- mlotst    :           ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
+	    <!-- mlotstsq  : square_of_ocean_mixed_layer_thickness_defined_by_sigma_t : must be done offline -->
+	    <field ref="mldkz5"       name='omlmax'   description="ocean_mixed_layer_thickness_defined_by_mixing_scheme" level="2" operation="t_max(X)" />
+	  </file>   
+	  
+	  <file id="1m grid_T table 2.5" name_suffix="_table2.5" >
+	    <field ref="rain"         name="pr"       description="rainfall_flux"                                           level="1" />
+	    <field ref="snow_ao_cea"  name="prsn"     description="snowfall_flux"                                           level="1" />
+	    <field ref="evap_ao_cea"  name="evs"      description="water_evaporation_flux"                                  level="1" />
+	    <field ref="runoffs"      name="friver"   description="water_flux_into_sea_water_from_rivers"                   level="1" />
+	    <field ref="calving"      name="ficeberg" description="water_flux_into_sea_water_from_icebergs"                 level="1" />
+	    <field ref="isnwmlt_cea"  name="fsitherm" description="water_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
+	    <field ref="empmr"        name="wfo"      description="water_flux_into_sea_water"                               level="1" />
+	    <!-- wfonocorr : water_flux_into_sea_water_without_flux_correction : emp - erp -->  
+	    <field ref="erp"          name="wfcorr"   description="water_flux_correction"                                   level="1" /> <!-- usually = 0 -->
+	  </file>   
+	  
+	  <file id="1m grid_T table 2.6" name_suffix="_table2.6" >
+	    <!-- vsfpr    : virtual_salt_flux_into_sea_water_due_to_rainfall    = 0 --> 
+	    <!-- vsfevap  : virtual_salt_flux_into_sea_water_due_to_evaporation = 0 --> 
+	    <!-- vsfriver : virtual_salt_flux_into_sea_water_from_rivers        = 0 --> 	  
+	    <field ref="fsal_virt_cea" name="vsfsit" description="virtual_salt_flux_into_sea_water_due_to_sea_ice_thermodynamics" level="1" />
+	    <!-- vsf      : virtual_salt_flux_into_sea_water = fsal_virtual + fsal_real -->
+	    <!-- wfcorr   : virtual_salt_flux_correction                        = 0 --> 
+	    <field ref="fsal_virt_cea" name="sfdsi"  description="downward_sea_ice_basal_salt_flux"                               level="1" />
+	    <!-- sfriver  : salt_flux_into_sea_water_from_rivers                = 0 --> 
+	  </file>   
+	  
+	  <file id="1m grid_T table 2.7" name_suffix="_table2.7" >
+	    <!-- hfgeou : upward_geothermal_heat_flux_at_sea_floor : cte, see nambbc and trabbc.F90 -->
+	    <field ref="hflx_rain_cea" name="hfrainds"    description="temperature_flux_due_to_rainfall_expressed_as_heat_flux_into_sea_water"      level="1" />
+	    <field ref="hflx_evap_cea" name="hfevapds"    description="temperature_flux_due_to_evaporation_expressed_as_heat_flux_out_of_sea_water" level="1" />
+	    <field ref="hflx_rnf_cea"  name="hfrunoffds"  description="temperature_flux_due_to_runoff_expressed_as_heat_flux_into_sea_water"        level="1" />
+	    <field ref="hflx_snow_cea" name="hfsnthermds" description="heat_flux_into_sea_water_due_to_snow_thermodynamics"                         level="1" />
+	    <field ref="hflx_ice_cea"  name="hfsithermds" description="heat_flux_into_sea_water_due_to_sea_ice_thermodynamics"                      level="1" />
+	    <field ref="hflx_cal_cea"  name="hfibthermds" description="heat_flux_into_sea_water_due_to_iceberg_thermodynamics"                      level="1" />
+	    <!-- rlds   : surface_net_downward_longwave_flux : not available -->
+	    <!-- hfls   : surface_downward_latent_heat_flux  : not available -->
+	    <!-- hfss   : surface_downward_sensible_heat_flux: not available -->
+	    <field ref="qns"           name="nshfls"      description="surface_net_downward_non_solar_flux"                                         level="1" />
+	    <field ref="qsr"           name="rsntds"      description="surface_net_downward_shortwave_flux"                                         level="1" />
+	    <field ref="qsr3d"         name="rsds"        description="downwelling_shortwave_flux_in_sea_water"                                     level="1" />
+	    <field ref="qrp"           name="hfcorr"      description="heat_flux_correction"                                                        level="1" />
+	  </file>   
+	</group>
+	<!--
+..............................................    grid U   .................................................
+	  -->
+	<group id="1m_grid_U" name="auto" >                                                        <!-- grid U -->
+
+	  <file id="1m grid_U table 2.3" name_suffix="_table2.3" >
+	    <field ref="uoce"         name="uo"      description="sea_water_x_velocity"                                       />
+	    <field ref="u_masstr"     name="umo"     description="ocean_mass_x_transport"                           level="1" />
+	    <field ref="u_heattr"     name="hfx"     description="ocean_heat_x_transport"                           level="1" />
+	    <field ref="ueiv_heattr"  name="hfxba"   description="ocean_heat_x_transport_due_to_bolus_advection"    level="2" />
+	    <field ref="udiff_heattr" name="hfxdiff" description="ocean_heat_x_transport_due_to_diffusion"          level="2" />
+	  </file>   
+
+	  <file id="1m grid_U table 2.8" name_suffix="_table2.8" >
+	    <field ref="utau"         name="tauuo" description="surface_downward_x_stress"                          level="1" />
+	    <!-- tauucorr : surface_downward_x_stress_correction = 0 -->
+	  </file>   
+
+	</group>
+	<!--
+..............................................    grid V   .................................................
+	  -->
+	<group id="1m_grid_V" name="auto" >                                                        <!-- grid V -->
+
+	  <file id="1m grid_V table 2.3" name_suffix="_table2.3" >
+	    <field ref="voce"         name="vo"      description="sea_water_y_velocity"                                       />
+	    <field ref="v_masstr"     name="vmo"     description="ocean_mass_y_transport"                           level="1" />
+	    <field ref="v_heattr"     name="hfy"     description="ocean_heat_y_transport"                           level="1" />
+	    <field ref="veiv_heattr"  name="hfyba"   description="ocean_heat_y_transport_due_to_bolus_advection"    level="2" />
+	    <field ref="vdiff_heattr" name="hfydiff" description="ocean_heat_y_transport_due_to_diffusion"          level="2" />
+	  </file>   
+
+	  <file id="1m grid_V table 2.8" name_suffix="_table2.8" >
+	    <field ref="vtau"         name="tauvo" description="surface_downward_y_stress"                          level="1" />
+	    <!-- tauvcorr : surface_downward_y_stress_correction = 0 -->
+	  </file>   
+
+	</group>
+	<!--
+..............................................    grid W   .................................................
+	  -->
+	<group id="1m_grid_W" name="auto" >                                                        <!-- grid W -->
+	  
+	  <file id="1m grid_W table 2.3" name_suffix="_table2.3" >
+	    <field ref="w_masstr"   name="wmo"   description="upward_ocean_mass_transport"                                    />
+	    <field ref="w_masstr2"  name="wmosq" description="square_pf_upward_ocean_mass_transport"                          />
+	  </file>   
+	  
+	  <file id="1m grid_W table 2.9" name_suffix="_table2.9" >
+	    <field ref="avt"     name="difvho"   description="ocean_vertical_heat_diffusivity"                  level="2" />
+	    <field ref="avs"     name="difvso"   description="ocean_vertical_salt_diffusivity"                  level="2" />
+	    <!-- difvtrbo : ocean_vertical_tracer_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb and  nn_havtb -->
+	    <field ref="av_tide" name="difvtrto" description="ocean_vertical_tracer_diffusivity_due_to_tides"   level="2" />
+	    <!-- tnpeo     : tendency_of_ocean_potential_energy_content                   : not available -->
+	    <!-- tnpeot    : tendency_of_ocean_potential_energy_content_due_to_tides      : not available -->
+	    <!-- tnpeotb   : tendency_of_ocean_potential_energy_content_due_to_background : not available -->
+	    <field ref="avm"     name="difvmo"   description="ocean_vertical_momentum_diffusivity"              level="2" />
+	    <!-- difvmbo : ocean_vertical_momentum_diffusivity_due_to_background : cte with time, see namelist parameters nn_avb -->
+	    <field ref="av_tide" name="difvmto"  description="ocean_vertical_momentum_diffusivity_due_to_tides" level="2" /> <!-- same as tracer -->
+	    <!-- difvmfdo : ocean_vertical_momentum_diffusivity_due_to_form_drag : ??? -->
+	    <!-- dispkevfo : ocean_kinetic_energy_dissipation_per_unit_area_due_to_vertical_friction : not available -->
+	  </file>
+
+	  <file id="1m grid_W table 2.10" name_suffix="_table2.10" >
+	    <!-- if ln_traldf_lap    =  .true. -->
+	    <field ref="aht2d_eiv" name="diftrblo" description="ocean_tracer_bolus_laplacian_diffusivity"                     level="2" />
+	    <!-- diftrelo : ocean_tracer_epineutral_laplacian_diffusivity : cte with time, see ln_traldf_iso -->
+	    <!-- diftrxylo : ocean_tracer_xy_laplacian_diffusivity : cte with time -->
+	    <!-- if ln_traldf_bilap  =  .true. -->
+	    <!-- field ref="diftrbbo" name="aht2d_eiv" description="ocean_tracer_bolus_biharmonic_diffusivity"                    level="2" /-->
+	    <!-- diftrebo : ocean_tracer_epineutral_biharmonic_diffusivity : cte with time, see ln_traldf_iso -->
+	    <!-- diftrxybo : ocean_tracer_xy_biharmonic_diffusivity : cte with time -->
+	    <!-- tnkebto : tendency_of_ocean_eddy_kinetic_energy_content_due_to_bolus_transport : not available -->
+	    <!-- difmxylo : ocean_momentum_xy_laplacian_diffusivity : cte with time, see ln_dynldf_lap -->
+	    <!-- difmxybo : ocean_momentum_xy_biharmonic_diffusivity : cte with time, see ln_dynldf_bilap -->
+	    <!-- dispkexyfo : ocean_kinetic_energy_dissipation_per_unit_area_due_to_xy_friction : not available -->
+	  </file>   
+
+	</group>
+	<!--
+..............................................    scalar   .................................................
+	  -->
+	<file id="1m_scalar" name="auto" name_suffix="_table2.2" description="table 2.2" >         <!-- scalar -->
+	  <field ref="masstot"    name="masso"    description="sea_water_mass"                                />
+	  <field ref="voltot"     name="volo"     description="sea_water_volume"                              />
+	  <field ref="sshtot"     name="zosga"    description="global_average_sea_level_change"               />
+	  <field ref="sshsteric"  name="zossga"   description="global_average_steric_sea_level_change"        />
+	  <field ref="sshthster"  name="zostoga"  description="global_average_thermosteric_sea_level_change"  />
+	  <field ref="temptot"    name="thetaoga" description="sea_water_potential_temperature"               />
+	  <field ref="saltot"     name="soga"     description="sea_water_salinity"                            />
+	</file>   
+	<!--
+..............................................    icemod   .................................................
+	  -->
+	<file id="1m_icemod" name="auto" name_suffix="_table2.2" description="table 2.2" >         <!-- scalar -->
+	  <field ref="ice_pres"                     />
+	  <field ref="ice_cover"    name="sic"        description="sea_ice_area_fraction"                            />
+	  <field ref="icethic_cea"  name="sit"        description="sea_ice_thickness"                                />
+	  <field ref="subl_ai_cea"  name="evap"       description="water_evaporation_flux"                           />
+	  <field ref="snowthic_cea" name="snd"        description="surface_snow_thickness"                           />
+	  <!-- snc : surface_snow_area_fraction : same as sic -->
+	  <field ref="icealb_cea"   name="ialb"       description="Bare Sea Ice Albedo"                              />
+	  <!-- ssi : Sea Ice Salinity : cte = sice = 6, expect in baltic sea = 2 -->
+	  <field ref="ist_cea"      name="tsice"      description="Surface Temperature of Sea Ice"                   />
+	  <!-- tsnint : Temperature at Interface Between Sea Ice and Snow : not available -->
+	  <!-- pr : Surface Rainfall Rate into the Sea Ice Portion of the Grid Cell = 0 -->
+	  <field ref="snow_ai_cea"  name="prsn"       description="Surface Snowfall Rate into the Sea Ice Portion of the Grid Cell" />
+	  <!-- ageice   : Age of Sea Ice : not available ??? -->
+	  <!-- grFrazil : Frazil Sea Ice Growth (Leads) Rate ??? -->
+	  <!-- grCongel : Congelation Sea Ice Growth Rate ??? -->
+	  <field ref="licepro_cea"  name="grLateral"  description="Lateral Sea Ice Growth Rate"                      />
+	  <field ref="sntoice_cea"  name="snoToIce"   description="Snow-Ice Formation Rate"                          />
+	  <field ref="snowmel_cea"  name="snomelt"    description="Snow Melt Rate"                                   />
+	  <field ref="ticemel_cea"  name="tmelt"      description="Rate of Melt at Upper Surface of Sea Ice"         />
+	  <field ref="bicemel_cea"  name="bmelt"      description="Rate of Melt at Sea Ice Base"                     />
+	  <!-- hcice  : Sea Ice Total Heat Content ??? -->
+	  <field ref="qsr_ai_cea"   name="rsdssi"     description="surface_downwelling_shortwave_flux_in_air"        />
+	  <!-- rsussi : surface_upwelling_shortwave_flux_in_air ??? -->
+	  <!-- rldssi : surface_downwelling_longwave_flux_in_air ??? -->
+	  <!-- rlussi : surface_upwelling_longwave_flux_in_air ??? -->
+	  <!-- hfssi  : surface_upward_sensible_heat_flux ??? -->
+	  <!-- hflssi : surface_upward_latent_heat_flux ??? -->
+	  <field ref="subl_ai_cea"  name="sblsi"      description="surface_snow_and_ice_sublimation_flux"             />
+	  <field ref="u_imasstr"    name="transix"    description="Eastward Sea Ice Transport"                        />
+	  <field ref="v_imasstr"    name="transiy"    description="Northward Sea Ice Transport"                       />
+	  <field ref="fram_trans"   name="transifs"   description="Sea Ice Mass Transport Through Fram Strait"        />
+	  <field ref="utau_ice"     name="strairx"    description="Eastward Atmospheric Stress On Sea Ice"            />
+	  <field ref="vtau_ice"     name="strairy"    description="Northward Atmospheric Stress On Sea Ice"           />
+	  <!-- strocnx : Eastward Ocean Stress On Sea Ice ??? -->
+	  <!-- strocny : Northward Ocean Stress On Sea Ice ??? -->
+	  <!-- streng  : Compressive Sea Ice Strength ??? -->
+	  <!-- divice  : Strain Rate Divergence of Sea Ice ??? -->
+	  <!-- shrice  : Strain Rate Shear of Sea Ice ??? -->
+	  <!-- ridgice : Sea Ice Ridging Rate ??? -->
+	</file>   
+      </group>
+
+      <!-- 
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+        -->
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+	<zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+	<zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+	<zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+	<zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+	<zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+	<zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+	<zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+	<zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+	<zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+	<zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+	<zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+	<zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+	<zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+ 	<zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+	<zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+	<zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+	<zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+	<zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+	<zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+	<zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+	<zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+	<zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+	<zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+	<zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+	<zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+	<zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+	<zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+    </grid_definition>    
+    
+  </context>
+  
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist	(revision 3437)
@@ -0,0 +1,986 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  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_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+                           !    = 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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    5475   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    5475   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    0      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 5760.     !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 28800.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 28800.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   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)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 5         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave)
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+!-----------------------------------------------------------------------
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .true.    !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      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
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =  -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
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nam_tide      !   tide parameters (#ifdef key_tide)
+!-----------------------------------------------------------------------
+   ln_tide_pot   = .true.   !  use tidal potential forcing
+   nb_harmo      =    11    !  number of constituents used
+   clname(1)     =   'M2'   !  name of constituent
+   clname(2)     =   'S2'
+   clname(3)     =   'N2'
+   clname(4)     =   'K1'
+   clname(5)     =   'O1'
+   clname(6)     =   'Q1'
+   clname(7)     =   'M4'
+   clname(8)     =   'K2'
+   clname(9)     =   'P1'
+   clname(10)    =   'Mf'
+   clname(11)    =   'Mm'
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&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                 
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative 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 mized 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]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   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   =    1      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&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 sections
+!-----------------------------------------------------------------------
+    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
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .true.   ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice	(revision 3437)
@@ -0,0 +1,1 @@
+link namelist_ice_lim2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim2	(revision 3437)
@@ -0,0 +1,129 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! 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_out = "restart_ice"      !  suffix of ice restart name (output)
+   ln_limdyn     = .true.             !  ice dynamics (T) or thermodynamics only (F)
+   ln_limdmp     = .false.            !  restoring ice thickness and fraction leads   (T => 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
+   creepl      =   1.0e-08 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   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 !
+!              !              !  (if <0  months)  !   name   !  (logical)   !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_hicif    = 'ice_damping',  -1.              , 'hicif'  ,   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'ice_damping',  -1.              , 'frld'   ,   .true.     , .true. , 'yearly'  , ''       , ''
+!
+   cn_dir      = './'      !  root directory for the location of the runoff files
+/
+!-----------------------------------------------------------------------
+&namicedia     !   ice diagnostics
+!-----------------------------------------------------------------------
+   fmtinf      = '1PE13.5' !  format of the output values
+   nfrinf      =  4        !  number of variables written in one line
+   ntmoy       =  1        !  instantaneous values of ice evolution or averaging
+   ninfo       =  1        !  frequency of ouputs on file ice_evolu in case of averaging
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim3
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim3	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_ice_lim3	(revision 3437)
@@ -0,0 +1,193 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/LIM3 :  1 - dynamics/advection/thermo          (namicerun)
+!! namelists    2 - ice intialisation                  (namiceini)
+!!              3 - ice dynamic                        (namicedyn)
+!!              4 - ice advection                      (namicetrp)
+!!              5 - thermodynamic                      (namicethd)
+!!              6 - ice salinity                       (namicesal)
+!!              7 - mechanical redistribution of ice   (namiceitdme)
+!!              8 - ice diagnostics                    (namicedia)
+!!              9 - ice outputs                        (namiceout)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!-----------------------------------------------------------------------
+&namicerun     !   Share parameters for dynamics/advection/thermo
+!-----------------------------------------------------------------------
+   cn_icerst_in  = "restart_ice_in"   !  suffix of ice restart name (input)
+   cn_icerst_out = "restart_ice"      !  suffix of ice restart name (output)
+   ln_limdyn   = .true.    !  ice dynamics (T) or thermodynamics only (F)
+   acrit       =  1.0e-02 , 1.0e-02  !  minimum fraction for leads in the Northern (Southern) Hemisphere
+   hsndif      =  0.0      !  computation of temperature in snow (=0.0) or not
+   hicdif      =  0.0      !  computation of temperature in ice  (=0.0) or not (=9999.0)
+   cai         =  1.40e-3  !  atmospheric drag over sea ice
+   cao         =  1.00e-3  !  atmospheric drag over ocean
+   ln_nicep    = .false.   !  Ice points output for debug (yes or no)
+/
+!-----------------------------------------------------------------------
+&namiceini     !   ice initialisation
+!-----------------------------------------------------------------------
+   ttest       =  2.0      !  threshold water temperature for initial sea ice
+   hninn       =  0.3      !  initial snow thickness in the north
+   hnins       =  0.1      !        "            "          south
+   hginn_u     =  3.50     !  initial undeformed ice thickness in the north
+   hgins_u     =  1.0      !        "            "              "     south
+   aginn_u     =  0.95     !  initial undeformed ice concentration in the north
+   agins_u     =  0.9      !        "            "              "         south
+   hginn_d     =  0.0      !  initial  deformed  ice thickness     in the north
+   hgins_d     =  0.0      !  
+   aginn_d     =  0.00     !  initial  deformed  ice concentration in the north
+   agins_d     =  0.00     !        "            "              "         south
+   sinn        =  6.301    !  initial salinity in the north
+   sins        =  6.301    !        "            "    south
+/
+!-----------------------------------------------------------------------
+&namicedyn     !   ice dynamic
+!-----------------------------------------------------------------------
+   epsd        =   1.0e-20 !  tolerance parameter
+   alpha       =   0.5     !  coefficient for semi-implicit coriolis
+   dm          =   0.6e+03 !  diffusion constant for dynamics
+   nbiter      =   1       !  number of sub-time steps for relaxation
+   nbitdr      = 500       !  maximum number of iterations for relaxation
+   om          =   0.5     !  relaxation constant 
+   resl        =   5.0e-05 !  maximum value for the residual of relaxation
+   cw          =   5.0e-03 !  drag coefficient for oceanic stress
+   angvg       =   0.0     !  turning angle for oceanic stress
+   pstar       =   4.0e+04 !  1st bulk-rheology parameter
+   c_rhg       =  20.0     !  2nd bulk-rhelogy parameter
+   etamn       =   0.0e+07 !  minimun value for viscosity
+   creepl      =   1.0e-12 !  creep limit
+   ecc         =   2.0     !  eccentricity of the elliptical yield curve
+   ahi0        = 350.e0    !  horizontal eddy diffusivity coefficient for sea-ice [m2/s]
+   nevp        = 300       !  number of iterations for subcycling in EVP, SB, 400
+   telast      =9600.0     !  timescale for elastic waves, SB, 720.0
+   alphaevp    =   1.0     !  coefficient for the solution of internal ice stresses
+/
+!-----------------------------------------------------------------------
+&namicetrp     !   ice transport
+!-----------------------------------------------------------------------
+   bound       =   0.      !  boundary conditions (=0.0 no-slip, =1.0 free-slip)
+/
+!-----------------------------------------------------------------------
+&namicethd     !   ice thermodynamic
+!-----------------------------------------------------------------------
+   hmelt       = -0.15     !  maximum melting at the bottom
+   hiccrit     = 0.1 , 0.1 !  ice thickness for lateral accretion in the Northern (Southern) Hemisphere
+                           !         caution 1.0, 1.0 best value to be used!!! (gilles G.)  ????
+   fraz_swi    = 0.0       !  use of frazil ice collection thickness in function of wind (1.0) or not (0.0)
+   maxfrazb    = 0.0       !  maximum portion of frazil ice collecting at the ice bottom
+   vfrazb      = 0.4166667 !  thresold drift speed for frazil ice collecting at the ice bottom
+   Cfrazb      = 5.0       !  squeezing coefficient for frazil ice collecting at the ice bottom
+   hicmin      = 0.2       !  ice thickness corr. to max. energy stored in brine pocket
+   hiclim      = 0.10      !  minimum ice thickness
+   amax        = 0.999     !  maximum lead fraction
+   sbeta       = 1.        !  numerical caracteritic of the scheme for diffusion in ice
+                           !        Cranck-Nicholson (=0.5), implicit (=1), explicit (=0)
+   parlat      = 0.0       !  percentage of energy used for lateral ablation
+   hakspl      = 0.25      !  slope of distr. for Hakkinen-Mellor's lateral melting
+   hibspl      = 0.5       !  slope of distribution for Hibler's lateral melting
+   exld        = 2.0       !  exponent for leads-closure rate
+   hakdif      = 1.0       !  coefficient for diffusions of ice and snow
+   thth        = 0.2       !  threshold thickness for comp. of eq. thermal conductivity
+   hnzst       = 0.1       !  thickness of the surf. layer in temp. computation
+   parsub      = 1.0       !  switch for snow sublimation or not
+   alphs       = 1.0       !  coefficient for snow density when snow ice formation
+   betas       = 0.6       !  exponent in lead-ice fractionation of snow precipitation 0.66
+                           !        betas = 1 -> equipartition, betas < 1 -> more on leads
+   kappa_i     = 1.0       !  extinction radiation parameter in sea ice (1.0)
+   nconv_i_thd = 50        !  maximal number of iterations for heat diffusion computation
+   maxer_i_thd = 0.0001    !  maximal error in temperature for heat diffusion computation
+   thcon_i_swi = 1         !  switch for computation of thermal conductivity in the ice
+                           !        (0) Untersteiner (1964), (1) Pringle et al. (2007)
+/
+!-----------------------------------------------------------------------
+&namicesal     !   ice salinity
+!-----------------------------------------------------------------------
+   num_sal     =  2        !  salinity option: 1 -> S = bulk_sal
+                           !                   2 -> S = S(z,t) with a simple parameterization
+                           !                   3 -> S = S(z) profile of Scwharzacher [1959]
+                           !                   4 -> S = S(h) Cox and Weeks [1974]
+   bulk_sal    =  4.0      !  if 1 is used, it represents the ice salinity
+   sal_G       =  5.00     !  restoring salinity for GD
+   time_G      =  1.728e+6 !  restoring time for GD
+   sal_F       =  2.00     !  restoring salinity for flushing
+   time_F      =  8.640e+5 !  restoring time for flushing
+   s_i_max     = 20.0      !  Maximum salinity 
+   s_i_min     =  0.1      !  Minimum tolerated ice salinity
+   s_i_0       =  3.5      !  1st salinity for salinity profile
+   s_i_1       =  4.5      !  2nd salinity for salinity profile
+/
+!-----------------------------------------------------------------------
+&namiceitdme   !   parameters for mechanical redistribution of ice 
+!-----------------------------------------------------------------------
+   ridge_scheme_swi = 0      !  which ridging scheme using (1=Rothrock,else=Hibler79)
+   Cs               =   0.50 !  shearing energy contribution to ridging
+   Cf               =  17.0  !  ratio of ridging work to PE change in ridging
+   fsnowrdg         =   0.5  !  snow fraction that survives in ridging
+   fsnowrft         =   0.5  !  snow fraction that survives in rafting
+   Gstar            =   0.15 !  fractional area of thin ice being ridged
+   astar            =   0.05 !  equivalent of gstar (0.05 for TH75 and 0.03 for weaker ice)
+   Hstar            = 100.0  !  parameter determining the maximum thickness of ridged ice
+   raftswi          =   1    !  rafting or not
+   hparmeter        =   0.75 !  threshold thickness for rafting or not
+   Craft            =   5.0  !  coefficient used in the rafting function
+   ridge_por        =   0.3  !  initial porosity of the ridged ice (typically 0.30)
+   sal_max_ridge    =  15.0  !  maximum ridged ice salinity
+   partfun_swi      =   1    !  participation function linear, TH75 (0) or exponential Letal07 (1)
+   transfun_swi     =   0    !  transfer function uniform of H80 (0) or exponential Letal07 (1)
+   brinstren_swi    =   0    !  (1) use brine volume to diminish ice strength
+/
+!-----------------------------------------------------------------------
+&namicedia     !   ice diagnostics
+!-----------------------------------------------------------------------
+   fmtinf      ='1PE13.5 ' !  format of the output values
+   nfrinf      = 4         !  number of variables written in one line
+   ntmoy       = 1         !  instantaneous values of ice evolution or averaging
+   ninfo       = 1         !  frequency of ouputs on file ice_evolu in case of averaging
+/
+!-----------------------------------------------------------------------
+&namiceout     !   parameters for outputs
+!-----------------------------------------------------------------------
+   noumef      =   37      !  number of fields
+   add_diag_swi=    1      !  1 -> diagnose distribution in thickness space
+                           !  0 -> only simple diagnostics
+!
+!           !         title of the field           !  name     !   units   !  save  ! multipl. ! additive !
+!           !                                      !           !           ! or not !  factor  !  factor  !
+   field_1  = 'Ice concentration                  ', 'iiceconc', '%       ',    1   ,  1.0     ,    0.0
+   field_2  = 'Ice thickness                      ', 'iicethic', 'm       ',    1   ,  1.0     ,    0.0
+   field_3  = 'Snow thickness                     ', 'isnowthi', 'm       ',    1   ,  1.0     ,    0.0
+   field_4  = 'Daily bottom thermo ice production ', 'iicebopr', 'cm/day  ',    1   , 100.     ,    0.0
+   field_5  = 'Daily dynamic ice production       ', 'iicedypr', 'cm/day  ',    1   , 100.     ,    0.0
+   field_6  = 'Oceanic flux at the ice base       ', 'ioceflxb', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_7  = 'Ice velocity u                     ', 'iicevelu', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_8  = 'Ice velocity v                     ', 'iicevelv', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_9  = 'Sea surface temperature            ', 'isstempe', 'C       ',    1   ,  1.0     , -273.15
+   field_10 = 'Sea surface salinity               ', 'isssalin', 'PSU     ',    1   ,  1.0     ,    0.0
+   field_11 = 'Total flux at ocean surface        ', 'iocetflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_12 = 'Solar flux at ocean surface        ', 'iocesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_13 = 'Non-solar flux at ocean surface    ', 'iocwnsfl', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_14 = 'Heat flux due to brine release     ', 'iocehebr', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_15 = 'Wind stress u                      ', 'iocestru', 'Pa      ',    1   ,  1.0     ,    0.0
+   field_16 = 'Wind stress v                      ', 'iocestrv', 'Pa      ',    1   ,  1.0     ,    0.0 
+   field_17 = 'Solar flux at ice/ocean surface    ', 'iicesflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_18 = 'Non-solar flux at ice/ocean surface', 'iicenflx', 'w/m2    ',    1   ,  1.0     ,    0.0
+   field_19 = 'Snow precipitation                 ', 'isnowpre', 'kg/day  ',    1   ,  1.0     ,    0.0
+   field_20 = 'Mean ice salinity                  ', 'iicesali', 'psu     ',    1   ,  1.0     ,    0.0
+   field_21 = 'Mean ice age                       ', 'iiceages', 'years   ',    1   ,  0.002739,    0.0
+   field_22 = 'Daily lateral thermo ice prod.     ', 'iicelapr', 'cm/day  ',    1   ,100.      ,    0.0
+   field_23 = 'Daily snowice ice production       ', 'iicesipr', 'cm/day  ',    1   ,100.      ,    0.0
+   field_24 = 'Mean ice temperature               ', 'iicetemp', 'C       ',    1   ,  1.0     , -273.15
+   field_25 = 'Ice total heat content             ', 'iiceheco', '10^9 J  ',    1   ,  1.0     ,    0.0
+   field_26 = 'Ice surface temperature            ', 'iicesurt', 'C       ',    1   ,  1.0     , -273.15
+   field_27 = 'Snow temperature                   ', 'isnotem2', 'C       ',    1   ,  1.0     , -273.15
+   field_28 = 'Fsbri - brine salt flux            ', 'iicfsbri', 'kg/m2/s ',    1   ,  1.0     ,    0.0
+   field_29 = 'Fseqv - equivalent FW salt flux    ', 'iicfseqv', 'kg/m2/s ',    1   ,  1.0     ,    0.0
+   field_30 = 'Brine volume                       ', 'ibrinvol', '%       ',    1   ,  100.0   ,    0.0
+   field_31 = 'Frazil ice collection thickness    ', 'iicecolf', 'm       ',    1   ,  1.0     ,    0.0
+   field_32 = 'Ice strength                       ', 'iicestre', 'N/m     ',    1   ,  0.001   ,    0.0
+   field_33 = 'Ice velocity                       ', 'iicevelo', 'm/s     ',    1   ,  1.0     ,    0.0
+   field_34 = 'Surface melt                       ', 'iicesume', 'cm/day  ',    1   ,100.      ,    0.0
+   field_35 = 'Bottom melt                        ', 'iicebome', 'cm/day  ',    1   ,100.      ,    0.0
+   field_36 = 'Divergence                         ', 'iicedive', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
+   field_37 = 'Shear                              ', 'iiceshea', '10-8s-1 ',    1   ,  1.0e8   ,    0.0
+/      
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/README	(revision 3437)
@@ -0,0 +1,39 @@
+#----------------------------------------------------------------------
+# prerequired
+#----------------------------------------------------------------------
+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
+#----------------------------------------------------------------------
+Use the examples provided in :
+ - std_ts_vardef.sh_example1 or std_ts_vardef.sh_example2
+ - std_plot_vardef.sh_example1 or std_plot_vardef.sh_example2
+to build your own std_plot_vardef.sh or std_ts_vardef.sh file.
+
+This file is needed to define you PATH, the experiments and variables names
+
+
+
+
+
+
+
+
+#----------------------------------------------------------------------
+# short note on: How to build IDL 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/initenv.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/initenv.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/initenv.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_common.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_common.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_common.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_main.sh	(revision 3437)
@@ -0,0 +1,231 @@
+#!/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
+	texexec --pdfarrange --result=$PDF_DIR/$filepdf $pdflist
+	rm -f $PDF_DIR/$( basename $filepdf .pdf ).aux $PDF_DIR/$( basename $filepdf .pdf ).log
+	echo ${PDF_DIR}/$filepdf done
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ArcSal.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ArcSal.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ArcSal.pro	(revision 3437)
@@ -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, 60, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqS.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqS.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqS.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqT.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqT.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqT.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqU.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqU.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_EqU.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_GlobMeanTS.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_GlobMeanTS.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_GlobMeanTS.pro	(revision 3437)
@@ -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 = .2, 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 = 2., 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceFrac.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceFrac.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceFrac.pro	(revision 3437)
@@ -0,0 +1,50 @@
+pro std_plot_IceFrac, Ifra1, Ifra2, ARC = arc, ANT = ant, 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(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 = Ifra1.unit
+;
+  title = var+'!C'+std_file1_I
+  plt, (Ifra1.arr < 1. ) - 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
+    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
+  endif                        
+  
+  domdef
+
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'.png  />  ' ]
+  if KEYWORD_SET(postscript) then closeps
+
+  return
+end
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceThick.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceThick.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_IceThick.pro	(revision 3437)
@@ -0,0 +1,66 @@
+pro std_plot_IceThick, Ithi1, Ithi2, ARC = arc, ANT = ant, 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 = 'IceThi'
+  IF keyword_set(arc) THEN var = var+'_Arc_'
+  IF keyword_set(ant) THEN var = var+'_Ant_'
+  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 = 10.
+    vint = 0.5
+    fmt = '(i2)'
+    vmind = -3.
+    vmaxd = 3.
+    vintd = 0.5
+    fmtd = '(i2)'
+    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)'
+    map = [-90, 0, 0]
+  ENDIF
+;
+  varunit = Ithi1.unit
+;
+  title = var+'!C'+std_file1_I
+  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 $
+       , 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
+    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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sdepth.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sdepth.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sdepth.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sspread.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sspread.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_Med_Sspread.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_S100m.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_S100m.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_S100m.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_T100m.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_T100m.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_T100m.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ZonMld.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ZonMld.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_ZonMld.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_all.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_all.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_all.pro	(revision 3437)
@@ -0,0 +1,364 @@
+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)
+
+; Levitus 98
+  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)
+
+  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 )
+  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
+  march = where(mm EQ 3, cnt)
+  Ithi_march_1 = {arr:1./float(cnt) * total(Ithi_1.arr[*, *, temporary(march)], 3), unit:Ithi_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ithi_sept_1 = {arr:1./float(cnt) * total(Ithi_1.arr[*, *, temporary(sept)], 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
+    march = where(mm EQ 3, cnt)
+    Ithi_march_2 = {arr:1./float(cnt) * total(Ithi_2.arr[*, *, temporary(march)], 3), unit:Ithi_2.unit} 
+    sept = where(mm EQ 9, cnt)
+    Ithi_sept_2 = {arr:1./float(cnt) * total(Ithi_2.arr[*, *, temporary(sept)], 3), unit:Ithi_2.unit} 
+    undefine, Ithi_2
+  ENDIF ELSE BEGIN 
+    Ithi_march_2 = {arr:-1}
+    Ithi_sept_2 = {arr:-1}
+  ENDELSE
+;
+  Ifra_1 = read_ncdf(getenv('VAR1_Ifrac'), allrecords = allrec, filename = std_file1_I ) 
+  caldat, time, mm
+  march = where(mm EQ 3, cnt)
+  Ifra_march_1 = {arr:1./float(cnt) * total(Ifra_1.arr[*, *, temporary(march)], 3), unit:Ifra_1.unit} 
+  sept = where(mm EQ 9, cnt)
+  Ifra_sept_1 = {arr:1./float(cnt) * total(Ifra_1.arr[*, *, temporary(sept)], 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
+    march = where(mm EQ 3, cnt)
+    Ifra_march_2 = {arr:1./float(cnt) * total(Ifra_2.arr[*, *, temporary(march)], 3), unit:Ifra_2.unit}
+    sept = where(mm EQ 9, cnt)
+    Ifra_sept_2 = {arr:1./float(cnt) * total(Ifra_2.arr[*, *, temporary(sept)], 3), unit:Ifra_2.unit}
+    undefine, Ifra_2
+  ENDIF ELSE BEGIN 
+    Ifra_march_2 = {arr:-1}
+    Ifra_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 = '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 = 'Arctic Ice Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_march_1, Ithi_march_2, /ARC, /MARCH, _extra = ex
+  
+  cnt = cnt+1   &   blabla = 'Arctic Ice Thickness: SEPT'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_sept_1, Ithi_sept_2, /ARC, /SEPT, _extra = ex
+  
+  cnt = cnt+1   &   blabla = 'Antarctic Ice Thickness: MARCH'
+  IF doplot EQ cnt OR doplot EQ 0 THEN std_plot_IceThick, Ithi_march_1, Ithi_march_2, /ANT, /MARCH, _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 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_march_1, Ifra_march_2, /ANT, /MARCH, _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 = '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 = '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
+
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_plot_html_body.txt', htmltxt[1:*]
+  
+  return
+END
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_bsf.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_bsf.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_bsf.pro	(revision 3437)
@@ -0,0 +1,33 @@
+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
+
+  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
+    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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_emp.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_emp.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_emp.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_erp.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_erp.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_erp.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mht.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mht.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mht.pro	(revision 3437)
@@ -0,0 +1,84 @@
+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
+
+    varunit = 'Tw'
+    title = 'MHT (TeraW) differences!C'+std_file1_T+' - '+std_file2_T
+    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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mld.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mld.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_mld.pro	(revision 3437)
@@ -0,0 +1,53 @@
+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, MIN = 0., MAX = 500., INTER = 25., /NOCONTOUR, FORMAT = '(I3)' $
+         , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_msf.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_msf.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_msf.pro	(revision 3437)
@@ -0,0 +1,52 @@
+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
+
+  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
+    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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_qnet.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_qnet.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_qnet.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sss.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sss.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sss.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sst.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sst.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_sst.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example1
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example1	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example1	(revision 3437)
@@ -0,0 +1,105 @@
+#!/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
+#
+PS_DIR=$( pwd )/ps
+PDF_DIR=$( pwd )/pdf
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/smasson/SAXO_DIR
+#
+DIR_DATA=/Users/smasson/tmp/idlorca2/res      # path of data in NetCDF format
+DIR_CLIMATO=/Users/smasson/tmp/idlorca2/clim  # path of climatological data
+DIR_MASK=/Users/smasson/tmp/idlorca2/clim     # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/smasson/data/vp33beta_mesh_mask_7.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper   ;   FILE_TEMP_3D=data_1y_potential_temperature_nomask.nc    # Levitus_T
+VAR_SAL_3D=vosaline    ;   FILE_SAL_3D=data_1y_salinity_nomask.nc                  # Levitus_S
+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
+#
+# 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=tr33beta_00910101_01001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=tr33beta_00910101_01001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=tr33beta_00910101_01001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=tr33beta_00910101_01001231_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=sit
+VAR1_Ifrac=sic
+#
+#===================== 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
+#
+######################### 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
+#===================== 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
+#===================== 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
+#
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_vardef.sh_example2	(revision 3437)
@@ -0,0 +1,105 @@
+#!/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
+#
+PS_DIR=$( pwd )/ps
+PDF_DIR=$( pwd )/pdf
+HTML_DIR=$( pwd )/html
+SAXO_DIR=/Users/smasson/SAXO_DIR
+#
+DIR_DATA=/Users/smasson/tmp/idlorca2/res      # path of data in NetCDF format
+DIR_CLIMATO=/Users/smasson/tmp/idlorca2/clim  # path of climatological data
+DIR_MASK=/Users/smasson/tmp/idlorca2/clim     # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/smasson/data/vp33beta_mesh_mask_7.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper   ;   FILE_TEMP_3D=data_1y_potential_temperature_nomask.nc    # Levitus_T
+VAR_SAL_3D=vosaline    ;   FILE_SAL_3D=data_1y_salinity_nomask.nc                  # Levitus_S
+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
+#
+# 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=tag33_20910101_21001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE1_U=tag33_20910101_21001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE1_V=tag33_20910101_21001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE1_I=tag33_20910101_21001231_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=sit
+VAR1_Ifrac=sic
+#
+#===================== EXP2 =====================
+#
+FILE2_T=tmx_2000_00910101_01001231_1Y_grid_T.nc   # exp1 grid T input file
+FILE2_U=tmx_2000_00910101_01001231_1Y_grid_U.nc   # exp1 grid U input file
+FILE2_V=tmx_2000_00910101_01001231_1Y_grid_V.nc   # exp1 grid V input file
+FILE2_I=tmx_2000_00910101_01001231_1M_icemod.nc   # exp1 ice    input file
+VAR2_T=thetao
+VAR2_S=so
+VAR2_QNET=qns+qsr
+VAR2_ERP=wfcorr
+VAR2_EMP=wfo
+VAR2_MLD=mldr10_1
+VAR2_U=uoce_eff
+VAR2_V=voce_eff
+VAR2_Ithick=sit
+VAR2_Ifrac=sic
+#
+######################### 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
+#===================== 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
+#===================== 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
+#
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_S.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_S.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_S.pro	(revision 3437)
@@ -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 = 32., MAXIN = 37., 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_T.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_T.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_plot_zonal_T.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_AMOC.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_AMOC.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_AMOC.pro	(revision 3437)
@@ -0,0 +1,131 @@
+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'
+
+  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
+      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
+      t45 = [t45, max(msftot[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', 0., 30., date1, date2, /REMPLI, /PORTRAIT $
+        ,  small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  IF prefix NE prefix2 then begin
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+'Max Atlantic MOC between 40N and 50N'
+    pltt, t45 - t45_2, 't', -9., 9., date1, date2, /REMPLI, /NOERASE $
+          ,  COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex
+  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', 0., 20., date1, date2, /REMPLI, /PORTRAIT, window = 2 $
+        , small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  if prefix NE prefix2 then begin 
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+'Max AntArctic Bottom Water between 80S and 65S'
+    pltt, -t70 + t70_2, 't', -5., 5., date1, date2, /REMPLI, /NOERASE $
+          ,  COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex
+  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', 5., 30., date1, date2, /REMPLI, /PORTRAIT, window = 3 $
+        ,  small = [1, 2, 1],  TITLE = title, YTITLE = varunit, _extra = ex
+  if prefix NE prefix2 then begin
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+'Max AntArctic Bottom Cell between 65S and 30N'
+    pltt, -t50 + t50_2, 't', -5., 5., date1, date2, /REMPLI, /NOERASE  $
+          ,  COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _extra = ex
+  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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Drake.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Drake.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Drake.pro	(revision 3437)
@@ -0,0 +1,69 @@
+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)
+  trans = strlowcase(getenv('VAR1_U')) EQ 'uocetr_eff'
+  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 $
+        , 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)
+    trans = strlowcase(getenv('VAR2_U')) EQ 'uocetr_eff'
+    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+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, drk1 - drk2, 't', -30., 30., date1, date2, /REMPLI, /NOERASE $
+          , COLOR = 250, small = [1, 2, 2],  TITLE = title, YTITLE = varunit, _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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_EMP.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_EMP.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_EMP.pro	(revision 3437)
@@ -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', -.001, .001, date1, date2, /REMPLI $
+        , 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+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_EMP.arr - ts_EMP2.arr, 't', -.001, .001, date1, date2, /REMPLI $
+          , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_ICE.pro	(revision 3437)
@@ -0,0 +1,73 @@
+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')
+;
+  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)+')'
+;
+  iodir = std_iodir_data
+
+  domdef, 0, jpi-1, 30, 90, /xindex
+  ICE_N = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, direc = 'xy', /integration, mask2d = masknp)
+  ICE_N.arr = ICE_N.arr * 1.e-12   &   ICE_N.unit = '10^12 m^2'
+  domdef, 0, jpi-1, -90, -30, /xindex
+  ICE_S = rseries_ncdf(vICE1, date1, date2, prefix, suffix, FIRSTONLY = 1 - allrec, direc = 'xy', /integration, mask2d = masknp)
+  ICE_S.arr = ICE_S.arr * 1.e-12   &   ICE_S.unit = '10^12 m^2'
+
+  title = prefix+' '+d1_d2+'!C'+'Global Annual Mean Ice Area (North. Hemisp.)'
+  pltt, ICE_N, 't', 0., 15., date1, date2, /REMPLI, /PORTRAIT $
+        , small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  
+  title = prefix+' '+d1_d2+'!C'+'Global Annual Mean Ice Area (South. Hemisp.)'
+  pltt, ICE_S, 't', 0., 15., date1, date2, /REMPLI, /NOERASE $
+        , small = [1, 2, 2], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+  
+  htmltxt = [ htmltxt, '<hr>'+blabla, '<br><img width="80%" src='+filename+'_1.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_N2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, direc = 'xy', /integration, mask2d = masknp)
+    ICE_N2.arr = ICE_N2.arr * 1.e-12   &   ICE_N2.unit = '10^12 m^2'
+    domdef, 0, jpi-1, -90, -30, /xindex
+    ICE_S2 = rseries_ncdf(vICE2, date1_2, date2_2, prefix2, suffix2, FIRSTONLY = 1 - allrec, direc = 'xy', /integration, mask2d = masknp)
+    ICE_S2.arr = ICE_S2.arr * 1.e-12   &   ICE_S2.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 = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+'Global Annual Mean Ice Area (North. Hemisp.)'
+    pltt, ICE_N.arr - ICE_N2.arr, 't', -2., 2., date1, date2, /REMPLI, /PORTRAIT, window = 2 $
+          , COLOR = 250, small = [1, 2, 1], YTITLE = '10^12 m^2 ', TITLE = title, _extra = ex
+    
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+'Global Annual Mean Ice Area (South. Hemisp.)'
+    pltt, ICE_S.arr - ICE_S2.arr, 't', -2., 2., date1, date2, /REMPLI, /NOERASE $
+          , COLOR = 250, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Q.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Q.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_Q.pro	(revision 3437)
@@ -0,0 +1,46 @@
+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', -4, 4, date1, date2, /REMPLI $
+        , 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+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_Q.arr - ts_Q2.arr, 't', -4., 4., date1, date2, /REMPLI $
+          , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_S.pro	(revision 3437)
@@ -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', 34.54, 34.76, date1, date2, /REMPLI $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, _extra = ex
+
+  title = prefix+' '+d1_d2+' - Levitus!C'+blabla
+  pltt, ts_Sal - Lev_xyz, 't', -.05, .05, date1, date2, /REMPLI $
+        , 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', -.5, .5, INTER = .05, date1, date2, /REMPLI, style = 'so0so' $ 
+        , 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', -.5, .5, INTER = .05, date1, date2, /REMPLI, style = 'so0so' $ 
+        , 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+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_Sal - ts_Sal2, 't', -0.1, 0.1, date1, date2, /REMPLI $
+          , COLOR = 250, small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, window = 2, _extra = ex
+
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C ZT-plot (0-6000m) '+blabla
+    pltt, ts_z - ts_z2, 'zt', -0.1, 0.1, INTER = .01, date1, date2, /REMPLI, style = 'so0so' $ 
+          , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_SSH.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_SSH.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_SSH.pro	(revision 3437)
@@ -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 * 100   &   ts_SSH.unit = 'cm'
+  title = prefix+' '+d1_d2+'!C'+blabla
+  pltt, ts_SSH, 't', -.1, .1, date1, date2, /REMPLI $
+        , small = [1, 2, 1], YTITLE = 'cm', 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 * 100   &   ts_SSH2.unit = 'cm'
+    time = tsave   &   IF n_elements(time) NE jpt THEN stop
+
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_SSH.arr - ts_SSH2.arr, 't', -.1, .1, date1, date2, /REMPLI $
+          , color = 250, small = [1, 2, 2], YTITLE = 'cm', 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_T.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_T.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_T.pro	(revision 3437)
@@ -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', 1., 4.5, date1, date2, /REMPLI $
+        , small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, _extra = ex
+
+  title = prefix+' '+d1_d2+' - Levitus!C'+blabla
+  pltt, ts_Temp - Lev_xyz, 't', -1., 1., date1, date2, /REMPLI $
+        , 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', -2., 2., inter = .2, date1, date2, /REMPLI, style = 'so0so' $ 
+        , 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', -2., 2., inter = .2, date1, date2, /REMPLI, style = 'so0so' $ 
+        , 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+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C'+blabla
+    pltt, ts_Temp - ts_Temp2, 't', -1., 1., date1, date2, /REMPLI $
+          , COLOR = 250, small = [1, 2, 1], YTITLE = varunit, TITLE = title, /PORTRAIT, window = 2, _extra = ex
+
+    title = prefix+' '+d1_d2+' - '+prefix2+' '+d1_d2_2+'!C ZT-plot (0-6000m) '+blabla
+    pltt, ts_z - ts_z2, 'zt', -1., 1., inter = .1, date1, date2, /REMPLI, style = 'so0so' $ 
+          , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_all.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_all.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_all.pro	(revision 3437)
@@ -0,0 +1,70 @@
+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)
+
+  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
+
+  IF n_elements(htmltxt) GT 1 THEN putfile, psdir+'std_ts_html_body.txt', htmltxt[1:*]
+
+  return
+END
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_read.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_read.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_read.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1	(revision 3437)
@@ -0,0 +1,110 @@
+#!/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_core_tmx
+PDF_DIR=$( pwd )/pdf_core_tmx
+HTML_DIR=$( pwd )/html_core_tmx
+SAXO_DIR=/Users/smasson/SAXO_DIR
+#
+DIR_DATA=/Users/smasson/tmp/idlorca2/res      # path of data in NetCDF format
+DIR_CLIMATO=/Users/smasson/tmp/idlorca2/clim  # path of climatological data
+DIR_MASK=/Users/smasson/tmp/idlorca2/clim     # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/smasson/data/vp33beta_mesh_mask_7.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper   ;   FILE_TEMP_3D=data_1y_potential_temperature_nomask.nc    # Levitus_T
+VAR_SAL_3D=vosaline    ;   FILE_SAL_3D=data_1y_salinity_nomask.nc                  # Levitus_S
+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
+#
+# 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=10101   ;   DATE2=20001231
+#
+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=_1Y_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=_1Y_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
+#===================== 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
+#===================== 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
+#
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2	(revision 3437)
@@ -0,0 +1,110 @@
+#!/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_tag33_tag331
+SAXO_DIR=/Users/smasson/SAXO_DIR
+#
+DIR_DATA=/Users/smasson/tmp/idlorca2/res      # path of data in NetCDF format
+DIR_CLIMATO=/Users/smasson/tmp/idlorca2/clim  # path of climatological data
+DIR_MASK=/Users/smasson/tmp/idlorca2/clim     # path of mask files (ex: subbasins)
+#
+#===================== Model GRID =====================
+#
+FILE_MESH_MASK=/Users/smasson/data/vp33beta_mesh_mask_7.nc # meshmask
+FILE_MASK_SUBDOMAIN=subbasins_orca21_nored.nc              # sub-bassin masks
+#
+#===================== DATA =====================
+#
+VAR_TEMP_3D=votemper   ;   FILE_TEMP_3D=data_1y_potential_temperature_nomask.nc    # Levitus_T
+VAR_SAL_3D=vosaline    ;   FILE_SAL_3D=data_1y_salinity_nomask.nc                  # Levitus_S
+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
+#
+# 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=_1Y_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=_1Y_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
+#===================== 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
+#===================== 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
+#
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.card	(revision 3437)
@@ -0,0 +1,28 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+
+[InitialStateFiles]
+List=	()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= ()
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist_ice_lim2, namelist_ice)
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart_ice.nc, restart_icemod.nc, restart_ice_in.nc)
+
+[OutputText]
+List=   (ice_evolu)
+
+[OutputFiles]
+List=   (${PREFIX_WFI1}_icemod.nc, ${R_OUT_ICE_WFI1}/${PREFIX}_${WFI1}_icemod.nc, Post_1M_icemod)
+
+[Post_1M_icemod]
+Patches = ()
+GatherWithInternal = (nav_lon, nav_lat, time_counter)
+TimeSeriesVars = (iicethic, ileadfra, isnowthi, iicevelu, iicevelv)
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/lim2.driver	(revision 3437)
@@ -0,0 +1,56 @@
+#!/bin/ksh
+
+#-----------------------------------
+function ICE_Initialize
+{ 
+    IGCM_debug_PushStack "ICE_Initialize"
+
+    echo INITIALIZE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Initialize"
+}
+
+#-----------------------------------
+function ICE_Update
+{
+    IGCM_debug_PushStack "ICE_Update"
+
+    NbFreq=$( echo ${config_ICE_WriteFrequency} | wc -w )
+
+    ##--Write Frequency Purpose ....
+    typeset -Z1 i=1
+    while [ $i -le ${NbFreq} ]; do
+        frequency=$( echo ${config_ICE_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+        factor=$( echo ${frequency} | sed -e "s/[yYmMdD]//" )
+        case ${frequency} in
+            *Y|*y)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}y_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_Y} ;
+                eval WFI${i}=${factor}Y ;;
+            *M|*m)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}m_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_M} ;
+                eval WFI${i}=${factor}M ;;
+            *D|*d)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}d_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_D} ;
+                eval WFI${i}=${factor}D ;;
+            *)
+        esac
+        let i=$i+1
+
+    done
+    echo UPDATE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Update"
+}
+
+#-----------------------------------
+function ICE_Finalize
+{
+    IGCM_debug_PushStack "ICE_Finalize"
+
+    echo FINALIZE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Finalize"
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.card	(revision 3437)
@@ -0,0 +1,123 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+OPA_NDT_DAY=15
+#==============================================================
+#-- Name of directory for COMMON ACCOUNT at idris or CCRT
+#-- available directories are:  v3, v3_1, v3_2
+#-- related to NEMO_tag_revision (nemo_v3, nemo_v3_1, nemo_v3_2_beta)
+#-- NOTE: if you use COMMON ACCOUNT you have to de-comment it
+#OPA_version=v3_2
+#==============================================================
+
+#===================================
+#-- Use (y) or not (n) of io_server
+io_server=n
+#===================================
+
+#-- if you run interannual is "y", if not (=climatology) is "n"
+Interannual_Run=n
+
+[Interannual]
+#==================================================================================================
+#-- Surface Boundary Condition original files name ( get by the job ) same as the ones in namelist
+#==================================================================================================
+#-- NOTE: MANDATORY STRUCTURE OF FILE NAMES GET BY THE JOB : 
+#-- "basename_yyyy.nc"  	( for interannual data )
+#-- "basename.nc"	  	( for climatologycal data )
+#-- MANDATORY: NAMES USED IN List_jobsbc VARIABLE MUST BE ONLY THE BASENAME
+
+# default climatology, bulk_clio: 
+#List_jobsbc=(flx, taux_1m, tauy_1m)
+# example for interannual, bulk core, forcing CORE2:
+List_jobsbc=(u_10.15JUNE2009_orca2, v_10.15JUNE2009_orca2, ncar_rad.15JUNE2009_orca2, t_10.15JUNE2009_orca2, q_10.15JUNE2009_orca2, ncar_precip.15JUNE2009_orca2)
+# example for interannual, bulk core, forcing DRAKKAR:
+#List_jobsbc=(radlw_DFS4-ORCA2, radsw_DFS4-ORCA2, q2_DFS4-ORCA2, t2_DFS4-ORCA2, u10_DFS4-ORCA2, v10_DFS4-ORCA2, snow_DFS4-ORCA2, precip_DFS4-ORCA2)
+
+
+[InitialStateFiles]
+List=	()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/ahmcoef, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/bathy_level.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/bathy_meter.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/coordinates.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_potential_temperature_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_salinity_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/geothermal_heating.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/runoff_core_monthly.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/sss_data.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/sst_data.nc, .),\
+	    (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/subbasins.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/chlorophyll.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/K1rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/M2rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/mask_itf.nc, .)
+
+
+
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist,         namelist), \
+	(${SUBMIT_DIR}/PARAM/iodef.xml,        iodef.xml),      \
+        (${SUBMIT_DIR}/PARAM/xmlio_server.def, xmlio_server.def)
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart.nc,  restart.nc, restart.nc)
+
+[OutputText]
+List=   (ocean.output, solver.stat, STRAIT.dat, out_nemo)
+
+[OutputFiles]
+List=   (${PREFIX_WF1}_grid_T.nc,         ${R_OUT_OCE_WF1}/${PREFIX}_${WF1}_grid_T.nc,               Post_1Y_grid_T),\
+        (${PREFIX_WF2}_grid_T.nc,         ${R_OUT_OCE_WF2}/${PREFIX}_${WF2}_grid_T.nc,               Post_1M_grid_T),\
+        (${PREFIX_WF3}_grid_T.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_T.nc,               Post_1M_grid_T),\
+        (${PREFIX_WF3}_grid_U.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_U.nc,               Post_1M_grid_U) ,\
+        (${PREFIX_WF3}_grid_V.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_V.nc,               Post_1M_grid_V),\
+        (${PREFIX_WF3}_grid_W.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_W.nc,               Post_1M_grid_W),\
+        (${PREFIX_WF4}_grid_T_0n180w.nc,  ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_grid_T_0n180w.nc,        NONE ),\
+        (${PREFIX_WF4}_grid_T_Eq.nc,      ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_grid_T_Eq.nc,            NONE ),\
+        (${PREFIX_WF4}_diaptr.nc,         ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_diaptr.nc,               Post_1D_diaptr),\
+        (mesh_mask.nc     ,               ${R_OUT_OCE_O}/${config_UserChoices_JobName}_mesh_mask.nc, NONE),\
+        (output.abort.nc  ,               ${R_OUT_OCE_D}/${PREFIX}_output.abort.nc,                  NONE),\
+        (output.init.nc   ,               ${R_OUT_OCE_O_I}/${config_UserChoices_JobName}_${PeriodDateBegin}_output.init.nc, NONE)
+
+
+[Post_1Y_grid_T]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, deptht, time_counter)
+TimeSeriesVars = (sohtc300, sohefldo, soicecov, somxl010, sosaline, sossheig, sosstsst, sowaflcd, sowaflup)
+
+[Post_1M_grid_T]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, deptht, time_counter)
+TimeSeriesVars = (sohtc300, sohefldo, soicecov, somxl010, sosaline, sossheig, sosstsst, sowaflcd, sowaflup)
+
+[Post_1M_grid_U]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthu, time_counter)
+TimeSeriesVars = (sozotaux)
+
+[Post_1M_grid_V]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthv, time_counter)
+TimeSeriesVars = (sometauy)
+
+[Post_1M_grid_W]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthw, time_counter)
+TimeSeriesVars =
+
+[Post_1D_diaptr]
+Patches = ()
+GatherWithInternal = (lat, deptht, depthw, time_counter)
+TimeSeriesVars = (zotemglo, zosalglo, zomsfglo, zotematl, zosalatl, zomsfatl, zotempac, zosalpac, zomsfpac, zotemind, zosalind, zomsfind, zotemipc, zosalipc, zomsfipc, sohtatl, sostatl, sohtpac, sostpac, sohtind, sostind, sohtipc, sostipc, sophtadv, sophtove, sophtldf, sopstadv, sopstove, zomsfeiv, sophteiv, sopsteiv)
+
+[Post_time]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal =
+TimeSeriesVars =
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/COMP/opa9.driver	(revision 3437)
@@ -0,0 +1,288 @@
+#!/bin/ksh
+#-----------------------------------------------------------------
+function OCE_Initialize
+{
+    IGCM_debug_PushStack "OCE_Initialize"
+
+    JOB_NAME=${config_UserChoices_JobName}
+
+    OPA_NDT_DAY=${opa_UserChoices_OPA_NDT_DAY:=15}
+
+
+    ##--Variables used by OPA --
+
+    # cn_exp experience name for vairmer format
+    # nn_it000 number of the first time step
+    # nn_itend number of the last time step
+    # nn_leapy leap year calendar (0/1) (30 for 360d)
+    # nn_write frequency of OUTPUT file
+    # ln_rstart boolean term for restart (true or false)
+    # nn_stock frequency of restart file
+    # nn_rstctl control of the time step (0, 1 or 2)
+    # nn_date0 initial calendar date aammjj
+    # nn_msh  =1 create a mesh file (coordinates, scale factors, masks)
+    # rn_rdt time step in seconds (coming from namelist)
+    # nf_ptr_wri frequency of zonal means and transport output
+
+
+# Local function to find namelists parameters
+supergrep () {
+    grep "^ *$1 *=" $2 | sed -e "s% *\!.*%%"
+}
+
+
+    PAT_CEXPER=$( supergrep cn_exp    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NIT000=$( supergrep nn_it000    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NITEND=$( supergrep nn_itend    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NLEAPY=$( supergrep nn_leapy    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_RESTAR=$( supergrep ln_rstart ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NSTOCK=$( supergrep nn_stock    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NRSTAR=$( supergrep nn_rstctl    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NDATE0=$( supergrep nn_date0    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NMSH=$(   supergrep nn_msh      ${SUBMIT_DIR}/PARAM/namelist ) 
+    
+
+    OPA_RDT=$( supergrep rn_rdt  ${SUBMIT_DIR}/PARAM/namelist | sed 's/ *rn_rdt *=//' | sed 's/\. *,//' )
+
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # /!\ Needed by OPA namelist to compute file names /!\
+    (( DaysSinceJC = $( IGCM_date_DaysSinceJC ${DateBegin} ) + 1 ))
+
+    # Definition from opa9.card of List_jobsbc and List_runsbc used to do to interannual and climatological runs 
+	IGCM_card_DefineArrayFromOption ${SUBMIT_DIR}/COMP/opa9.card Interannual List_jobsbc
+        set -A ListFormulationJobsbc -- \${opa9_Interannual_Listjobsc${opa9_Interannual_List_jobsbc}[*]}
+
+    ##--Variables used for XMLIO_SERVER configuration file
+	    # using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+	    PAT_SERVER=$( supergrep using_server ${SUBMIT_DIR}/PARAM/xmlio_server.def )
+	
+    IGCM_debug_PopStack "OCE_Initialize"
+}
+
+#-----------------------------------------------------------------
+function OCE_Update
+{
+    IGCM_debug_PushStack "OCE_Update"
+
+    # Interannual run
+    # In this case job need to calculate previous and following year and give, and if every run needs to add "_y" before every year 
+    if [ X${opa9_UserChoices_Interannual_Run} = Xy ] ; then
+
+	typeset file 
+
+ 	(( PeriodCumulPeriod =  ${CumulPeriod} - 1 )) 
+ 	(( PeriodInitYear =${InitYear} + ${PeriodCumulPeriod} * ${PeriodLengthInYears} ))
+ 	(( PeriodFinalYear =${InitYear} + ${PeriodLengthInYears}*${CumulPeriod} - 1 ))
+
+        NbFileInter=${#opa9_Interannual_List_jobsbc[*]}
+        (( NbFileInter_tot=${#opa9_Interannual_List_jobsbc[*]} * ${PeriodLengthInYears} ))
+	(( i = 0 ))
+
+	while [ ${year} -le ${PeriodFinalYear} ] ; do #copy in ONCE of ALL necessary files for all PeriodLength
+	    
+	    while [ $i -lt ${NbFileInter} ] ; do
+		
+		eval file=${opa9_Interannual_List_jobsbc[$i]}
+		if [ X${year} = X${PeriodInitYear} ] ; then  
+                        	if [ ${month} -eq 01 ] ; then
+		    			# if year-1 does not exist we create a file _noym1.nc copy of year
+		    			eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year - 1 )).nc
+		    			if  [ ! -f ${jobsbc_file_ym1} ] ; then
+		    				eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		    				eval runsbc_file_ym1=${file}_noym1.nc
+		    			else
+		    			    eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year - 1 )).nc
+		    			    eval runsbc_file_ym1=${file}_y$(( year - 1 )).nc
+		    			fi
+
+                            IGCM_sys_Get ${jobsbc_file_ym1} ${runsbc_file_ym1}
+                        	fi
+		fi
+		
+       		# download year 
+		eval jobsbc_file_y=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		eval runsbc_file_y=${file}_y${year}.nc
+		
+		if [ ! -f ${runsbc_file_y} ] ; then
+		    IGCM_sys_Get ${jobsbc_file_y} ${runsbc_file_y}
+		fi
+		
+		# download (year+1) if it is last year of run
+		if [ X${year} = X${PeriodFinalYear} ] ; then 	
+	
+		    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+		    eval runsbc_file_yp1=${file}_y$(( year + 1 )).nc
+		    
+		    if  [ ! -f ${runsbc_file_yp1} ] ; then
+			
+		        # if year+1 does not exist we create a file _noyp1.nc copy of year
+		    	eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+			if  [ ! -f ${jobsbc_file_yp1} ] ; then
+			    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		    	    eval runsbc_file_yp1=${file}_noyp1.nc
+			else
+			    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+			    eval runsbc_file_yp1=${file}_y$(( year + 1 )).nc
+			fi
+			IGCM_sys_Get ${jobsbc_file_yp1} ${runsbc_file_yp1}
+		    fi
+		    
+		fi
+		(( i = i + 1 ))
+	
+	    done
+	
+	    (( year = year + 1 ))
+	 
+	    (( i = 0 ))
+	done
+
+    # End interannual
+    elif [ X${opa9_UserChoices_Interannual_Run} = Xn ] ; then
+    # Climatological run
+       typeset file 
+
+       eval NbFileInter=${#opa9_Interannual_List_jobsbc[*]}
+
+        (( i = 0 ))
+        while [ $i -lt ${NbFileInter} ] ; do
+            eval file=${opa9_Interannual_List_jobsbc[$i]}
+            eval jobsbc_file=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}.nc
+            eval runsbc_file=${file}.nc
+
+            IGCM_sys_Get ${jobsbc_file} ${runsbc_file}
+            (( i = i + 1 ))
+	done
+    fi
+    # End climatological
+
+    NbFreq=$( echo ${config_OCE_WriteFrequency} | wc -w )
+
+    ##--Write Frequency Purpose ....
+    typeset -Z1 i=1
+    while [ $i -le ${NbFreq} ]; do
+        frequency=$( echo ${config_OCE_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+    	factor=$( echo ${frequency} | sed -e "s/[yYmMdD]//" )
+    	case ${frequency} in
+    	    *Y|*y)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}y_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_Y} ;
+    	        eval WF${i}=${factor}Y ;;
+    	    *M|*m)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}m_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_M} ;
+    	        eval WF${i}=${factor}M ;;
+    	    *D|*d)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}d_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_D} ;
+    	        eval WF${i}=${factor}D ;;
+    	    *)
+    	esac
+        let i=$i+1
+
+    done
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # Needed by OPA namelist to compute correct file names 
+    (( PeriodDaysSinceJC =  $( IGCM_date_DaysSinceJC ${PeriodDateBegin} ) + 1  ))
+
+    ## Count of number of time steps from begin of OPA job
+    (( OPA_NIT000 = ( PeriodDaysSinceJC - DaysSinceJC ) * OPA_NDT_DAY + 1 ))
+    (( OPA_NDT   = PeriodLengthInDays * OPA_NDT_DAY ))
+    (( OPA_NITEND = OPA_NIT000 + OPA_NDT - 1))
+
+    ## Forcing to write one restart file at the end of period
+    OPA_NSTOCK="${OPA_NITEND}"
+
+    ## Verification of number of time steps per day
+    (( NB_SEC_DAY_MODEL = OPA_NDT_DAY * OPA_RDT ))
+    (( NB_SEC_DAY = 60 * 60 * 24 ))
+
+    if [ ${NB_SEC_DAY_MODEL} -ne ${NB_SEC_DAY} ]
+	then
+        echo " VERIFY OPA_NDT_DAY in opa9.card "
+        exit
+    fi
+
+    ##-- Restart configuration
+    if ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_OCE_Restart}" = "n" ] ) ; then
+
+        #echo "NO OPA RESTART"
+	OPA_LRSTAR=.FALSE.
+	OPA_NRSTDT=0
+        #Put OPA_NMSH=0 when OPA runnig in parallel mode 
+	OPA_NMSH=1
+	( [ X${BATCH_NUM_PROC_TOT} != X ] && [ "${BATCH_NUM_PROC_TOT}" -gt 1 ] ) && OPA_NMSH=0
+
+    elif ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_OCE_Restart}" = "y" ] ) ; then
+
+        #echo "OPA RESTART"
+	OPA_LRSTAR=.TRUE.
+	OPA_NRSTDT=1
+	OPA_NMSH=0
+
+    else
+
+        #echo "OPA RESTART"
+	OPA_LRSTAR=.TRUE.
+	OPA_NRSTDT=2
+	OPA_NMSH=0
+
+    fi
+   
+     ## nleapy configuration
+	case ${config_UserChoices_CalendarType} in
+        	leap)
+            	OPA_NLEAPY=1;;
+        	noleap)
+            	OPA_NLEAPY=0;;
+        	360d)
+            	OPA_NLEAPY=30;;
+    	esac
+
+
+        typeset -r PRECIS=8
+	NEMO_END=$( echo $( awk "BEGIN { printf \"%0${PRECIS}d\",${OPA_NITEND} }" ) ) 
+
+    sed -e "s%${PAT_CEXPER}%       cn_exp=\"${config_UserChoices_JobName}\"%"  \
+	-e "s%${PAT_NIT000}%       nn_it000=${OPA_NIT000}%"                    \
+	-e "s%${PAT_NITEND}%       nn_itend=${OPA_NITEND}%"                    \
+	-e "s%${PAT_RESTAR}%       ln_rstart=${OPA_LRSTAR}%"                   \
+	-e "s%${PAT_NSTOCK}%       nn_stock=${OPA_NSTOCK}%"                    \
+	-e "s%${PAT_NRSTAR}%       nn_rstctl=${OPA_NRSTDT}%"                   \
+	-e "s%${PAT_NDATE0}%       nn_date0=${PeriodDateBegin}%"               \
+	-e "s%${PAT_NMSH}%         nn_msh=${OPA_NMSH}%"                        \
+	-e "s%${PAT_NLEAPY}%       nn_leapy=${OPA_NLEAPY}%"	               \
+	namelist > namelist.tmp
+
+    IGCM_sys_Mv namelist.tmp namelist
+
+
+    # update xmlio_server.def
+
+    if [ X${opa9_UserChoices_io_server} = Xy ] ; then
+        sed -e "s/${PAT_SERVER}/  using_server = .TRUE./" \
+        xmlio_server.def > xmlio_server.def.tmp
+        IGCM_sys_Mv xmlio_server.def.tmp xmlio_server.def
+    fi
+	
+    IGCM_debug_PopStack "OCE_Update"
+}
+
+#-----------------------------------
+function OCE_Finalize
+{
+    IGCM_debug_PushStack "OCE_Finalize"
+
+    if [ -f date.file ] ; then
+        # Prefix use in opa.card AND in lim2.card :
+	DATE_OPA=$( cat date.file | \
+	    sed "s/\ ${config_UserChoices_JobName}_[0-9]*[a-z]_\([0-9]*_[0-9]*\)_\ */\1/g" )
+        ###DATE_OPA=$( $DATE_OPABF | cut -c1-30 )
+	MainPrefix=${config_UserChoices_JobName}_1d_${DATE_OPA}
+	SecondPrefix=${config_UserChoices_JobName}_5d_${DATE_OPA}
+    fi
+
+    echo FINALIZE OCE !!!
+
+    IGCM_debug_PopStack "OCE_Finalize"
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/config.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/config.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/IGCM00/config.card	(revision 3437)
@@ -0,0 +1,115 @@
+#
+# This is config.card file for NEMO ORCA2_LIM2 configuration
+#
+#========================================================================
+#D-- Compatibility -
+[Compatibility]
+libIGCM=1.0
+#D-- UserChoices -
+[UserChoices]
+#============================
+#-- (<8 chars MAX for JobName)
+JobName=ORCA2
+LongName="SCRIPT_V1"
+TagName=ORCA2_LIM2
+#============================
+#-- leap, noleap, 360d
+CalendarType=noleap
+#-- Begin and end of Job
+#-- "YYYY-MM-DD"
+DateBegin=2001-01-01
+DateEnd=2005-12-31
+#============================
+#-- 1Y, 1M, 5D, 1D
+PeriodLength=1Y
+#============================
+#-- PBS Class (required on brodie mono/multi)
+JobClass=mono
+#JobClass=multi
+#============================
+#-- Total Number of Processors
+#JobNumProcTot=4
+JobNumProcTot=1
+#============================
+#-- Run Options : 
+#JobRunOptions='"-np "${BATCH_NUM_PROC_TOT}"'
+JobRunOptions=''
+#============================
+# config.card configuration options :
+#R_INIT=/home/mancip/PROG/IPSL/FORCAGE_OL/INIT
+#R_BC=/u/rech/psl/rpsl035/IGCM/BC 
+#R_BC=/dmnfs/cont003/p86ipsl/IGCM/BC 
+#============================
+
+#========================================================================
+#D-- ListOfComponents -
+[ListOfComponents]
+#D- For each component, Name of component, Tag of component
+OCE= (opa9, NEMO_v3)
+ICE= (lim2, LIM_2)
+
+#========================================================================
+#D-- Executable -
+[Executable]
+Name=nemo
+#D- For each component, Real name of executable
+OCE= (nemo.exe, nemo)
+ICE= ("", "")
+
+#========================================================================
+#D-- Restarts -
+[Restarts]
+#D- If you want a GENERAL RULE FOR RESTARTS, put this flag to 'y'
+OverRule=n
+#D- Last day of the experience used as restart
+RestartDate=1999-12-30
+#D- Define restart simulation name
+RestartJobName=NL1
+#D- Path Server Group Login
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM
+
+#========================================================================
+#D-- Post -
+[Post]
+#D- Do we rebuild parallel output, this flag determines
+#D- frequency of rebuild submission
+#-- 1Y
+RebuildFrequency=NONE
+#D- Do we rebuild parallel output from archive
+RebuildFromArchive=true
+#D- If you want to produce time series, this flag determines
+#D- frequency of post-processing submission
+TimeSeriesFrequency=NONE
+#D- If you want to produce seasonal average, this flag determines
+#D- the period of this average
+SeasonalFrequency=NONE
+
+#========================================================================
+#D-- OCE -
+[OCE]
+WriteFrequency="1Y 1M 5D 1D"
+#WriteFrequency="5D"
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=1999-12-31
+# Define restart simulation name
+RestartJobName=NL1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM
+# Old component name for restart (if empty, use new name)
+OldName=
+
+#========================================================================
+#D-- ICE -
+[ICE]
+WriteFrequency="5D"
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=1999-12-31
+# Define restart simulation name
+RestartJobName=NL1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM
+# Old component name for restart (if empty, use new name)
+OldName=
+
+#========================================================================
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+ bld::tool::fppkeys key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job	(revision 3437)
@@ -0,0 +1,173 @@
+#-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 5Gb                    # 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= 10800
+#-Q- aix #@stack_limit= 200Mb        
+#-Q- aix #@data_limit= 5Gb         
+#-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=5gb      # Max memory
+#-Q- sx8brodie #PBS -l cputim_prc=3:01:00   # Max CPU time/prc
+#-Q- sx8brodie #PBS -l cputim_job=3: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=7gb      # Max memory
+#-Q- sx8mercure #PBS -l cputim_job=2:00: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_LIM_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 ] || ( rcp ${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_ice_lim2   namelist_ice 
+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 and ocean dynamics
+Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar
+Rapatrie ${R_TMP} INPUTS_INIT_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 *_grid_*.nc *_diad_T*.nc *_ptrc_T*.nc
+do
+$DPUT ${file_netcdf} ${R_SORTIE_OCE}/${file_netcdf}
+done
+#
+#- Save ice output files
+for file_netcdf in *icemod*
+do
+$DPUT ${file_netcdf} ${R_SORTIE_OCE}/${file_netcdf} 
+done
+$DPUT ice.evolu ${R_SORTIE_OCE}/ice.evolu 
+#
+#- 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/EMPave_old.dat
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/EMPave_old.dat	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/EMPave_old.dat	(revision 3437)
@@ -0,0 +1,1 @@
+                               0  0.0000000000000000E+00  0.0000000000000000E+00
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,748 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+	
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"     description="Effective ocean transport along i-axis"    unit="m3/s"                 />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"     description="Effective ocean tra,sport along j-axis"    unit="m3/s"                 />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"     description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+
+      <!-- variables available with key_float -->
+      <group id="floatvar" axis_ref="nfloat" grid_ref="scalarpoint" zoom_ref="1point">
+        <field id="traj_lon"   description="floats longitude"   unit="deg"  operation="inst(X)" />
+        <field id="traj_lat"   description="floats latitude"    unit="deg"   />
+        <field id="traj_dep"   description="floats depth"       unit="m"     />
+        <field id="traj_temp"  description="floats temperature" unit="degC"  />
+        <field id="traj_salt"  description="floats salinity"    unit="psu"   />
+        <field id="traj_dens"  description="floats density"     unit="kg/m3" />
+        <field id="traj_group" description="floats group"       unit="none"  />
+      </group>
+     
+      <!-- ptrc on T grid -->
+
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="Alkalini" description="Total Alkalinity Concentration"           unit="mmol/m3"    />
+       <field id="O2"       description="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="Si"       description="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="mmol/m3" />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="mmol/m3" />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="DSi"      description="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="GSi"      description="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="mg/m3" />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="mg/m3" />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="mmol/m3" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="mmol/m3" />
+     </group>
+
+      <!-- diad on T grid : variables available with key_diatrc -->
+
+     <group id="diad_T" axis_ref="none" grid_ref="grid_T">
+       <field id="PH"          description="PH"                                       unit="-"          axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/m3"     axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/m3"     axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"       axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="Mumax"       description="Maximum growth rate"                      unit="s-1"        axis_ref="deptht" />
+       <field id="MuN"         description="Realized growth rate for nanophyto"       unit="s-1"        axis_ref="deptht" />
+       <field id="MuD"         description="Realized growth rate for diatomes"        unit="s-1"        axis_ref="deptht" />
+       <field id="MuNlight"    description="Light limited growth rate for nanophyto"  unit="s-1"        axis_ref="deptht" />
+       <field id="MuDlight"    description="Light limited growth rate for diatomes"   unit="s-1"        axis_ref="deptht" />
+       <field id="LNnut"       description="Nutrient limitation term in Nanophyto"    unit="-"          axis_ref="deptht" />
+       <field id="LDnut"       description="Nutrient limitation term in Diatoms"      unit="-"          axis_ref="deptht" />
+       <field id="LNFe"        description="Iron limitation term in Nanophyto"        unit="-"          axis_ref="deptht" />
+       <field id="LDFe"        description="Iron limitation term in Diatoms"          unit="-"          axis_ref="deptht" />
+       <field id="LNlight"     description="Light limitation term in Nanophyto"       unit="-"          axis_ref="deptht" />
+       <field id="LDlight"     description="Light limitation term in Diatoms"         unit="-"          axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="mol/m2/s"                     />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="mol/m2/s"                     />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="mol/m2/s"                     />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="mol/m2/s"                     />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="mol/m2/s"                     />
+       <field id="Cflx"        description="DIC flux"                                 unit="mol/m2/s"                     />
+       <field id="Oflx"        description="Oxygen flux"                              unit="mol/m2/s"                     />
+       <field id="Kg"          description="Gas transfer"                             unit="mol/m2/s/uatm"                />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"                         />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"                         />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"                            />
+       <field id="Irondep"     description="Iron deposition"                          unit="mol/m2/s"                     />
+     </group>
+       
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+
+    <!-- 
+............................................................................................................
+           example of 3 types of 1d files
+............................................................................................................
+    -->
+        <!-- automatic definition of the name based on id="1d_grid_T" 
+             => this name is used as the radical for all file names of this group
+             => add a suffix to be sure that all files names of this group are different   -->
+        <group id="1d_grid_T" name="auto" description="ocean T grid variables" >
+          <!-- mooring: automatic definition of the file name suffix based on id="0n180wT"  -->
+          <file id="0n180wT" name_suffix="auto" >
+            <group id="0n180wT" zoom_ref="0n180wT" >    <!-- group of variables sharing the same zoom -->
+              <field ref="toce" name="votemper"  />
+              <field ref="uoce" name="vozocrtx"  />     <!-- include a U-grid variable in the list => switch to T-grid -->
+            </group>
+          </file>
+          <!-- Equatorial section: automatic definition of the file name suffix based on id="EqT" -->
+          <file id="EqT" name_suffix="auto" >
+            <group id="EqT" zoom_ref="EqT" >
+              <field ref="toce" name="votemper"  />
+            </group>
+          </file>
+          <!-- global file with different operations on data   -->
+          <file id="global" >
+            <field ref="sst"    name="sst_1d_ave"                       />     <!-- mean -->
+            <field ref="sst"    name="sst_1d_max"  operation="t_max(X)" />     <!-- max -->
+          </file>
+        </group>
+
+      </group>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+	<file id="5d_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="toce"         name="votemper"  />
+	  <field ref="soce"         name="vosaline"  />
+	  <field ref="sst"          name="sosstsst"  />
+	  <field ref="sss"          name="sosaline"  />
+	  <field ref="ssh"          name="sossheig"  />
+	  <field ref="empmr"        name="sowaflup"  />
+	  <field ref="qsr"          name="soshfldo"  />
+	  <field ref="empsmr"       name="sowaflcd"  />
+	  <field ref="qt"           name="sohefldo"  />
+	  <field ref="mldr10_1"     name="somxl010"  />
+	  <field ref="mldkz5"       name="somixhgt"  />
+	  <field ref="ice_cover"    name="soicecov"  />
+	  <field ref="wspd"         name="sowindsp"  />
+	  <field ref="qrp"          name="sohefldp"  />
+	  <field ref="erp"          name="sowafldp"  />
+	  <field ref="mlddzt"       name="sothedep"  />
+	  <field ref="20d"          name="so20chgt"  />
+	  <field ref="28d"          name="so28chgt"  />
+	  <field ref="hc300"        name="sohtc300"  />
+	  <field ref="ist_ipa"      name="soicetem"  />
+	  <field ref="icealb_cea"   name="soicealb"  />   
+	</file>
+	
+	<file id="5d_grid_U" name="auto" description="ocean U grid variables" >
+	  <field ref="uoce"         name="vozocrtx"  />
+	  <field ref="uoce_eiv"     name="vozoeivu"  />
+	  <field ref="utau"         name="sozotaux"  />
+	</file>
+	
+	<file id="5d_grid_V" name="auto" description="ocean V grid variables" >
+	  <field ref="voce"         name="vomecrty"  />
+	  <field ref="voce_eiv"     name="vomeeivv"  />
+	  <field ref="vtau"         name="sometauy"  />
+	</file>
+	
+	<file id="5d_grid_W" name="auto" description="ocean W grid variables" >
+	  <field ref="woce"         name="vovecrtz" />
+	  <field ref="woce_eiv"     name="voveeivw" />
+	  <field ref="avt"          name="votkeavt" />
+	  <field ref="avt_evd"      name="votkeevd" />
+	  <field ref="avm"          name="votkeavm" />
+	  <field ref="avm_evd"      name="votkeevm" />
+	  <field ref="avs"          name="voddmavs" />
+	  <field ref="aht2d"        name="soleahtw" />
+	  <field ref="aht2d_eiv"    name="soleaeiw" />
+	</file>
+
+
+	<file id="5d_icemod" name="auto" description="ice variables" >
+	  <field ref="ice_pres"                     />
+	  <field ref="snowthic_cea" name="isnowthi" />
+	  <field ref="icethic_cea"  name="iicethic" />
+	  <field ref="iceprod_cea"  name="iiceprod" />
+	  <field ref="ist_ipa"      name="iicetemp" />
+	  <field ref="ioceflxb"     name="ioceflxb" />
+	  <field ref="uice_ipa"     name="iicevelu" />
+	  <field ref="vice_ipa"     name="iicevelv" />
+	  <field ref="utau_ice"     name="iicestru" />
+	  <field ref="vtau_ice"     name="iicestrv" />
+	  <field ref="qsr_io_cea"   name="iicesflx" />
+	  <field ref="qns_io_cea"   name="iicenflx" />
+	  <field ref="snowpre"      name="isnowpre" />
+	</file>
+
+        <!-- variables available with key_float, instantaneous fields -->
+        <file id="floats"  description="floats variables">
+            <field ref="traj_lon"   name="floats_longitude"   freq_op="432000" />
+            <field ref="traj_lat"   name="floats_latitude"    freq_op="432000" />
+            <field ref="traj_dep"   name="floats_depth"       freq_op="432000" />
+            <field ref="traj_temp"  name="floats_temperature" freq_op="432000" />
+            <field ref="traj_salt"  name="floats_salinity"    freq_op="432000" />
+            <field ref="traj_dens"  name="floats_density"     freq_op="432000" />
+            <field ref="traj_group" name="floats_group"       freq_op="432000" />
+        </file>
+
+       <file id="5d_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+       </file>
+
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+	<file id="1m_grid_T" name="auto" description="ocean T grid variables" >
+	  <field ref="sst"          name="sosstsst"  />
+	</file>   
+
+        <file id="1m_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="DOC"      />
+          <field ref="Fer"      />
+          <field ref="NO3"      />
+       </file>
+	
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+
+        <file id="1y_grid_T" name="auto" description="ocean T grid variables" >
+          <field ref="mldr10_1"     name="sobowlin"  operation="t_max(X)" />
+        </file>
+
+        <file id="1y_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="CaCO3"    />
+          <field ref="PO4"      />
+          <field ref="POC"      />
+          <field ref="Si"       />
+          <field ref="PHY"      />
+          <field ref="ZOO"      />
+          <field ref="DOC"      />
+          <field ref="PHY2"     />
+          <field ref="ZOO2"     />
+          <field ref="DSi"      />
+          <field ref="Fer"      />
+          <field ref="BFe"      />
+          <field ref="GOC"      />
+          <field ref="SFe"      />
+          <field ref="DFe"      />
+          <field ref="GSi"      />
+          <field ref="NFe"      />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="NO3"      />
+          <field ref="NH4"      />
+       </file>
+
+       <file id="1y_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="PH"       />
+          <field ref="CO3"      />
+          <field ref="CO3sat"   />
+          <field ref="PAR"      />
+          <field ref="PPPHY"    />
+          <field ref="PPPHY2"   />
+          <field ref="PPNEWN"   />
+          <field ref="PPNEWD"   />
+          <field ref="PBSi"     />
+          <field ref="PFeN"     />
+          <field ref="PFeD"     />
+          <field ref="PCAL"     />
+          <field ref="DCAL"     />
+          <field ref="GRAZ"     />
+          <field ref="Mumax"    />
+          <field ref="MuN"      />
+          <field ref="MuD"      />
+          <field ref="MuNlight" />
+          <field ref="MuDlight" />
+          <field ref="LNnut"    />
+          <field ref="LDnut"    />
+          <field ref="LNFe"     />
+          <field ref="LDFe"     />
+          <field ref="LNlight"  />
+          <field ref="LDlight"  />
+          <field ref="EPC100"   />
+          <field ref="EPFE100"  />
+          <field ref="EPSI100"  />
+          <field ref="EPCAL100" />
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Kg"       />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+          <field ref="Irondep"  />
+          <field ref="Nfix"     />
+       </file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="nfloat" description="Number of float"   unit="no unit" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+        <zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+        <zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+        <zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+        <zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+        <zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+        <zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+        <zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+        <zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+        <zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+        <zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+        <zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+        <zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+        <zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+        <zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+        <zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+        <zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+        <zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+        <zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+        <zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+        <zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+        <zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+        <zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+        <zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+        <zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+        <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+
+    </grid_definition>    
+    
+  </context>
+  
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../ORCA2_LIM/EXP00/namelist
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../ORCA2_LIM/EXP00/namelist_ice_lim2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim2	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../ORCA2_LIM/EXP00/namelist_ice_lim2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_ice_lim3	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../ORCA2_LIM/EXP00/namelist_ice_lim3
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_pisces	(revision 3437)
@@ -0,0 +1,230 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :    1  - air-sea exchange                         (nampisext)
+!! namelists    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)
+!!              9  - parameters for Kriest parameterization   (nampiskrp, nampiskrs)
+!!              10 - additional 2D/3D  diagnostics            (nampisdia)
+!!              11 - Damping                                  (nampisdmp)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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 !
+!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   cn_dir      = './'     !  root directory for the location of the dynamical files
+!
+   ln_presatm  = .true.   ! constant atmopsheric pressure (F) or from a file (T)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nrdttrc    =  4        ! 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     =  30.      ! Big particles sinking speed
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   conc0      =  1.e-6    ! Phosphate half saturation
+   conc1      =  8E-6     ! Phosphate half saturation for diatoms
+   conc2      =  1E-9     ! Iron half saturation for phyto
+   conc2m     =  3E-9     ! Max iron half saturation for phyto
+   conc3      =  3E-9     ! Iron half saturation for diatoms
+   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms
+   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms
+   xsizephy   =  1.E-6    ! Minimum size criteria for phyto
+   concnnh4   =  1.E-7    ! NH4 half saturation for phyto
+   concdnh4   =  8.E-7    ! NH4 half saturation for diatoms
+   xksi1      =  2.E-6    ! half saturation constant for Si uptake
+   xksi2      =  3.33E-6  ! half saturation constant for Si/C
+   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
+   concfebac  =  1.E-11   ! Half-saturation for Fe limitation of Bacteria
+   qnfelim    =  7.E-6    ! Optimal quota of phyto
+   qdfelim    =  7.E-6    ! Optimal quota of diatoms
+   caco3r     =  0.16     ! mean rain ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   pislope    =  2.       ! P-I slope
+   pislope2   =  2.       ! P-I slope  for diatoms
+   excret     =  0.05     ! excretion ratio of phytoplankton
+   excret2    =  0.05     ! excretion ratio of diatoms
+   ln_newprod =  .true.  ! Enable new parame. of production (T/F) 
+   bresp      =  0.00333  ! Basal respiration rate
+   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton
+   chlcdm     =  0.05     ! Minimum Chl/C in diatoms
+   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton
+   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton
+   fecdm      =  40E-6    ! Minimum Fe/C in diatoms
+   grosip     =  0.151    ! mean Si/C ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   wchl       =  0.001    ! quadratic mortality of phytoplankton
+   wchld      =  0.02     ! maximum quadratic mortality of diatoms
+   mprat      =  0.01     ! phytoplankton mortality rate
+   mprat2     =  0.01     ! Diatoms mortality rate
+   mpratm     =  0.01     ! Phytoplankton minimum mortality rate
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts
+   grazrat2   =  0.7      ! maximal mesozoo grazing rate
+   resrat2    =  0.005    ! exsudation rate of mesozooplankton
+   mzrat2     =  0.03     ! mesozooplankton mortality rate
+   xprefc     =  1.       ! zoo preference for phyto
+   xprefp     =  0.3      ! zoo preference for POC
+   xprefz     =  1.       ! zoo preference for zoo
+   xprefpoc   =  0.3      ! zoo preference for poc
+   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   =  2E-7    ! Food threshold for grazing
+   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing
+   epsher2    =  0.3      ! 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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa
+   grazrat    =  3.0      ! maximal zoo grazing rate
+   resrat     =  0.03     ! exsudation rate of zooplankton
+   mzrat      =  0.001    ! 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    =  2.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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xremik    =  0.25      ! remineralization rate of DOC
+   xremip    =  0.025     ! remineralisation rate of POC
+   nitrif    =  0.05      ! NH4 nitrification rate
+   xsirem    =  0.003     ! remineralization rate of Si
+   xsiremlab =  0.025     ! fast remineralization rate of Si
+   xsilab    =  0.31      ! Fraction of labile biogenic silica
+   xlam1     =  0.005     ! scavenging rate of Iron
+   oxymin    =  1.E-6     ! Half-saturation constant for anoxia
+   ligand    =  0.6E-9    ! Ligands concentration
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   kdca       =  6.       ! calcite dissolution rate constant (1/time)
+   nca        =  1.       ! order of dissolution reaction (dimensionless)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissed     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .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_river    =  .false.   ! boolean for river input of nutrients
+   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N
+   ln_ironsed  =  .true.   ! boolean for Fe input from sediments
+   sedfeinput  =  1E-9     ! Coastal release of Iron
+   dustsolub   =  0.02     ! Solubility of the dust
+   wdust       =  2.0      ! Dust sinking speed
+   nitrfix     =  1E-7     ! Nitrogen fixation rate
+   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2)
+   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrp     !   Kriest parameterization : parameters     "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_eta      = 1.17    ! Sinking  exponent
+   xkr_zeta     = 2.28    ! N content exponent
+   xkr_mass_min = 0.0002  ! Minimum mass for Aggregates
+   xkr_mass_max = 1.      ! Maximum mass for Aggregates
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrs     !   Kriest parameterization : size classes  "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_sfact    = 942.    ! Sinking factor
+   xkr_stick    = 0.5     ! Stickiness
+   xkr_nnano    = 2.337   ! Nbr of cell in nano size class
+   xkr_ndiat    = 3.718   ! Nbr of cell in diatoms size class
+   xkr_nmeso    = 7.147   ! Nbr of cell in mesozoo size class
+   xkr_naggr    = 9.877   ! Nbr of cell in aggregates  size class
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdia     !   additional 2D/3D tracers diagnostics 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !    name   !           title of the field          !     units      !
+!              !           !                                       !                !  
+   pisdia2d(1)  = 'Cflx     ' , 'DIC flux                          ',  'molC/m2/s    '
+   pisdia2d(2)  = 'Oflx     ' , 'Oxygen flux                       ',  'molC/m2/s    '
+   pisdia2d(3)  = 'Kg       ' , 'Gas transfer                      ',  'mol/m2/s/uatm'
+   pisdia2d(4)  = 'Delc     ' , 'Delta CO2                         ',  'uatm         '
+   pisdia2d(5)  = 'PMO      ' , 'POC export                        ',  'molC/m2/s    '
+   pisdia2d(6)  = 'PMO2     ' , 'GOC export                        ',  'molC/m2/s    '
+   pisdia2d(7)  = 'ExpFe1   ' , 'Nano iron export                  ',  'molFe/m2/s   '
+   pisdia2d(8)  = 'ExpFe2   ' , 'Diatoms iron export               ',  'molFe/m2/s   '
+   pisdia2d(9)  = 'ExpSi    ' , 'Silicate export                   ',  'molSi/m2/s   '
+   pisdia2d(10) = 'ExpCaCO3 ' , 'Calcite export                    ',  'molC/m2/s    '
+   pisdia2d(11) = 'heup     ' , 'euphotic layer depth              ',  'm            '
+   pisdia2d(12) = 'Fedep    ' , 'Iron dep                          ',  'molFe/m2/s   '
+   pisdia2d(13) = 'Nfix     ' , 'Nitrogen Fixation                 ',  'molN/m2/s    '
+   pisdia3d(1)  = 'PH       ' , 'PH                                ',  '-            '
+   pisdia3d(2)  = 'CO3      ' , 'Bicarbonates                      ',  'mol/l        '
+   pisdia3d(3)  = 'CO3sat   ' , 'CO3 saturation                    ',  'mol/l        '
+   pisdia3d(4)  = 'PAR      ' , 'light penetration                 ',  'W/m2         '
+   pisdia3d(5)  = 'PPPHY    ' , 'Primary production of nanophyto   ',  'molC/m3/s    '
+   pisdia3d(6)  = 'PPPHY2   ' , 'Primary production of diatoms     ',  'molC/m3/s    '
+   pisdia3d(7)  = 'PPNEWN   ' , 'New Primary production of nano    ',  'molC/m3/s    '
+   pisdia3d(8)  = 'PPNEWD   ' , 'New Primary production of diat    ',  'molC/m3/s    '
+   pisdia3d(9)  = 'PBSi     ' , 'Primary production of Si diatoms  ',  'molSi/m3/s   '
+   pisdia3d(10) = 'PFeN     ' , 'Primary production of nano iron   ',  'molFe/m3/s   '
+   pisdia3d(11) = 'PFeD     ' , 'Primary production of diatoms iron',  'molFe/m3/s   '
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_top	(revision 3437)
@@ -0,0 +1,146 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!!              2 - tracer data initialisation            (namtrc_dta)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
+!!              7 - dynamical tracer trends               (namtrc_trd)
+!!              8 - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers      
+   nn_writetrc   =  5475     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                             !                  = 1 do not use the value in the restart file
+                             !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   ln_trcdta     =   .true.  !  Initialisation from data input file (T) or not (F)
+   ln_trcdmp     =  .false.  !  add a damping termn (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 !
+!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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'  , ''       , ''
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+   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_cen2   =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd    =  .false.  !  TVD scheme
+   ln_trcadv_muscl  =  .true.   !  MUSCL scheme
+   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
+   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
+   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&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_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F)
+   nn_writedia   =  5475     !  time step frequency for diagnostics
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.card	(revision 3437)
@@ -0,0 +1,28 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+
+[InitialStateFiles]
+List=	()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= ()
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist_ice_lim2, namelist_ice)
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart_ice.nc, restart_icemod.nc, restart_ice_in.nc)
+
+[OutputText]
+List=   (ice_evolu)
+
+[OutputFiles]
+List=   (${PREFIX_WFI1}_icemod.nc, ${R_OUT_ICE_WFI1}/${PREFIX}_${WFI1}_icemod.nc, Post_1M_icemod)
+
+[Post_1M_icemod]
+Patches = ()
+GatherWithInternal = (nav_lon, nav_lat, time_counter)
+TimeSeriesVars = (iicethic, ileadfra, isnowthi, iicevelu, iicevelv)
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/lim2.driver	(revision 3437)
@@ -0,0 +1,56 @@
+#!/bin/ksh
+
+#-----------------------------------
+function ICE_Initialize
+{ 
+    IGCM_debug_PushStack "ICE_Initialize"
+
+    echo INITIALIZE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Initialize"
+}
+
+#-----------------------------------
+function ICE_Update
+{
+    IGCM_debug_PushStack "ICE_Update"
+
+    NbFreq=$( echo ${config_ICE_WriteFrequency} | wc -w )
+
+    ##--Write Frequency Purpose ....
+    typeset -Z1 i=1
+    while [ $i -le ${NbFreq} ]; do
+        frequency=$( echo ${config_ICE_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+        factor=$( echo ${frequency} | sed -e "s/[yYmMdD]//" )
+        case ${frequency} in
+            *Y|*y)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}y_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_Y} ;
+                eval WFI${i}=${factor}Y ;;
+            *M|*m)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}m_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_M} ;
+                eval WFI${i}=${factor}M ;;
+            *D|*d)
+                eval PREFIX_WFI${i}=${config_UserChoices_JobName}_${factor}d_${DatesPeriod} ;
+                eval R_OUT_ICE_WFI${i}=${R_OUT_ICE_O_D} ;
+                eval WFI${i}=${factor}D ;;
+            *)
+        esac
+        let i=$i+1
+
+    done
+    echo UPDATE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Update"
+}
+
+#-----------------------------------
+function ICE_Finalize
+{
+    IGCM_debug_PushStack "ICE_Finalize"
+
+    echo FINALIZE ICE !!!
+
+    IGCM_debug_PopStack "ICE_Finalize"
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.card	(revision 3437)
@@ -0,0 +1,123 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+OPA_NDT_DAY=15
+#==============================================================
+#-- Name of directory for COMMON ACCOUNT at idris or CCRT
+#-- available directories are:  v3, v3_1, v3_2
+#-- related to NEMO_tag_revision (nemo_v3, nemo_v3_1, nemo_v3_2_beta)
+#-- NOTE: if you use COMMON ACCOUNT you have to de-comment it
+#OPA_version=v3_2
+#==============================================================
+
+#===================================
+#-- Use (y) or not (n) of io_server
+io_server=n
+#===================================
+
+#-- if you run interannual is "y", if not (=climatology) is "n"
+Interannual_Run=n
+
+[Interannual]
+#==================================================================================================
+#-- Surface Boundary Condition original files name ( get by the job ) same as the ones in namelist
+#==================================================================================================
+#-- NOTE: MANDATORY STRUCTURE OF FILE NAMES GET BY THE JOB : 
+#-- "basename_yyyy.nc"  	( for interannual data )
+#-- "basename.nc"	  	( for climatologycal data )
+#-- MANDATORY: NAMES USED IN List_jobsbc VARIABLE MUST BE ONLY THE BASENAME
+
+# default climatology, bulk_clio: 
+#List_jobsbc=(flx, taux_1m, tauy_1m)
+# example for interannual, bulk core, forcing CORE2:
+List_jobsbc=(u_10.15JUNE2009_orca2, v_10.15JUNE2009_orca2, ncar_rad.15JUNE2009_orca2, t_10.15JUNE2009_orca2, q_10.15JUNE2009_orca2, ncar_precip.15JUNE2009_orca2)
+# example for interannual, bulk core, forcing DRAKKAR:
+#List_jobsbc=(radlw_DFS4-ORCA2, radsw_DFS4-ORCA2, q2_DFS4-ORCA2, t2_DFS4-ORCA2, u10_DFS4-ORCA2, v10_DFS4-ORCA2, snow_DFS4-ORCA2, precip_DFS4-ORCA2)
+
+
+[InitialStateFiles]
+List=	()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/ahmcoef, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/bathy_level.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/bathy_meter.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/coordinates.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_potential_temperature_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_salinity_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/geothermal_heating.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/runoff_core_monthly.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/sss_data.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/sst_data.nc, .),\
+	    (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/subbasins.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/chlorophyll.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/K1rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/M2rowdrg.nc, .),\
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/mask_itf.nc, .)
+
+
+
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist,         namelist), \
+	(${SUBMIT_DIR}/PARAM/iodef.xml,        iodef.xml),      \
+        (${SUBMIT_DIR}/PARAM/xmlio_server.def, xmlio_server.def)
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart.nc,  restart.nc, restart.nc)
+
+[OutputText]
+List=   (ocean.output, solver.stat, STRAIT.dat, out_nemo)
+
+[OutputFiles]
+List=   (${PREFIX_WF1}_grid_T.nc,         ${R_OUT_OCE_WF1}/${PREFIX}_${WF1}_grid_T.nc,               Post_1Y_grid_T),\
+        (${PREFIX_WF2}_grid_T.nc,         ${R_OUT_OCE_WF2}/${PREFIX}_${WF2}_grid_T.nc,               Post_1M_grid_T),\
+        (${PREFIX_WF3}_grid_T.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_T.nc,               Post_1M_grid_T),\
+        (${PREFIX_WF3}_grid_U.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_U.nc,               Post_1M_grid_U) ,\
+        (${PREFIX_WF3}_grid_V.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_V.nc,               Post_1M_grid_V),\
+        (${PREFIX_WF3}_grid_W.nc,         ${R_OUT_OCE_WF3}/${PREFIX}_${WF3}_grid_W.nc,               Post_1M_grid_W),\
+        (${PREFIX_WF4}_grid_T_0n180w.nc,  ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_grid_T_0n180w.nc,        NONE ),\
+        (${PREFIX_WF4}_grid_T_Eq.nc,      ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_grid_T_Eq.nc,            NONE ),\
+        (${PREFIX_WF4}_diaptr.nc,         ${R_OUT_OCE_WF4}/${PREFIX}_${WF4}_diaptr.nc,               Post_1D_diaptr),\
+        (mesh_mask.nc     ,               ${R_OUT_OCE_O}/${config_UserChoices_JobName}_mesh_mask.nc, NONE),\
+        (output.abort.nc  ,               ${R_OUT_OCE_D}/${PREFIX}_output.abort.nc,                  NONE),\
+        (output.init.nc   ,               ${R_OUT_OCE_O_I}/${config_UserChoices_JobName}_${PeriodDateBegin}_output.init.nc, NONE)
+
+
+[Post_1Y_grid_T]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, deptht, time_counter)
+TimeSeriesVars = (sohtc300, sohefldo, soicecov, somxl010, sosaline, sossheig, sosstsst, sowaflcd, sowaflup)
+
+[Post_1M_grid_T]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, deptht, time_counter)
+TimeSeriesVars = (sohtc300, sohefldo, soicecov, somxl010, sosaline, sossheig, sosstsst, sowaflcd, sowaflup)
+
+[Post_1M_grid_U]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthu, time_counter)
+TimeSeriesVars = (sozotaux)
+
+[Post_1M_grid_V]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthv, time_counter)
+TimeSeriesVars = (sometauy)
+
+[Post_1M_grid_W]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal = (nav_lon, nav_lat, depthw, time_counter)
+TimeSeriesVars =
+
+[Post_1D_diaptr]
+Patches = ()
+GatherWithInternal = (lat, deptht, depthw, time_counter)
+TimeSeriesVars = (zotemglo, zosalglo, zomsfglo, zotematl, zosalatl, zomsfatl, zotempac, zosalpac, zomsfpac, zotemind, zosalind, zomsfind, zotemipc, zosalipc, zomsfipc, sohtatl, sostatl, sohtpac, sostpac, sohtind, sostind, sohtipc, sostipc, sophtadv, sophtove, sophtldf, sopstadv, sopstove, zomsfeiv, sophteiv, sopsteiv)
+
+[Post_time]
+Patches = (Patch_20091030_histcom_time_axis)
+GatherWithInternal =
+TimeSeriesVars =
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/opa9.driver	(revision 3437)
@@ -0,0 +1,288 @@
+#!/bin/ksh
+#-----------------------------------------------------------------
+function OCE_Initialize
+{
+    IGCM_debug_PushStack "OCE_Initialize"
+
+    JOB_NAME=${config_UserChoices_JobName}
+
+    OPA_NDT_DAY=${opa_UserChoices_OPA_NDT_DAY:=15}
+
+
+    ##--Variables used by OPA --
+
+    # cn_exp experience name for vairmer format
+    # nn_it000 number of the first time step
+    # nn_itend number of the last time step
+    # nn_leapy leap year calendar (0/1) (30 for 360d)
+    # nn_write frequency of OUTPUT file
+    # ln_rstart boolean term for restart (true or false)
+    # nn_stock frequency of restart file
+    # nn_rstctl control of the time step (0, 1 or 2)
+    # nn_date0 initial calendar date aammjj
+    # nn_msh  =1 create a mesh file (coordinates, scale factors, masks)
+    # rn_rdt time step in seconds (coming from namelist)
+    # nf_ptr_wri frequency of zonal means and transport output
+
+
+# Local function to find namelists parameters
+supergrep () {
+    grep "^ *$1 *=" $2 | sed -e "s% *\!.*%%"
+}
+
+
+    PAT_CEXPER=$( supergrep cn_exp    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NIT000=$( supergrep nn_it000    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NITEND=$( supergrep nn_itend    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NLEAPY=$( supergrep nn_leapy    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_RESTAR=$( supergrep ln_rstart ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NSTOCK=$( supergrep nn_stock    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NRSTAR=$( supergrep nn_rstctl    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NDATE0=$( supergrep nn_date0    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NMSH=$(   supergrep nn_msh      ${SUBMIT_DIR}/PARAM/namelist ) 
+    
+
+    OPA_RDT=$( supergrep rn_rdt  ${SUBMIT_DIR}/PARAM/namelist | sed 's/ *rn_rdt *=//' | sed 's/\. *,//' )
+
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # /!\ Needed by OPA namelist to compute file names /!\
+    (( DaysSinceJC = $( IGCM_date_DaysSinceJC ${DateBegin} ) + 1 ))
+
+    # Definition from opa9.card of List_jobsbc and List_runsbc used to do to interannual and climatological runs 
+	IGCM_card_DefineArrayFromOption ${SUBMIT_DIR}/COMP/opa9.card Interannual List_jobsbc
+        set -A ListFormulationJobsbc -- \${opa9_Interannual_Listjobsc${opa9_Interannual_List_jobsbc}[*]}
+
+    ##--Variables used for XMLIO_SERVER configuration file
+	    # using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+	    PAT_SERVER=$( supergrep using_server ${SUBMIT_DIR}/PARAM/xmlio_server.def )
+	
+    IGCM_debug_PopStack "OCE_Initialize"
+}
+
+#-----------------------------------------------------------------
+function OCE_Update
+{
+    IGCM_debug_PushStack "OCE_Update"
+
+    # Interannual run
+    # In this case job need to calculate previous and following year and give, and if every run needs to add "_y" before every year 
+    if [ X${opa9_UserChoices_Interannual_Run} = Xy ] ; then
+
+	typeset file 
+
+ 	(( PeriodCumulPeriod =  ${CumulPeriod} - 1 )) 
+ 	(( PeriodInitYear =${InitYear} + ${PeriodCumulPeriod} * ${PeriodLengthInYears} ))
+ 	(( PeriodFinalYear =${InitYear} + ${PeriodLengthInYears}*${CumulPeriod} - 1 ))
+
+        NbFileInter=${#opa9_Interannual_List_jobsbc[*]}
+        (( NbFileInter_tot=${#opa9_Interannual_List_jobsbc[*]} * ${PeriodLengthInYears} ))
+	(( i = 0 ))
+
+	while [ ${year} -le ${PeriodFinalYear} ] ; do #copy in ONCE of ALL necessary files for all PeriodLength
+	    
+	    while [ $i -lt ${NbFileInter} ] ; do
+		
+		eval file=${opa9_Interannual_List_jobsbc[$i]}
+		if [ X${year} = X${PeriodInitYear} ] ; then  
+                        	if [ ${month} -eq 01 ] ; then
+		    			# if year-1 does not exist we create a file _noym1.nc copy of year
+		    			eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year - 1 )).nc
+		    			if  [ ! -f ${jobsbc_file_ym1} ] ; then
+		    				eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		    				eval runsbc_file_ym1=${file}_noym1.nc
+		    			else
+		    			    eval jobsbc_file_ym1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year - 1 )).nc
+		    			    eval runsbc_file_ym1=${file}_y$(( year - 1 )).nc
+		    			fi
+
+                            IGCM_sys_Get ${jobsbc_file_ym1} ${runsbc_file_ym1}
+                        	fi
+		fi
+		
+       		# download year 
+		eval jobsbc_file_y=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		eval runsbc_file_y=${file}_y${year}.nc
+		
+		if [ ! -f ${runsbc_file_y} ] ; then
+		    IGCM_sys_Get ${jobsbc_file_y} ${runsbc_file_y}
+		fi
+		
+		# download (year+1) if it is last year of run
+		if [ X${year} = X${PeriodFinalYear} ] ; then 	
+	
+		    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+		    eval runsbc_file_yp1=${file}_y$(( year + 1 )).nc
+		    
+		    if  [ ! -f ${runsbc_file_yp1} ] ; then
+			
+		        # if year+1 does not exist we create a file _noyp1.nc copy of year
+		    	eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+			if  [ ! -f ${jobsbc_file_yp1} ] ; then
+			    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_${year}.nc
+		    	    eval runsbc_file_yp1=${file}_noyp1.nc
+			else
+			    eval jobsbc_file_yp1=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}_$(( year + 1 )).nc
+			    eval runsbc_file_yp1=${file}_y$(( year + 1 )).nc
+			fi
+			IGCM_sys_Get ${jobsbc_file_yp1} ${runsbc_file_yp1}
+		    fi
+		    
+		fi
+		(( i = i + 1 ))
+	
+	    done
+	
+	    (( year = year + 1 ))
+	 
+	    (( i = 0 ))
+	done
+
+    # End interannual
+    elif [ X${opa9_UserChoices_Interannual_Run} = Xn ] ; then
+    # Climatological run
+       typeset file 
+
+       eval NbFileInter=${#opa9_Interannual_List_jobsbc[*]}
+
+        (( i = 0 ))
+        while [ $i -lt ${NbFileInter} ] ; do
+            eval file=${opa9_Interannual_List_jobsbc[$i]}
+            eval jobsbc_file=${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/${file}.nc
+            eval runsbc_file=${file}.nc
+
+            IGCM_sys_Get ${jobsbc_file} ${runsbc_file}
+            (( i = i + 1 ))
+	done
+    fi
+    # End climatological
+
+    NbFreq=$( echo ${config_OCE_WriteFrequency} | wc -w )
+
+    ##--Write Frequency Purpose ....
+    typeset -Z1 i=1
+    while [ $i -le ${NbFreq} ]; do
+        frequency=$( echo ${config_OCE_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+    	factor=$( echo ${frequency} | sed -e "s/[yYmMdD]//" )
+    	case ${frequency} in
+    	    *Y|*y)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}y_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_Y} ;
+    	        eval WF${i}=${factor}Y ;;
+    	    *M|*m)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}m_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_M} ;
+    	        eval WF${i}=${factor}M ;;
+    	    *D|*d)
+    	        eval PREFIX_WF${i}=${config_UserChoices_JobName}_${factor}d_${DatesPeriod} ;
+    	        eval R_OUT_OCE_WF${i}=${R_OUT_OCE_O_D} ;
+    	        eval WF${i}=${factor}D ;;
+    	    *)
+    	esac
+        let i=$i+1
+
+    done
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # Needed by OPA namelist to compute correct file names 
+    (( PeriodDaysSinceJC =  $( IGCM_date_DaysSinceJC ${PeriodDateBegin} ) + 1  ))
+
+    ## Count of number of time steps from begin of OPA job
+    (( OPA_NIT000 = ( PeriodDaysSinceJC - DaysSinceJC ) * OPA_NDT_DAY + 1 ))
+    (( OPA_NDT   = PeriodLengthInDays * OPA_NDT_DAY ))
+    (( OPA_NITEND = OPA_NIT000 + OPA_NDT - 1))
+
+    ## Forcing to write one restart file at the end of period
+    OPA_NSTOCK="${OPA_NITEND}"
+
+    ## Verification of number of time steps per day
+    (( NB_SEC_DAY_MODEL = OPA_NDT_DAY * OPA_RDT ))
+    (( NB_SEC_DAY = 60 * 60 * 24 ))
+
+    if [ ${NB_SEC_DAY_MODEL} -ne ${NB_SEC_DAY} ]
+	then
+        echo " VERIFY OPA_NDT_DAY in opa9.card "
+        exit
+    fi
+
+    ##-- Restart configuration
+    if ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_OCE_Restart}" = "n" ] ) ; then
+
+        #echo "NO OPA RESTART"
+	OPA_LRSTAR=.FALSE.
+	OPA_NRSTDT=0
+        #Put OPA_NMSH=0 when OPA runnig in parallel mode 
+	OPA_NMSH=1
+	( [ X${BATCH_NUM_PROC_TOT} != X ] && [ "${BATCH_NUM_PROC_TOT}" -gt 1 ] ) && OPA_NMSH=0
+
+    elif ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_OCE_Restart}" = "y" ] ) ; then
+
+        #echo "OPA RESTART"
+	OPA_LRSTAR=.TRUE.
+	OPA_NRSTDT=1
+	OPA_NMSH=0
+
+    else
+
+        #echo "OPA RESTART"
+	OPA_LRSTAR=.TRUE.
+	OPA_NRSTDT=2
+	OPA_NMSH=0
+
+    fi
+   
+     ## nleapy configuration
+	case ${config_UserChoices_CalendarType} in
+        	leap)
+            	OPA_NLEAPY=1;;
+        	noleap)
+            	OPA_NLEAPY=0;;
+        	360d)
+            	OPA_NLEAPY=30;;
+    	esac
+
+
+        typeset -r PRECIS=8
+	NEMO_END=$( echo $( awk "BEGIN { printf \"%0${PRECIS}d\",${OPA_NITEND} }" ) ) 
+
+    sed -e "s%${PAT_CEXPER}%       cn_exp=\"${config_UserChoices_JobName}\"%"  \
+	-e "s%${PAT_NIT000}%       nn_it000=${OPA_NIT000}%"                    \
+	-e "s%${PAT_NITEND}%       nn_itend=${OPA_NITEND}%"                    \
+	-e "s%${PAT_RESTAR}%       ln_rstart=${OPA_LRSTAR}%"                   \
+	-e "s%${PAT_NSTOCK}%       nn_stock=${OPA_NSTOCK}%"                    \
+	-e "s%${PAT_NRSTAR}%       nn_rstctl=${OPA_NRSTDT}%"                   \
+	-e "s%${PAT_NDATE0}%       nn_date0=${PeriodDateBegin}%"               \
+	-e "s%${PAT_NMSH}%         nn_msh=${OPA_NMSH}%"                        \
+	-e "s%${PAT_NLEAPY}%       nn_leapy=${OPA_NLEAPY}%"	               \
+	namelist > namelist.tmp
+
+    IGCM_sys_Mv namelist.tmp namelist
+
+
+    # update xmlio_server.def
+
+    if [ X${opa9_UserChoices_io_server} = Xy ] ; then
+        sed -e "s/${PAT_SERVER}/  using_server = .TRUE./" \
+        xmlio_server.def > xmlio_server.def.tmp
+        IGCM_sys_Mv xmlio_server.def.tmp xmlio_server.def
+    fi
+	
+    IGCM_debug_PopStack "OCE_Update"
+}
+
+#-----------------------------------
+function OCE_Finalize
+{
+    IGCM_debug_PushStack "OCE_Finalize"
+
+    if [ -f date.file ] ; then
+        # Prefix use in opa.card AND in lim2.card :
+	DATE_OPA=$( cat date.file | \
+	    sed "s/\ ${config_UserChoices_JobName}_[0-9]*[a-z]_\([0-9]*_[0-9]*\)_\ */\1/g" )
+        ###DATE_OPA=$( $DATE_OPABF | cut -c1-30 )
+	MainPrefix=${config_UserChoices_JobName}_1d_${DATE_OPA}
+	SecondPrefix=${config_UserChoices_JobName}_5d_${DATE_OPA}
+    fi
+
+    echo FINALIZE OCE !!!
+
+    IGCM_debug_PopStack "OCE_Finalize"
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.card	(revision 3437)
@@ -0,0 +1,40 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+
+[InitialStateFiles]
+List= ()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_DIC_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_Alkalini_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_O2_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_NO3_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_PO4_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_Si_nomask.nc,  .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_DOC_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/data_1m_Fer_nomask.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/kRGB61.txt, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/dust.orca.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/bathy.orca.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/river.orca.nc, .), \
+            (${R_BC}/OCE/${config_UserChoices_TagName}/${opa9_UserChoices_OPA_version}/ndeposition.orca.nc, .)
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist_top, .), \
+        (${SUBMIT_DIR}/PARAM/namelist_pisces, .), \
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart_trc.nc,  restart_trc.nc, restart_trc.nc)
+
+[OutputText]
+List=   ()
+
+[OutputFiles]
+List=   (${PREFIX_WFT1}_ptrc_T.nc, ${R_OUT_MBG_WFT1}/${PREFIX}_${WFT1}_ptrc_T.nc, NONE), \
+        (${PREFIX_WFT1}_diad_T.nc, ${R_OUT_MBG_WFT1}/${PREFIX}_${WFT1}_diad_T.nc, NONE), \
+        (${PREFIX_WFT2}_ptrc_T.nc, ${R_OUT_MBG_WFT2}/${PREFIX}_${WFT2}_ptrc_T.nc, Post_1M_ptrc_T), \
+        (${PREFIX_WFT3}_diad_T.nc, ${R_OUT_MBG_WFT3}/${PREFIX}_${WFT3}_diad_T.nc, Post_5D_ptrc_T)
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/COMP/pisces.driver	(revision 3437)
@@ -0,0 +1,110 @@
+#!/bin/ksh
+
+#-----------------------------------
+function MBG_Initialize
+{ 
+    IGCM_debug_PushStack "MBG_Initialize"
+
+# Local function to find namelists parameters
+supergrep () {
+    grep "^ *$1 *=" $2 | sed -e "s% *\!.*%%"
+}
+
+    ##--Variables used by MBG --
+
+    # lrsttr    boolean term for tracer model restart (true or false)
+    # nrsttr    control of the time step (0, 1 or 2)
+    
+    ##--Variables used by PISCES --
+ 
+    PAT_TOP_LRSTTR=$( supergrep ln_rsttr                 ${SUBMIT_DIR}/PARAM/namelist_top )
+    PAT_TOP_NRSTTR=$( supergrep nrsttr                   ${SUBMIT_DIR}/PARAM/namelist_top )
+    PAT_PIS_LRIVER=$( supergrep ln_river                 ${SUBMIT_DIR}/PARAM/namelist_pisces )
+
+    IGCM_debug_PopStack "MBG_Initialize"
+}
+
+#-----------------------------------
+function MBG_Update
+{
+    IGCM_debug_PushStack "MBG_Update"
+
+
+    ##--Write Frequency Purpose
+    Nbfreq=$( echo ${config_MBG_WriteFrequency} | wc -w )
+    typeset -Z1 i=1
+    while [ $i -le ${Nbfreq} ]; do
+       topfrequency=$( echo ${config_MBG_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+       topfactor=$( echo ${topfrequency} | sed -e "s/[yYmMdD]//" )
+       case ${topfrequency} in
+         *Y|*y)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}y_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_Y} ;
+            eval WFT${i}=${topfactor}Y ;;
+         *M|*m)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}m_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_M} ;
+            eval WFT${i}=${topfactor}M ;;
+         *D|*d)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}d_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_D} ;
+            eval WFT${i}=${topfactor}D ;;
+         *)
+      esac
+       let i=$i+1
+    done
+
+    ##-- Restart configuration
+    if ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_MBG_Restart}" = "n" ] ) ; then
+
+        #echo "NO RESTART FOR TOP"
+        TOP_LRSTTR=.FALSE.
+        TOP_NRSTTR=0
+
+        PISCES_LRIVER=.FALSE.
+
+    elif ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_MBG_Restart}" = "y" ] ) ; then
+
+        #echo "RESTART TOP"
+        TOP_LRSTTR=.TRUE.
+        TOP_NRSTTR=0
+
+        PISCES_LRIVER=.TRUE.
+
+    else
+
+        #echo "RESTART TOP"
+        TOP_LRSTTR=.TRUE.
+        TOP_NRSTTR=2
+
+        PISCES_LRIVER=.TRUE.
+
+    fi
+
+# on force les sorties PISCES comme les sorties OPA
+
+    sed -e "s%${PAT_TOP_LRSTTR}%          ln_rsttr=${TOP_LRSTTR}%"                   \
+        -e "s%${PAT_TOP_NRSTTR}%          nrsttr=${TOP_NRSTTR}%"                   \
+        namelist_top > namelist_top.tmp
+
+    IGCM_sys_Mv namelist_top.tmp namelist_top
+
+    sed -e "s%${PAT_PIS_LRIVER}%          ln_river=${PISCES_LRIVER}%"                \
+        namelist_pisces > namelist_pisces.tmp
+
+    IGCM_sys_Mv namelist_pisces.tmp namelist_pisces
+
+
+    IGCM_debug_PopStack "MBG_Update"
+}
+
+#-----------------------------------
+function MBG_Finalize
+{
+    IGCM_debug_PushStack "MBG_Finalize"
+
+    echo FINALIZE MBG !!!
+
+    IGCM_debug_PopStack "MBG_Finalize"
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/README	(revision 3437)
@@ -0,0 +1,9 @@
+config.card
+ORCA2_LIM_PISCES
+1 year
+trunk of 12 months
+
+Wit monitoring, without atlas
+
+Tested on  NEC SX-8R mercure at CCRT.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/config.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/config.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/IGCM00/config.card	(revision 3437)
@@ -0,0 +1,125 @@
+#
+# This is config.card file for NEMO ORCA2_LIM_PISCES configuration
+#
+#========================================================================
+#D-- Compatibility -
+[Compatibility]
+libIGCM=1.0
+#D-- UserChoices -
+[UserChoices]
+#============================
+#-- (<8 chars MAX for JobName)
+JobName=OR2LP
+LongName="SCRIPT_V1"
+TagName=ORCA2_LIM2_PISCES
+#============================
+#-- leap, noleap, 360d
+CalendarType=noleap
+#-- Begin and end of Job
+#-- "YYYY-MM-DD"
+DateBegin=2001-01-01
+DateEnd=2005-12-31
+#============================
+#-- 1Y, 1M, 5D, 1D
+PeriodLength=1Y
+#============================
+#-- PBS Class (required on brodie mono/multi)
+JobClass=mono
+#JobClass=multi
+#============================
+#-- Total Number of Processors
+#JobNumProcTot=4
+JobNumProcTot=1
+#============================
+#-- Run Options : 
+JobRunOptions=''
+#JobRunOptions='"-np "${BATCH_NUM_PROC_TOT}"'
+#============================
+#============================
+# config.card configuration options :
+#R_BC=/u/rech/psl/rpsl035/IGCM/BC
+#R_BC=/dmnfs/cont003/p86ipsl/IGCM/BC
+#========================================================================
+#D-- ListOfComponents -
+[ListOfComponents]
+#D- For each component, Name of component, Tag of component
+OCE= (opa9, NEMO_v3)
+ICE= (lim2, LIM_2)
+MBG= (pisces, PISCES)
+#========================================================================
+#D-- Executable -
+[Executable]
+Name=nemo
+#D- For each component, Real name of executable
+OCE= (nemo.exe, nemo)
+ICE= ("", "")
+MBG= ("", "")
+#========================================================================
+#D-- Restarts -
+[Restarts]
+#D- If you want a GENERAL RULE FOR RESTARTS, put this flag to 'y'
+OverRule=n
+#D- Last day of the experience used as restart
+RestartDate=2000-12-31
+#D- Define restart simulation name
+RestartJobName=OR2LP
+#D- Path Server Group Login
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM_PISCES
+
+#========================================================================
+#D-- Post -
+[Post]
+#D- Do we rebuild parallel output, this flag determines
+#D- frequency of rebuild submission
+#D- BETA FEATURE
+RebuildFrequency=NONE
+#D- If you want to produce time series, this flag determines
+#D- frequency of post-processing submission
+RebuildFromArchive=true
+#D- If you want to produce time series, this flag determines
+#D- frequency of post-processing submission
+TimeSeriesFrequency=NONE
+#D- If you want to produce seasonal average, this flag determines
+#D- the period of this average
+SeasonalFrequency=NONE
+
+#========================================================================
+#D-- OCE -
+[OCE]
+WriteFrequency="1Y 1M 5D 1D"
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=2000-12-31
+# Define restart simulation name
+RestartJobName=OR2LP1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM_PISCES
+# Old component name for restart (if empty, use new name)
+OldName=
+
+#========================================================================
+#D-- ICE -
+[ICE]
+WriteFrequency="5D"
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=2000-12-31
+# Define restart simulation name
+RestartJobName=OR2LP1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM_PISCES
+# Old component name for restart (if empty, use new name)
+OldName=
+
+#========================================================================
+#D-- MBG -
+[MBG]
+WriteFrequency="1Y 1M 5D"
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=2000-12-31
+# Define restart simulation name
+RestartJobName=OR2LP1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_LIM_PISCES
+# Old component name for restart (if empty, use new name)
+OldName=
+
+#========================================================================
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/cpp_ORCA2_LIM_PISCES.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_top key_pisces key_iomput 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/AA_job	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/iodef.xml	(revision 3437)
@@ -0,0 +1,255 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+
+    <!-- $id$ -->
+ 
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+
+  <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+ 
+      <!-- ptrc on T grid -->
+ 
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="mmol/m3" />
+       <field id="Alkalini" description="Total Alkalinity Concentration"           unit="mmol/m3"    />
+       <field id="O2"       description="Oxygen Concentration"                     unit="mmol/m3" />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="mmol/m3" />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="mmol/m3" />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="mmol/m3" />
+       <field id="Si"       description="Silicate Concentration"                   unit="mmol/m3" />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="mmol/m3" />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="mmol/m3" />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="mmol/m3" />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="mmol/m3" />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="mmol/m3" />
+       <field id="DSi"      description="Diatoms Silicate Concentration"           unit="mmol/m3" />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="mmol/m3" />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="mmol/m3" />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="mmol/m3" />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="mmol/m3" />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="mmol/m3" />
+       <field id="GSi"      description="Sinking biogenic Silicate Concentration"  unit="mmol/m3" />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="mmol/m3" />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="mg/m3" />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="mg/m3" />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="mmol/m3" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="mmol/m3" />
+     </group>
+
+      <!-- diad on T grid : variables available with key_diatrc -->
+
+     <group id="diad_T" axis_ref="none" grid_ref="grid_T">
+       <field id="PH"          description="PH"                                       unit="-"          axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/m3"     axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/m3"     axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"       axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="mol/m3/s"   axis_ref="deptht" />
+       <field id="Mumax"       description="Maximum growth rate"                      unit="s-1"        axis_ref="deptht" />
+       <field id="MuN"         description="Realized growth rate for nanophyto"       unit="s-1"        axis_ref="deptht" />
+       <field id="MuD"         description="Realized growth rate for diatomes"        unit="s-1"        axis_ref="deptht" />
+       <field id="MuNlight"    description="Light limited growth rate for nanophyto"  unit="s-1"        axis_ref="deptht" />
+       <field id="MuDlight"    description="Light limited growth rate for diatomes"   unit="s-1"        axis_ref="deptht" />
+       <field id="LNnut"       description="Nutrient limitation term in Nanophyto"    unit="-"          axis_ref="deptht" />
+       <field id="LDnut"       description="Nutrient limitation term in Diatoms"      unit="-"          axis_ref="deptht" />
+       <field id="LNFe"        description="Iron limitation term in Nanophyto"        unit="-"          axis_ref="deptht" />
+       <field id="LDFe"        description="Iron limitation term in Diatoms"          unit="-"          axis_ref="deptht" />
+       <field id="LNlight"     description="Light limitation term in Nanophyto"       unit="-"          axis_ref="deptht" />
+       <field id="LDlight"     description="Light limitation term in Diatoms"         unit="-"          axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="mol/m2/s"                     />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="mol/m2/s"                     />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="mol/m2/s"                     />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="mol/m2/s"                     />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="mol/m2/s"                     />
+       <field id="Cflx"        description="DIC flux"                                 unit="mol/m2/s"                     />
+       <field id="Oflx"        description="Oxygen flux"                              unit="mol/m2/s"                     />
+       <field id="Kg"          description="Gas transfer"                             unit="mol/m2/s/uatm"                />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"                         />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"                         />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"                            />
+       <field id="Irondep"     description="Iron deposition"                          unit="mol/m2/s"                     />
+     </group>
+
+      <!-- scalar -->
+      
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+      </group>
+
+  </field_definition>
+
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+
+  <file_definition output_level="10" enabled=".TRUE.">
+   
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+      </group>
+
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+
+        <file id="5d_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+        </file>
+      
+      </group>
+ 
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+
+        <file id="1m_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="Fer"      />
+          <field ref="NO3"      />
+       </file>
+
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+        
+        <file id="1y_ptrc_T" name="auto" description="pisces sms variables" >
+          <field ref="DIC"      />
+          <field ref="Alkalini" />
+          <field ref="O2"       />
+          <field ref="CaCO3"    />
+          <field ref="PO4"      />
+          <field ref="POC"      />
+          <field ref="Si"       />
+          <field ref="PHY"      />
+          <field ref="ZOO"      />
+          <field ref="DOC"      />
+          <field ref="PHY2"     />
+          <field ref="ZOO2"     />
+          <field ref="DSi"      />
+          <field ref="Fer"      />
+          <field ref="BFe"      />
+          <field ref="GOC"      />
+          <field ref="SFe"      />
+          <field ref="DFe"      />
+          <field ref="GSi"      />
+          <field ref="NFe"      />
+          <field ref="NCHL"     />
+          <field ref="DCHL"     />
+          <field ref="NO3"      />
+          <field ref="NH4"      />
+       </file>
+
+       <file id="1y_diad_T" name="auto" description="additional pisces diagnostics" >
+          <field ref="PH"       />
+          <field ref="CO3"      />
+          <field ref="CO3sat"   />
+          <field ref="PAR"      />
+          <field ref="PPPHY"    />
+          <field ref="PPPHY2"   />
+          <field ref="PPNEWN"   />
+          <field ref="PPNEWD"   />
+          <field ref="PBSi"     />
+          <field ref="PFeN"     />
+          <field ref="PFeD"     />
+          <field ref="PCAL"     />
+          <field ref="DCAL"     />
+          <field ref="GRAZ"     />
+          <field ref="Mumax"    />
+          <field ref="MuN"      />
+          <field ref="MuD"      />
+          <field ref="MuNlight" />
+          <field ref="MuDlight" />
+          <field ref="LNnut"    />
+          <field ref="LDnut"    />
+          <field ref="LNFe"     />
+          <field ref="LDFe"     />
+          <field ref="LNlight"  />
+          <field ref="LDlight"  />
+          <field ref="EPC100"   />
+          <field ref="EPFE100"  />
+          <field ref="EPSI100"  />
+          <field ref="EPCAL100" />
+          <field ref="Cflx"     />
+          <field ref="Oflx"     />
+          <field ref="Kg"       />
+          <field ref="Dpco2"    />
+          <field ref="Dpo2"     />
+          <field ref="Heup"     />
+          <field ref="Irondep"  />
+          <field ref="Nfix"     />
+       </file>
+
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+    
+  </file_definition>
+
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+
+  <axis_definition>  
+     <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+     <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+     <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+     <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+     <axis id="none" description="axe non defini" unit="none" size="1" />
+  </axis_definition> 
+
+  <grid_definition>
+    <grid id="grid_T" description="grid T" />
+    <grid id="grid_U" description="grid U" />
+    <grid id="grid_V" description="grid V" />
+    <grid id="grid_W" description="grid W" />
+    <grid id="scalarpoint" description="scalar" >
+      <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+    </grid>
+  </grid_definition>
+
+</context>
+
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist	(revision 3437)
@@ -0,0 +1,983 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/OPA  :  1 - run manager      (namrun)
+!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd)
+!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core
+!!                                    namsbc_cpl, namtra_qsr, namsbc_rnf, 
+!!                                    namsbc_apr, namsbc_ssr, namsbc_alb)
+!!              4 - lateral boundary (namlbc, namcla, namobc, namagrif, nambdy, nambdy_tide)
+!!              5 - bottom  boundary (nambfr, nambbc, nambbl)
+!!              6 - Tracer           (nameos, namtra_adv, namtra_ldf, namtra_dmp)
+!!              7 - dynamics         (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf)
+!!              8 - Verical physics  (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx)
+!!              9 - diagnostics      (namnc4, namtrd, namspr, namflo, namptr, namhsb)
+!!             10 - miscellaneous    (namsol, nammpp, nammpp_dyndist, namctl)
+!!             11 - Obs & Assim      (namobs, nam_asminc)
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+
+!!======================================================================
+!!                   ***  Run management namelists  ***
+!!======================================================================
+!!   namrun        parameters of the run
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namrun        !   parameters of the run
+!-----------------------------------------------------------------------
+   nn_no       =       0   !  job number (no more used...)
+   cn_exp      =  "PISCES"  !  experience name 
+   nn_it000    =       1   !  first time step
+   nn_itend    =    1460   !  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_leapy    =       0   !  Leap year calendar (1) or not (0)
+   ln_rstart   = .false.   !  start from rest (F) or from a restart file (T)
+   nn_rstctl   =       0   !  restart control => activated only if ln_rstart = T
+                           !    = 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_out = "restart"   !  suffix of ocean restart name (output)
+   nn_istate   =       0   !  output the initial state (1) or not (0)
+   nn_stock    =    1460   !  frequency of creation of a restart file (modulo referenced to 1)
+   nn_write    =    1460   !  frequency of write in the output file   (modulo referenced to nn_it000)
+   ln_dimgnnn  = .false.   !  DIMG file format: 1 file for all processors (F) or by processor (T)
+   ln_mskland  = .false.   !  mask land points in NetCDF outputs (costly: + ~15%)
+   ln_clobber  = .false.   !  clobber (overwrite) an existing file
+   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+/
+
+!!======================================================================
+!!                      ***  Domain namelists  ***
+!!======================================================================
+!!   namzgr       vertical coordinate
+!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate
+!!   namdom       space and time domain (bathymetry, mesh, timestep)
+!!   namtsd       data: temperature & salinity                         
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzgr        !   vertical coordinate
+!-----------------------------------------------------------------------
+   ln_zco      = .false.   !  z-coordinate - full    steps   (T/F)      ("key_zco" may also be defined)
+   ln_zps      = .true.    !  z-coordinate - partial steps   (T/F)
+   ln_sco      = .false.   !  s- or hybrid z-s-coordinate    (T/F)
+/
+!-----------------------------------------------------------------------
+&namzgr_sco    !   s-coordinate or hybrid z-s-coordinate
+!-----------------------------------------------------------------------
+   rn_sbot_min =  300.     !  minimum depth of s-bottom surface (>0) (m)
+   rn_sbot_max = 5250.     !  maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   rn_theta    =    6.0    !  surface control parameter (0<=rn_theta<=20)
+   rn_thetb    =    0.75   !  bottom control parameter  (0<=rn_thetb<= 1)
+   rn_rmax     =    0.15   !  maximum cut-off r-value allowed (0<rn_max<1)
+   ln_s_sigma  = .false.   !  hybrid s-sigma coordinates
+   rn_bb       =    0.8    !  stretching with s-sigma
+   rn_hc       =  150.0    !  critical depth with s-sigma 
+/
+!-----------------------------------------------------------------------
+&namdom        !   space and time domain (bathymetry, mesh, timestep)
+!-----------------------------------------------------------------------
+   nn_bathy    =    1      !  compute (=0) or read (=1) the bathymetry file
+   nn_closea    =   0      !  remove (=0) or keep (=1) closed seas and lakes (ORCA)
+   nn_msh      =    1      !  create (=1) a mesh file or not (=0)
+   rn_hmin     =   -3.     !  min depth of the ocean (>0) or min number of ocean level (<0)
+   rn_e3zps_min=   20.     !  partial step thickness is set larger than the minimum of
+   rn_e3zps_rat=    0.1    !  rn_e3zps_min and rn_e3zps_rat*e3t, with 0<rn_e3zps_rat<1
+                           !
+   rn_rdt      = 21600.    !  time step for the dynamics (and tracer if nn_acc=0)
+   nn_baro     =   64      !  number of barotropic time step            ("key_dynspg_ts")
+   rn_atfp     =    0.1    !  asselin time filter parameter
+   nn_acc      =    0      !  acceleration of convergence : =1      used, rdt < rdttra(k)
+                                 !                          =0, not used, rdt = rdttra
+   rn_rdtmin   = 21600.          !  minimum time step on tracers (used if nn_acc=1)
+   rn_rdtmax   = 21600.          !  maximum time step on tracers (used if nn_acc=1)
+   rn_rdth     =  800.           !  depth variation of tracer time step  (used if nn_acc=1)
+/
+!-----------------------------------------------------------------------
+&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  !
+   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)
+/
+!!======================================================================
+!!            ***  Surface Boundary Condition namelists  ***
+!!======================================================================
+!!   namsbc          surface boundary condition
+!!   namsbc_ana      analytical         formulation
+!!   namsbc_flx      flux               formulation
+!!   namsbc_clio     CLIO bulk formulae formulation
+!!   namsbc_core     CORE bulk formulae formulation
+!!   namsbc_mfs      MFS  bulk formulae formulation
+!!   namsbc_cpl      CouPLed            formulation                     ("key_coupled")
+!!   namtra_qsr      penetrative solar radiation
+!!   namsbc_rnf      river runoffs
+!!   namsbc_apr      Atmospheric Pressure
+!!   namsbc_ssr      sea surface restoring term (for T and/or S)
+!!   namsbc_alb      albedo parameters
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsbc        !   Surface Boundary Condition (surface module)
+!-----------------------------------------------------------------------
+   nn_fsbc     = 1         !  frequency of surface boundary condition computation 
+                           !     (also = the frequency of sea-ice model call)
+   ln_ana      = .false.   !  analytical formulation                    (T => fill namsbc_ana ) 
+   ln_flx      = .false.   !  flux formulation                          (T => fill namsbc_flx )
+   ln_blk_clio = .false.   !  CLIO bulk formulation                     (T => fill namsbc_clio) 
+   ln_blk_core = .true.    !  CORE bulk formulation                     (T => fill namsbc_core) 
+   ln_blk_mfs  = .false.   !  MFS bulk formulation                      (T => fill namsbc_mfs )
+   ln_cpl      = .false.   !  Coupled formulation                       (T => fill namsbc_cpl )
+   ln_apr_dyn  = .false.   !  Patm gradient added in ocean & ice Eqs.   (T => fill namsbc_apr )
+   nn_ice      = 2         !  =0 no ice boundary condition   ,
+                           !  =1 use observed ice-cover      ,
+                           !  =2 ice-model used                         ("key_lim3" or "key_lim2)
+   ln_dm2dc    = .false.   !  daily mean to diurnal cycle on short wave
+   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf)
+   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr)
+   nn_fwb      = 3         !  FreshWater Budget: =0 unchecked 
+                           !     =1 global mean of e-p-r set to zero at each time step 
+                           !     =2 annual global mean of e-p-r set to zero
+                           !     =3 global emp set to zero and spread out over erp area
+   ln_cdgw = .false.       !  Neutral drag coefficient read from wave model (T => fill namsbc_wave )
+/
+!-----------------------------------------------------------------------
+&namsbc_ana    !   analytical surface boundary condition
+!-----------------------------------------------------------------------
+   nn_tau000   =   0       !  gently increase the stress over the first ntau_rst time-steps
+   rn_utau0    =   0.5     !  uniform value for the i-stress
+   rn_vtau0    =   0.e0    !  uniform value for the j-stress
+   rn_qns0     =   0.e0    !  uniform value for the total heat flux
+   rn_qsr0     =   0.e0    !  uniform value for the solar radiation
+   rn_emp0     =   0.e0    !  uniform value for the freswater budget (E-P)
+/
+!-----------------------------------------------------------------------
+&namsbc_flx    !   surface boundary condition : flux formulation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'utau'      ,        24         , 'utau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_vtau     = 'vtau'      ,        24         , 'vtau'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qtot     = 'qtot'      ,        24         , 'qtot'    , .false.      , .false., 'yearly'  , ''       , ''
+   sn_qsr      = 'qsr'       ,        24         , 'qsr'     , .false.      , .false., 'yearly'  , ''       , ''
+   sn_emp      = 'emp'       ,        24         , 'emp'     , .false.      , .false., 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the flux files
+/      
+!-----------------------------------------------------------------------
+&namsbc_clio   !   namsbc_clio  CLIO bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_utau     = 'taux_1m'   ,       -1          , 'sozotaux',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_vtau     = 'tauy_1m'   ,       -1          , 'sometauy',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_wndm     = 'flx'       ,       -1          , 'socliowi',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 'flx'       ,       -1          , 'socliot2',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'flx'       ,       -1          , 'socliohu',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_ccov     = 'flx'       ,       -1          , 'socliocl',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'flx'       ,       -1          , 'socliopl',   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files are
+/
+!-----------------------------------------------------------------------
+&namsbc_core   !   namsbc_core  CORE bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name                    ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                               !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_wndi     = 'u_10.15JUNE2009_orca2'       ,         6         , 'U_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Uwnd'
+   sn_wndj     = 'v_10.15JUNE2009_orca2'       ,         6         , 'V_10_MOD',   .false.    , .true. , 'yearly'  , ''       , 'Vwnd'
+   sn_qsr      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'SWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_qlw      = 'ncar_rad.15JUNE2009_orca2'   ,        24         , 'LWDN_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tair     = 't_10.15JUNE2009_orca2'       ,         6         , 'T_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_humi     = 'q_10.15JUNE2009_orca2'       ,         6         , 'Q_10_MOD',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_prec     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'PRC_MOD1',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_snow     = 'ncar_precip.15JUNE2009_orca2',        -1         , 'SNOW'    ,   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_tdif     = 'taudif_core'                 ,        24         , 'taudif'  ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_2m       = .false.   !  air temperature and humidity referenced at 2m (T) instead 10m (F)
+   ln_taudif   = .false.   !  HF tau contribution: use "mean of stress module - module of the mean stress" data
+   rn_pfac     = 1.        !  multiplicative factor for precipitation (total & snow)
+/
+!-----------------------------------------------------------------------
+&namsbc_mfs   !   namsbc_mfs  MFS bulk formulae
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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_coupled")
+!-----------------------------------------------------------------------
+!                    !     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'    ,     ''      ,         ''          ,   ''    
+/
+&namtra_qsr    !   penetrative solar radiation
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_chl      ='chlorophyll',        -1         , 'CHLA'    ,   .true.     , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   ln_traqsr   = .false.   !  Light penetration (T) or not (F)
+   ln_qsr_rgb  = .true.    !  RGB (Red-Green-Blue) light penetration
+   ln_qsr_2bd  = .false.   !  2 bands              light penetration
+   ln_qsr_bio  = .false.   !  bio-model light penetration
+   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0)
+   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1)
+   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction
+   rn_si1      =   23.0    !  2 bands: longest depth of extinction
+/
+!-----------------------------------------------------------------------
+&namsbc_rnf    !   runoffs namelist surface boundary condition
+!-----------------------------------------------------------------------
+!              !  file name           ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                      !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_rnf      = 'runoff_core_monthly',        -1         , 'sorunoff',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_cnf      = 'runoff_core_monthly',         0         , 'socoefr0',   .false.    , .true. , 'yearly'  , ''       , ''
+   sn_s_rnf    = 'runoffs'            ,        24         , 'rosaline',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_t_rnf    = 'runoffs'            ,        24         , 'rotemper',   .true.     , .true. , 'yearly'  , ''       , ''
+   sn_dep_rnf  = 'runoffs'            ,         0         , 'rodepth' ,   .false.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir       = './'      !  root directory for the location of the runoff files
+   ln_rnf_emp   = .false.   !  runoffs included into precipitation field (T) or into a file (F)
+   ln_rnf_mouth = .true.    !  specific treatment at rivers mouths
+   rn_hrnf      =  15.e0    !  depth over which enhanced vertical mixing is used
+   rn_avt_rnf   =   1.e-3   !  value of the additional vertical mixing coef. [m2/s]
+   rn_rfact     =   1.e0    !  multiplicative factor for runoff
+   ln_rnf_depth = .false.   !  read in depth information for runoff
+   ln_rnf_tem   = .false.   !  read in temperature information for runoff
+   ln_rnf_sal   = .false.   !  read in salinity information for runoff
+/
+!-----------------------------------------------------------------------
+&namsbc_apr    !   Atmospheric pressure used as ocean forcing or in bulk
+!-----------------------------------------------------------------------
+!              ! file name ! frequency (hours) ! variable ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !           !  (if <0  months)  !   name   !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   sn_apr      = 'patm'    ,         -1        ,'somslpre',    .true.      , .true.  , 'yearly'  ,  ''      ,   ''
+
+   cn_dir      = './'      !  root directory for the location of the bulk files
+   ln_ref_apr  = .false.   !  ref. pressure: global mean Patm (T) or a constant (F)
+/
+!-----------------------------------------------------------------------
+&namsbc_ssr    !   surface boundary condition : sea surface restoring
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_sst      = 'sst_data'  ,        24         ,  'sst'    ,    .false.   , .false., 'yearly'  , ''       , ''
+   sn_sss      = 'sss_data'  ,        -1         ,  'sss'    ,    .true.    , .true. , 'yearly'  , ''       , ''
+
+   cn_dir      = './'      !  root directory for the location of the runoff files
+   nn_sstr     =     0     !  add a retroaction term in the surface heat       flux (=1) or not (=0)
+   nn_sssr     =     2     !  add a damping     term in the surface freshwater flux (=2) 
+                           !  or to SSS only (=1) or no damping term (=0)
+   rn_dqdt     =   -40.    !  magnitude of the retroaction on temperature   [W/m2/K]
+   rn_deds     =  -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
+!-----------------------------------------------------------------------
+   rn_cloud    =    0.06   !  cloud correction to snow and ice albedo 
+   rn_albice   =    0.53   !  albedo of melting ice in the arctic and antarctic
+   rn_alphd    =    0.80   !  coefficients for linear interpolation used to
+   rn_alphc    =    0.65   !  compute albedo between two extremes values 
+   rn_alphdi   =    0.72   !  (Pyane, 1972)
+/
+
+!!======================================================================
+!!               ***  Lateral boundary condition  ***
+!!======================================================================
+!!   namlbc        lateral momentum boundary condition
+!!   namcla        cross land advection
+!!   namobc        open boundaries parameters                           ("key_obc")
+!!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
+!!   nambdy        Unstructured open boundaries                         ("key_bdy")
+!!   namtide       Tidal forcing at open boundaries                     ("key_bdy_tides")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namlbc        !   lateral momentum boundary condition
+!-----------------------------------------------------------------------
+   rn_shlat    =    2.     !  shlat = 0  !  0 < shlat < 2  !  shlat = 2  !  2 < shlat
+                           !  free slip  !   partial slip  !   no slip   ! strong slip
+   ln_vorlat   = .false.   !  consistency of vorticity boundary condition with analytical eqs.
+/
+!-----------------------------------------------------------------------
+&namcla        !   cross land advection
+!-----------------------------------------------------------------------
+   nn_cla      =    0      !  advection between 2 ocean pts separates by land
+/
+!-----------------------------------------------------------------------
+&namobc        !   open boundaries parameters                           ("key_obc")
+!-----------------------------------------------------------------------
+   ln_obc_clim = .false.   !  climatological obc data files (T) or not (F)
+   ln_vol_cst  = .true.    !  impose the total volume conservation (T) or not (F)
+   ln_obc_fla  = .false.   !  Flather open boundary condition 
+   nn_obcdta   =    1      !  = 0 the obc data are equal to the initial state
+                           !  = 1 the obc data are read in 'obc.dta' files
+   cn_obcdta   = 'annual'  !  set to annual if obc datafile hold 1 year of data
+                           !  set to monthly if obc datafile hold 1 month of data
+   rn_dpein    =    1.     !  damping time scale for inflow at east  open boundary
+   rn_dpwin    =    1.     !     -           -         -       west    -      -
+   rn_dpnin    =    1.     !     -           -         -       north   -      -
+   rn_dpsin    =    1.     !     -           -         -       south   -      -
+   rn_dpeob    = 3000.     !  time relaxation (days) for the east  open boundary
+   rn_dpwob    =   15.     !     -           -         -     west    -      -
+   rn_dpnob    = 3000.     !     -           -         -     north   -      -
+   rn_dpsob    =   15.     !     -           -         -     south   -      -
+   rn_volemp   =    1.     !  = 0 the total volume change with the surface flux (E-P-R)
+                           !  = 1 the total volume remains constant
+/
+!-----------------------------------------------------------------------
+&namagrif      !  AGRIF zoom                                            ("key_agrif")
+!-----------------------------------------------------------------------
+   nn_cln_update =    3    !  baroclinic update frequency
+   ln_spc_dyn    = .true.  !  use 0 as special value for dynamics
+   rn_sponge_tra = 2880.   !  coefficient for tracer   sponge layer [m2/s]
+   rn_sponge_dyn = 2880.   !  coefficient for dynamics sponge layer [m2/s]
+/
+!-----------------------------------------------------------------------
+&nambdy        !  unstructured open boundaries                          ("key_bdy")
+!-----------------------------------------------------------------------
+    nb_bdy = 1                            !  number of open boundary sets       
+    ln_coords_file = .true.               !  =T : read bdy coordinates from file
+    cn_coords_file = 'coordinates.bdy.nc' !  bdy coordinates files
+    ln_mask_file = .false.                !  =T : read mask from file
+    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.)
+    nn_dyn2d      =  2                    !  boundary conditions for barotropic fields
+    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state
+                                          !  = 1, bdy data are read in 'bdydata   .nc' files
+                                          !  = 2, use tidal harmonic forcing data from files
+                                          !  = 3, use external data AND tidal harmonic forcing
+    nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities
+    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_tra        =  1                    !  boundary conditions for T and S
+    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state
+                           !  = 1, bdy data are read in 'bdydata   .nc' files
+    nn_rimwidth  = 10                      !  width of the relaxation zone
+    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter)
+    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero
+/
+!-----------------------------------------------------------------------
+&nambdy_dta      !  open boundaries - external data           ("key_bdy")
+!-----------------------------------------------------------------------
+!              !   file name    ! frequency (hours) !  variable  ! time interpol. !  clim   ! 'yearly'/ ! weights  ! rotation !
+!              !                !  (if <0  months)  !    name    !    (logical)   !  (T/F)  ! 'monthly' ! filename ! pairing  !
+   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'  ,    ''    ,   ''
+   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
+    tide_cpt(1)   ='Q1'  !  names of tidal components used
+    tide_cpt(2)   ='O1'  !  names of tidal components used
+    tide_cpt(3)   ='P1'  !  names of tidal components used
+    tide_cpt(4)   ='S1'  !  names of tidal components used
+    tide_cpt(5)   ='K1'  !  names of tidal components used
+    tide_cpt(6)   ='2N2' !  names of tidal components used
+    tide_cpt(7)   ='MU2' !  names of tidal components used
+    tide_cpt(8)   ='N2'  !  names of tidal components used
+    tide_cpt(9)   ='NU2' !  names of tidal components used
+    tide_cpt(10)   ='M2'  !  names of tidal components used
+    tide_cpt(11)   ='L2'  !  names of tidal components used
+    tide_cpt(12)   ='T2'  !  names of tidal components used
+    tide_cpt(13)   ='S2'  !  names of tidal components used
+    tide_cpt(14)   ='K2'  !  names of tidal components used
+    tide_cpt(15)   ='M4'  !  names of tidal components used
+    tide_speed(1)   = 13.398661 !  phase speeds of tidal components (deg/hour)
+    tide_speed(2)   = 13.943036 !  phase speeds of tidal components (deg/hour)
+    tide_speed(3)   = 14.958932 !  phase speeds of tidal components (deg/hour)
+    tide_speed(4)   = 15.000001 !  phase speeds of tidal components (deg/hour)
+    tide_speed(5)   = 15.041069 !  phase speeds of tidal components (deg/hour)
+    tide_speed(6)   = 27.895355 !  phase speeds of tidal components (deg/hour)
+    tide_speed(7)   = 27.968210 !  phase speeds of tidal components (deg/hour)
+    tide_speed(8)   = 28.439730 !  phase speeds of tidal components (deg/hour)
+    tide_speed(9)   = 28.512585 !  phase speeds of tidal components (deg/hour)
+    tide_speed(10)   = 28.984106 !  phase speeds of tidal components (deg/hour)
+    tide_speed(11)   = 29.528479 !  phase speeds of tidal components (deg/hour)
+    tide_speed(12)   = 29.958935 !  phase speeds of tidal components (deg/hour)
+    tide_speed(13)   = 30.000002 !  phase speeds of tidal components (deg/hour)
+    tide_speed(14)   = 30.082138 !  phase speeds of tidal components (deg/hour)
+    tide_speed(15)   = 57.968212 !  phase speeds of tidal components (deg/hour)
+    ln_tide_date = .true.               !  adjust tidal harmonics for start date of run
+/
+!!======================================================================
+!!                 ***  Bottom boundary condition  ***
+!!======================================================================
+!!   nambfr        bottom friction
+!!   nambbc        bottom temperature boundary condition               
+!!   nambbl        bottom boundary layer scheme                         ("key_trabbl")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nambfr        !   bottom friction
+!-----------------------------------------------------------------------
+   nn_bfr      =    1      !  type of bottom friction :   = 0 : free slip,  = 1 : linear friction
+                           !                              = 2 : nonlinear friction
+   rn_bfri1    =    4.e-4  !  bottom drag coefficient (linear case)
+   rn_bfri2    =    1.e-3  !  bottom drag coefficient (non linear case)
+   rn_bfeb2    =    2.5e-3 !  bottom turbulent kinetic energy background  (m2/s2)
+   ln_bfr2d    = .false.   !  horizontal variation of the bottom friction coef (read a 2D mask file )
+   rn_bfrien   =    50.    !  local multiplying factor of bfr (ln_bfr2d=T)
+   ln_bfrimp   = .true.    !  implicit bottom friction (requires ln_zdfexp = .false. if true)
+/
+!-----------------------------------------------------------------------
+&nambbc        !   bottom temperature boundary condition
+!-----------------------------------------------------------------------
+   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom
+   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux 
+                           !     = 1 constant flux
+                           !     = 2 variable flux (read in geothermal_heating.nc in mW/m2) 
+   rn_geoflx_cst = 86.4e-3 !  Constant value of geothermal heat flux [W/m2]
+/
+!-----------------------------------------------------------------------
+&nambbl        !   bottom boundary layer scheme
+!-----------------------------------------------------------------------
+   nn_bbl_ldf  =  1      !  diffusive bbl (=1)   or not (=0)
+   nn_bbl_adv  =  0      !  advective bbl (=1/2) or not (=0)
+   rn_ahtbbl   =  1000.  !  lateral mixing coefficient in the bbl  [m2/s]
+   rn_gambbl   =  10.    !  advective bbl coefficient                 [s]
+/
+
+!!======================================================================
+!!                        Tracer (T & S ) namelists
+!!======================================================================
+!!   nameos        equation of state
+!!   namtra_adv    advection scheme
+!!   namtra_ldf    lateral diffusion scheme
+!!   namtra_dmp    T & S newtonian damping                        
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&nameos        !   ocean physical parameters
+!-----------------------------------------------------------------------
+   nn_eos      =   0       !  type of equation of state and Brunt-Vaisala frequency
+                           !     = 0, UNESCO (formulation of Jackett and McDougall (1994) and of McDougall (1987) )
+                           !     = 1, linear: rho(T)   = rau0 * ( 1.028 - ralpha * T )
+                           !     = 2, linear: rho(T,S) = rau0 * ( rbeta * S - ralpha * T )
+   rn_alpha    =   2.0e-4  !  thermal expension coefficient (nn_eos= 1 or 2)
+   rn_beta     =   7.7e-4  !  saline  expension coefficient (nn_eos= 2)
+/
+!-----------------------------------------------------------------------
+&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
+/
+!----------------------------------------------------------------------------------
+&namtra_ldf    !   lateral diffusion scheme for tracers
+!----------------------------------------------------------------------------------
+   !                       !  Operator type:
+   ln_traldf_lap    =  .true.   !  laplacian operator
+   ln_traldf_bilap  =  .false.  !  bilaplacian operator
+   !                       !  Direction of action:
+   ln_traldf_level  =  .false.  !  iso-level
+   ln_traldf_hor    =  .false.  !  horizontal (geopotential)   (needs "key_ldfslp" when ln_sco=T)
+   ln_traldf_iso    =  .true.   !  iso-neutral                 (needs "key_ldfslp")
+   !		       	   !  Griffies parameters              (all need "key_ldfslp")
+   ln_traldf_grif   =  .false.  !  use griffies triads
+   ln_traldf_gdia   =  .false.  !  output griffies eddy velocities
+   ln_triad_iso     =  .false.  !  pure lateral mixing in ML
+   ln_botmix_grif   =  .false.  !  lateral mixing on bottom
+   !                       !  Coefficients
+   ! Eddy-induced (GM) advection always used with Griffies; otherwise needs "key_traldf_eiv"
+   ! Value rn_aeiv_0 is ignored unless = 0 with Held-Larichev spatially varying aeiv
+   !                                  (key_traldf_c2d & key_traldf_eiv & key_orca_r2, _r1 or _r05)
+   rn_aeiv_0        =  2000.    !  eddy induced velocity coefficient [m2/s]
+   rn_aht_0         =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtb_0        =     0.    !  background eddy diffusivity for ldf_iso [m2/s]
+   !                                           (normally=0; not used with Griffies)
+/
+!-----------------------------------------------------------------------
+&namtra_dmp    !   tracer: T & S newtonian damping                  
+!-----------------------------------------------------------------------
+   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F)
+   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp     =    0      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf     =   50.     !  surface time scale of damping   [days]
+   rn_bot      =  360.     !  bottom  time scale of damping   [days]
+   rn_dep      =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file     =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+
+!!======================================================================
+!!                      ***  Dynamics namelists  ***
+!!======================================================================
+!!   namdyn_adv    formulation of the momentum advection
+!!   namdyn_vor    advection scheme
+!!   namdyn_hpg    hydrostatic pressure gradient
+!!   namdyn_spg    surface pressure gradient                            (CPP key only)
+!!   namdyn_ldf    lateral diffusion scheme
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namdyn_adv    !   formulation of the momentum advection
+!-----------------------------------------------------------------------
+   ln_dynadv_vec = .true.  !  vector form (T) or flux form (F)  
+   ln_dynadv_cen2= .false. !  flux form - 2nd order centered scheme
+   ln_dynadv_ubs = .false. !  flux form - 3rd order UBS      scheme 
+/  
+!-----------------------------------------------------------------------
+&namdyn_vor    !   option of physics/algorithm (not control by CPP keys)
+!-----------------------------------------------------------------------
+   ln_dynvor_ene = .false. !  enstrophy conserving scheme  
+   ln_dynvor_ens = .false. !  energy conserving scheme    
+   ln_dynvor_mix = .false. !  mixed scheme               
+   ln_dynvor_een = .true.  !  energy & enstrophy scheme  
+/
+!-----------------------------------------------------------------------
+&namdyn_hpg    !   Hydrostatic pressure gradient option
+!-----------------------------------------------------------------------
+   ln_hpg_zco  = .false.   !  z-coordinate - full steps                   
+   ln_hpg_zps  = .true.    !  z-coordinate - partial steps (interpolation)
+   ln_hpg_sco  = .false.   !  s-coordinate (standard jacobian formulation)
+   ln_hpg_djc  = .false.   !  s-coordinate (Density Jacobian with Cubic polynomial)
+   ln_hpg_prj  = .false.   !  s-coordinate (Pressure Jacobian scheme)
+   ln_dynhpg_imp = .false. !  time stepping: semi-implicit time scheme  (T)
+                                 !           centered      time scheme  (F)
+/
+!-----------------------------------------------------------------------
+!namdyn_spg    !   surface pressure gradient   (CPP key only)
+!-----------------------------------------------------------------------
+!                          !  explicit free surface                     ("key_dynspg_exp")
+!                          !  filtered free surface                     ("key_dynspg_flt")
+!                          !  split-explicit free surface               ("key_dynspg_ts")
+
+!-----------------------------------------------------------------------
+&namdyn_ldf    !   lateral diffusion on momentum
+!-----------------------------------------------------------------------
+   !                       !  Type of the operator : 
+   ln_dynldf_lap    =  .true.   !  laplacian operator         
+   ln_dynldf_bilap  =  .false.  !  bilaplacian operator    
+   !                       !  Direction of action  : 
+   ln_dynldf_level  =  .false.  !  iso-level               
+   ln_dynldf_hor    =  .true.   !  horizontal (geopotential)            (require "key_ldfslp" in s-coord.)
+   ln_dynldf_iso    =  .false.  !  iso-neutral                          (require "key_ldfslp")
+   !                       !  Coefficient
+   rn_ahm_0_lap     = 40000.    !  horizontal laplacian eddy viscosity   [m2/s]
+   rn_ahmb_0        =     0.    !  background eddy viscosity for ldf_iso [m2/s]
+   rn_ahm_0_blp     =     0.    !  horizontal bilaplacian eddy viscosity [m4/s] 
+/
+!-----------------------------------------------------------------------
+&namdta_dyn        !   offline dynamics read in files                ("key_offline")
+!-----------------------------------------------------------------------
+!            !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!            !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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            , 'sowaflcd' ,  .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            , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''
+   sn_vwd  = 'dyna_grid_V' ,    120            , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''
+   sn_wwd  = 'dyna_grid_W' ,    120            , 'vovecrtz' ,  .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'  , ''       , ''
+   sn_eiw  = 'dyna_grid_W' ,    120            , 'soleaeiw' ,  .true.    , .true. ,   'yearly'  , ''       , ''
+!
+   cn_dir      = './'      !  root directory for the location of the dynamical files
+   ln_degrad   =  .false.  !  flag for degradation -                requires ("key_degrad")
+   ln_dynwzv   =  .true.   !  computation of vertical velocity instead of using the one read in file
+   ln_dynbbl   =  .true.   !  bbl coef are in files, so read them - requires ("key_trabbl")
+/
+!!======================================================================
+!!             Tracers & Dynamics vertical physics namelists
+!!======================================================================
+!!    namzdf        vertical physics
+!!    namzdf_ric    richardson number dependent vertical mixing         ("key_zdfric")
+!!    namzdf_tke    TKE dependent vertical mixing                       ("key_zdftke")
+!!    namzdf_kpp    KPP dependent vertical mixing                       ("key_zdfkpp")
+!!    namzdf_ddm    double diffusive mixing parameterization            ("key_zdfddm")
+!!    namzdf_tmx    tidal mixing parameterization                       ("key_zdftmx")
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namzdf        !   vertical physics
+!-----------------------------------------------------------------------
+   rn_avm0     =   1.2e-4  !  vertical eddy viscosity   [m2/s]          (background Kz if not "key_zdfcst")
+   rn_avt0     =   1.2e-5  !  vertical eddy diffusivity [m2/s]          (background Kz if not "key_zdfcst")
+   nn_avb      =    0      !  profile for background avt & avm (=1) or not (=0)
+   nn_havtb    =    0      !  horizontal shape for avtb (=1) or not (=0)
+   ln_zdfevd   = .true.    !  enhanced vertical diffusion (evd) (T) or not (F)
+   nn_evdm     =    0      !  evd apply on tracer (=0) or on tracer and momentum (=1)
+   rn_avevd    =  100.     !  evd mixing coefficient [m2/s]
+   ln_zdfnpc   = .false.   !  Non-Penetrative 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 mized 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]
+   nn_mxl      =   2       !  mixing length: = 0 bounded by the distance to surface and bottom
+                           !                 = 1 bounded by the local vertical scale factor
+                           !                 = 2 first vertical derivative of mixing length bounded by 1
+                           !                 = 3 as =2 with distinct disspipative an mixing length scale
+   nn_pdl      =   1       !  Prandtl number function of richarson number (=1, avt=pdl(Ri)*avm) or not (=0, avt=avm)
+   ln_mxl0     = .true.    !  surface mixing length scale = F(wind stress) (T) or not (F)
+   rn_mxl0     =   0.04    !  surface  buoyancy lenght scale minimum value
+   ln_lc       = .true.    !  Langmuir cell parameterisation (Axell 2002)
+   rn_lc       =   0.15    !  coef. associated to Langmuir cells
+   nn_etau     =   1       !  penetration of tke below the mixed layer (ML) due to internal & intertial waves
+                           !        = 0 no penetration
+                           !        = 1 add a tke source below the ML
+                           !        = 2 add a tke source just at the base of the ML
+                           !        = 3 as = 1 applied on HF part of the stress    ("key_coupled")
+   rn_efr      =   0.05    !  fraction of surface tke value which penetrates below the ML (nn_etau=1 or 2)
+   nn_htau     =   1       !  type of exponential decrease of tke penetration below the ML
+                           !        = 0  constant 10 m length scale
+                           !        = 1  0.5m at the equator to 30m poleward of 40 degrees
+/
+!------------------------------------------------------------------------
+&namzdf_kpp    !   K-Profile Parameterization dependent vertical mixing  ("key_zdfkpp", and optionally:
+!------------------------------------------------------------------------ "key_kppcustom" or "key_kpplktb")
+   ln_kpprimix = .true.    !  shear instability mixing 
+   rn_difmiw   =  1.0e-04  !  constant internal wave viscosity [m2/s]
+   rn_difsiw   =  0.1e-04  !  constant internal wave diffusivity [m2/s]
+   rn_riinfty  =  0.8      !  local Richardson Number limit for shear instability
+   rn_difri    =  0.0050   !  maximum shear mixing at Rig = 0    [m2/s]
+   rn_bvsqcon  = -0.01e-07 !  Brunt-Vaisala squared for maximum convection [1/s2] 
+   rn_difcon   =  1.       !  maximum mixing in interior convection [m2/s] 
+   nn_avb      =  0        !  horizontal averaged (=1) or not (=0) on avt and amv
+   nn_ave      =  1        !  constant (=0) or profile (=1) background on avt
+/
+!-----------------------------------------------------------------------
+&namzdf_gls                !   GLS vertical diffusion                   ("key_zdfgls")
+!-----------------------------------------------------------------------
+   rn_emin       = 1.e-6   !  minimum value of e   [m2/s2]
+   rn_epsmin     = 1.e-12  !  minimum value of eps [m2/s3]
+   ln_length_lim = .true.  !  limit on the dissipation rate under stable stratification (Galperin et al., 1988)
+   rn_clim_galp  = 0.53    !  galperin limit
+   ln_crban      = .true.  !  Use Craig & Banner (1994) surface wave mixing parametrisation
+   ln_sigpsi     = .true.  !  Activate or not Burchard 2001 mods on psi schmidt number in the wb case
+   rn_crban      = 100.    !  Craig and Banner 1994 constant for wb tke flux
+   rn_charn      = 70000.  !  Charnock constant for wb induced roughness length
+   nn_tkebc_surf =   1     !  surface tke condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_tkebc_bot  =   1     !  bottom tke condition (0/1=Dir/Neum)
+   nn_psibc_surf =   1     !  surface psi condition (0/1/2=Dir/Neum/Dir Mellor-Blumberg)
+   nn_psibc_bot  =   1     !  bottom psi condition (0/1=Dir/Neum)
+   nn_stab_func  =   2     !  stability function (0=Galp, 1= KC94, 2=CanutoA, 3=CanutoB)
+   nn_clos       =   1     !  predefined closure type (0=MY82, 1=k-eps, 2=k-w, 3=Gen)
+/
+!-----------------------------------------------------------------------
+&namzdf_ddm    !   double diffusive mixing parameterization             ("key_zdfddm")
+!-----------------------------------------------------------------------
+   rn_avts     = 1.e-4     !  maximum avs (vertical mixing on salinity)
+   rn_hsbfr    = 1.6       !  heat/salt buoyancy flux ratio
+/
+!-----------------------------------------------------------------------
+&namzdf_tmx    !   tidal mixing parameterization                        ("key_zdftmx")
+!-----------------------------------------------------------------------
+   rn_htmx     = 500.      !  vertical decay scale for turbulence (meters)
+   rn_n2min    = 1.e-8     !  threshold of the Brunt-Vaisala frequency (s-1)
+   rn_tfe      = 0.333     !  tidal dissipation efficiency
+   rn_me       = 0.2       !  mixing efficiency 
+   ln_tmx_itf  = .true.    !  ITF specific parameterisation
+   rn_tfe_itf  = 1.        !  ITF tidal dissipation efficiency
+/
+
+!!======================================================================
+!!                  ***  Miscellaneous namelists  ***
+!!======================================================================
+!!   nammpp            Massively Parallel Processing                    ("key_mpp_mpi)
+!!   namctl            Control prints & Benchmark
+!!   namsol            elliptic solver / island / free surface 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namsol        !   elliptic solver / island / free surface 
+!-----------------------------------------------------------------------
+   nn_solv     =      1    !  elliptic solver: =1 preconditioned conjugate gradient (pcg)
+                           !                   =2 successive-over-relaxation (sor)
+   nn_sol_arp  =      0    !  absolute/relative (0/1) precision convergence test
+   rn_eps      =  1.e-6    !  absolute precision of the solver
+   nn_nmin     =    300    !  minimum of iterations for the SOR solver
+   nn_nmax     =    800    !  maximum of iterations for the SOR solver
+   nn_nmod     =     10    !  frequency of test for the SOR solver
+   rn_resmax   =  1.e-10   !  absolute precision for the SOR solver
+   rn_sor      =  1.92     !  optimal coefficient for SOR solver (to be adjusted with the domain)
+/
+!-----------------------------------------------------------------------
+&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi)
+!-----------------------------------------------------------------------
+   cn_mpi_send =  'I'      !  mpi send/recieve type   ='S', 'B', or 'I' for standard send,
+                           !  buffer blocking send or immediate non-blocking sends, resp.
+   nn_buffer   =   0       !  size in bytes of exported buffer ('B' case), 0 no exportation
+   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   =    1      !  timing by routine activated (=1) creates timing.output file, or not (=0)
+/
+
+!!======================================================================
+!!                  ***  Diagnostics namelists  ***
+!!======================================================================
+!!   namnc4       netcdf4 chunking and compression settings             ("key_netcdf4")
+!!   namtrd       dynamics and/or tracer trends                         ("key_trddyn","key_trdtra","key_trdmld")
+!!   namflo       float parameters                                      ("key_float")
+!!   namptr       Poleward Transport Diagnostics
+!!   namhsb       Heat and salt budgets 
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namnc4        !   netcdf4 chunking and compression settings            ("key_netcdf4")
+!-----------------------------------------------------------------------
+   nn_nchunks_i=   4       !  number of chunks in i-dimension
+   nn_nchunks_j=   4       !  number of chunks in j-dimension
+   nn_nchunks_k=   31      !  number of chunks in k-dimension
+                           !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                           !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip   = .true.    !  (T) use netcdf4 chunking and compression
+                           !  (F) ignore chunking information and produce netcdf3-compatible files
+/
+!-----------------------------------------------------------------------
+&namtrd        !   diagnostics on dynamics and/or tracer trends         ("key_trddyn" and/or "key_trdtra")
+!              !       or mixed-layer trends or barotropic vorticity    ("key_trdmld" or     "key_trdvor")
+!-----------------------------------------------------------------------
+   nn_trd      = 365       !  time step frequency dynamics and tracers trends
+   nn_ctls     =   0       !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf      =   1.      !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   cn_trdrst_in      = "restart_mld"   ! suffix of ocean restart name (input)
+   cn_trdrst_out     = "restart_mld"   ! suffix of ocean restart name (output)
+   ln_trdmld_restart = .false.         !  restart for ML diagnostics
+   ln_trdmld_instant = .false.         !  flag to diagnose trends of instantantaneous or mean ML T/S
+/
+!-----------------------------------------------------------------------
+&namflo       !   float parameters                                      ("key_float")
+!-----------------------------------------------------------------------
+   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)
+/
+!-----------------------------------------------------------------------
+&namptr       !   Poleward Transport Diagnostic
+!-----------------------------------------------------------------------
+   ln_diaptr  = .false.    !  Poleward heat and salt transport (T) or not (F)
+   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions
+   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not 
+                           !  (orca configuration only, need input basins mask file named "subbasins.nc"
+   ln_ptrcomp = .true.     !  Add decomposition : overturning
+   nn_fptr    =  1         !  Frequency of ptr computation [time step]
+   nn_fwri    =  15        !  Frequency of ptr outputs [time step]
+/
+!-----------------------------------------------------------------------
+&namhsb       !  Heat and salt budgets 
+!-----------------------------------------------------------------------
+   ln_diahsb  = .false.    !  check the heat and salt budgets (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namdct        ! transports through sections
+!-----------------------------------------------------------------------
+    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
+/
+
+!!======================================================================
+!!            ***  Observation & Assimilation namelists ***
+!!======================================================================
+!!   namobs       observation and model comparison                      ('key_diaobs')
+!!   nam_asminc   assimilation increments                               ('key_asminc')
+!!======================================================================
+!
+!-----------------------------------------------------------------------
+&namobs       !  observation usage switch                               ('key_diaobs')
+!-----------------------------------------------------------------------
+   ln_t3d     = .false.    ! Logical switch for T profile observations         
+   ln_s3d     = .false.    ! Logical switch for S profile observations          
+   ln_ena     = .false.    ! Logical switch for ENACT insitu data set           
+   !                       !     ln_cor                  Logical switch for Coriolis insitu data set       
+   ln_profb   = .false.    ! Logical switch for feedback insitu data set     
+   ln_sla     = .false.    ! Logical switch for SLA observations               
+
+   ln_sladt   = .false.    ! Logical switch for AVISO SLA data              
+
+   ln_slafb   = .false.    ! Logical switch for feedback SLA data            
+                           !     ln_ssh                  Logical switch for SSH observations              
+
+   ln_sst     = .false.    ! Logical switch for SST observations              
+                           !     ln_reysst               Logical switch for Reynolds observations       
+                           !     ln_ghrsst               Logical switch for GHRSST observations          
+
+   ln_sstfb   = .false.    ! Logical switch for feedback SST data          
+                           !     ln_sss                  Logical switch for SSS observations              
+                           !     ln_seaice               Logical switch for Sea Ice observations        
+                           !     ln_vel3d                Logical switch for velocity observations         
+                           !     ln_velavcur             Logical switch for velocity daily av. cur.    
+                           !     ln_velhrcur             Logical switch for velocity high freq. cur.   
+                           !     ln_velavadcp            Logical switch for velocity daily av. ADCP  
+                           !     ln_velhradcp            Logical switch for velocity high freq. ADCP
+                           !     ln_velfb                Logical switch for feedback velocity data       
+                           !     ln_grid_global          Global distribtion of observations         
+                           !     ln_grid_search_lookup   Logical switch for obs grid search w/lookup table  
+                           !     grid_search_file        Grid search lookup file header 
+                           !     enactfiles              ENACT input observation file names 
+                           !     coriofiles              Coriolis input observation file name  
+   !                       ! profbfiles: Profile feedback input observation file name 
+   profbfiles = 'profiles_01.nc'
+                           !     ln_profb_enatim         Enact feedback input time setting switch    
+                           !     slafilesact             Active SLA input observation file name
+                           !     slafilespas             Passive SLA input observation file name 
+   !                       ! slafbfiles: Feedback SLA input observation file name 
+   slafbfiles = 'sla_01.nc'
+                           !     sstfiles                GHRSST input observation file name       
+   !                       ! sstfbfiles: Feedback SST input observation file name 
+   sstfbfiles = 'sst_01.nc' 'sst_02.nc' 'sst_03.nc' 'sst_04.nc' 'sst_05.nc'
+                           !     seaicefiles             Sea Ice input observation file name 
+                           !     velavcurfiles           Vel. cur. daily av. input file name  
+                           !     velhvcurfiles           Vel. cur. high freq. input file name  
+                           !     velavadcpfiles          Vel. ADCP daily av. input file name    
+                           !     velhvadcpfiles          Vel. ADCP high freq. input file name 
+                           !     velfbfiles              Vel. feedback input observation file name 
+                           !     dobsini                 Initial date in window YYYYMMDD.HHMMSS       
+                           !     dobsend                 Final date in window YYYYMMDD.HHMMSS         
+                           !     n1dint                  Type of vertical interpolation method        
+                           !     n2dint                  Type of horizontal interpolation method       
+                           !     ln_nea                  Rejection of observations near land switch    
+   nmsshc     = 0          ! MSSH correction scheme                         
+                           !     mdtcorr                 MDT  correction                               
+                           !     mdtcutoff               MDT cutoff for computed correction          
+   ln_altbias = .false.    ! Logical switch for alt bias                
+   ln_ignmis  = .true.     ! Logical switch for ignoring missing files   
+                           !     endailyavtypes   ENACT daily average types                    
+   ln_grid_global = .true.
+   ln_grid_search_lookup = .false.
+/ 
+!-----------------------------------------------------------------------
+&nam_asminc   !   assimilation increments                               ('key_asminc')
+!-----------------------------------------------------------------------
+    ln_bkgwri = .false.    !  Logical switch for writing out background state 
+    ln_trjwri = .false.    !  Logical switch for writing out state trajectory
+    ln_trainc = .false.    !  Logical switch for applying tracer increments
+    ln_dyninc = .false.    !  Logical switch for applying velocity increments
+    ln_sshinc = .false.    !  Logical switch for applying SSH increments 
+    ln_asmdin = .false.    !  Logical switch for Direct Initialization (DI)
+    ln_asmiau = .false.    !  Logical switch for Incremental Analysis Updating (IAU)
+    nitbkg    = 0          !  Timestep of background in [0,nitend-nit000-1]
+    nitdin    = 0          !  Timestep of background for DI in [0,nitend-nit000-1]
+    nitiaustr = 1          !  Timestep of start of IAU interval in [0,nitend-nit000-1]
+    nitiaufin = 15         !  Timestep of end of IAU interval in [0,nitend-nit000-1]
+    niaufn    = 0          !  Type of IAU weighting function
+    nittrjfrq = 0          !  Frequency of trajectory output for 4D-VAR
+    ln_salfix = .false.    !  Logical switch for ensuring that the sa > salfixmin
+    salfixmin = -9999      !  Minimum salinity after applying the increments
+    nn_divdmp = 0          !  Number of iterations of divergence damping operator
+/
+!-----------------------------------------------------------------------
+&namsbc_wave   ! External fields from wave model
+!-----------------------------------------------------------------------
+!              !  file name  ! frequency (hours) ! variable  ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !             !  (if <0  months)  !   name    !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_cdg      =  'cdg_wave' ,        1          , 'drag_coeff' , .true.   , .false. , 'daily'  ,''         , ''
+!
+   cn_dir_cdg  = './'  !  root directory for the location of drag coefficient files
+/
+!-----------------------------------------------------------------------
+&namdyn_nept  !   Neptune effect (simplified: lateral and vertical diffusions removed)
+!-----------------------------------------------------------------------
+   ! Suggested lengthscale values are those of Eby & Holloway (1994) for a coarse model
+   ln_neptsimp       = .false.  ! yes/no use simplified neptune
+
+   ln_smooth_neptvel = .false.  ! yes/no smooth zunep, zvnep
+   rn_tslse          =  1.2e4   ! value of lengthscale L at the equator
+   rn_tslsp          =  3.0e3   ! value of lengthscale L at the pole
+   ! Specify whether to ramp down the Neptune velocity in shallow
+   ! water, and if so the depth range controlling such ramping down
+   ln_neptramp       = .false.  ! ramp down Neptune velocity in shallow water
+   rn_htrmin         =  100.0   ! min. depth of transition range
+   rn_htrmax         =  200.0   ! max. depth of transition range
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_pisces	(revision 3437)
@@ -0,0 +1,230 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! PISCES  :    1  - air-sea exchange                         (nampisext)
+!! namelists    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)
+!!              9  - parameters for Kriest parameterization   (nampiskrp, nampiskrs)
+!!              10 - additional 2D/3D  diagnostics            (nampisdia)
+!!              11 - Damping                                  (nampisdmp)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&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 !
+!              !              !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_patm     = 'presatm'    ,     -1            , 'patm'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   cn_dir      = './'     !  root directory for the location of the dynamical files
+!
+   ln_presatm  = .true.   ! constant atmopsheric pressure (F) or from a file (T)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisbio     !   biological parameters
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nrdttrc    =  4        ! 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     =  30.      ! Big particles sinking speed
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampislim     !   parameters for nutrient limitations
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   conc0      =  1.e-6    ! Phosphate half saturation
+   conc1      =  8E-6     ! Phosphate half saturation for diatoms
+   conc2      =  1E-9     ! Iron half saturation for phyto
+   conc2m     =  3E-9     ! Max iron half saturation for phyto
+   conc3      =  3E-9     ! Iron half saturation for diatoms
+   conc3m     =  8E-9     ! Maxi iron half saturation for diatoms
+   xsizedia   =  1.E-6    ! Minimum size criteria for diatoms
+   xsizephy   =  1.E-6    ! Minimum size criteria for phyto
+   concnnh4   =  1.E-7    ! NH4 half saturation for phyto
+   concdnh4   =  8.E-7    ! NH4 half saturation for diatoms
+   xksi1      =  2.E-6    ! half saturation constant for Si uptake
+   xksi2      =  3.33E-6  ! half saturation constant for Si/C
+   xkdoc      =  417.E-6  ! half-saturation constant of DOC remineralization
+   concfebac  =  1.E-11   ! Half-saturation for Fe limitation of Bacteria
+   qnfelim    =  7.E-6    ! Optimal quota of phyto
+   qdfelim    =  7.E-6    ! Optimal quota of diatoms
+   caco3r     =  0.16     ! mean rain ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisprod     !   parameters for phytoplankton growth
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   pislope    =  2.       ! P-I slope
+   pislope2   =  2.       ! P-I slope  for diatoms
+   excret     =  0.05     ! excretion ratio of phytoplankton
+   excret2    =  0.05     ! excretion ratio of diatoms
+   ln_newprod =  .true.  ! Enable new parame. of production (T/F) 
+   bresp      =  0.00333  ! Basal respiration rate
+   chlcnm     =  0.033    ! Minimum Chl/C in nanophytoplankton
+   chlcdm     =  0.05     ! Minimum Chl/C in diatoms
+   chlcmin    =  0.0033   ! Maximum Chl/c in phytoplankton
+   fecnm      =  40E-6    ! Maximum Fe/C in nanophytoplankton
+   fecdm      =  40E-6    ! Minimum Fe/C in diatoms
+   grosip     =  0.151    ! mean Si/C ratio
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismort     !   parameters for phytoplankton sinks
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   wchl       =  0.001    ! quadratic mortality of phytoplankton
+   wchld      =  0.02     ! maximum quadratic mortality of diatoms
+   mprat      =  0.01     ! phytoplankton mortality rate
+   mprat2     =  0.01     ! Diatoms mortality rate
+   mpratm     =  0.01     ! Phytoplankton minimum mortality rate
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismes     !   parameters for mesozooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part2      =  0.75    ! part of calcite not dissolved in mesozoo guts
+   grazrat2   =  0.7      ! maximal mesozoo grazing rate
+   resrat2    =  0.005    ! exsudation rate of mesozooplankton
+   mzrat2     =  0.03     ! mesozooplankton mortality rate
+   xprefc     =  1.       ! zoo preference for phyto
+   xprefp     =  0.3      ! zoo preference for POC
+   xprefz     =  1.       ! zoo preference for zoo
+   xprefpoc   =  0.3      ! zoo preference for poc
+   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   =  2E-7    ! Food threshold for grazing
+   xkgraz2    =  20.E-6   ! half sturation constant for meso grazing
+   epsher2    =  0.3      ! 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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiszoo     !   parameters for microzooplankton
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   part       =  0.5      ! part of calcite not dissolved in microzoo gutsa
+   grazrat    =  3.0      ! maximal zoo grazing rate
+   resrat     =  0.03     ! exsudation rate of zooplankton
+   mzrat      =  0.001    ! 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    =  2.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
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisrem     !   parameters for remineralization
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xremik    =  0.25      ! remineralization rate of DOC
+   xremip    =  0.025     ! remineralisation rate of POC
+   nitrif    =  0.05      ! NH4 nitrification rate
+   xsirem    =  0.003     ! remineralization rate of Si
+   xsiremlab =  0.025     ! fast remineralization rate of Si
+   xsilab    =  0.31      ! Fraction of labile biogenic silica
+   xlam1     =  0.005     ! scavenging rate of Iron
+   oxymin    =  1.E-6     ! Half-saturation constant for anoxia
+   ligand    =  0.6E-9    ! Ligands concentration
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiscal     !   parameters for Calcite chemistry
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   kdca       =  6.       ! calcite dissolution rate constant (1/time)
+   nca        =  1.       ! order of dissolution reaction (dimensionless)
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampissed     !   parameters for inputs deposition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !  file name        ! frequency (hours) ! variable   ! time interp. !  clim  ! 'yearly'/ ! weights  ! rotation !
+!              !                   !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   sn_dust     = 'dust.orca'       ,     -1            , 'dust'     ,  .true.      , .true. ,   'yearly'  , ''       , ''
+   sn_riverdic = 'river.orca'      ,    -12            , 'riverdic' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_riverdoc = 'river.orca'      ,    -12            , 'riverdoc' ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ndepo    = 'ndeposition.orca',    -12            , 'ndep'     ,  .false.     , .true. ,   'yearly'  , ''       , ''
+   sn_ironsed  = 'bathy.orca'      ,    -12            , 'bathy'    ,  .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_river    =  .false.   ! boolean for river input of nutrients
+   ln_ndepo    =  .true.   ! boolean for atmospheric deposition of N
+   ln_ironsed  =  .true.   ! boolean for Fe input from sediments
+   sedfeinput  =  1E-9     ! Coastal release of Iron
+   dustsolub   =  0.02     ! Solubility of the dust
+   wdust       =  2.0      ! Dust sinking speed
+   nitrfix     =  1E-7     ! Nitrogen fixation rate
+   diazolight  =  50.      ! Diazotrophs sensitivity to light (W/m2)
+   concfediaz  =  1.E-10   ! Diazotrophs half-saturation Cste for Iron
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrp     !   Kriest parameterization : parameters     "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_eta      = 1.17    ! Sinking  exponent
+   xkr_zeta     = 2.28    ! N content exponent
+   xkr_mass_min = 0.0002  ! Minimum mass for Aggregates
+   xkr_mass_max = 1.      ! Maximum mass for Aggregates
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampiskrs     !   Kriest parameterization : size classes  "key_kriest"
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   xkr_sfact    = 942.    ! Sinking factor
+   xkr_stick    = 0.5     ! Stickiness
+   xkr_nnano    = 2.337   ! Nbr of cell in nano size class
+   xkr_ndiat    = 3.718   ! Nbr of cell in diatoms size class
+   xkr_nmeso    = 7.147   ! Nbr of cell in mesozoo size class
+   xkr_naggr    = 9.877   ! Nbr of cell in aggregates  size class
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdia     !   additional 2D/3D tracers diagnostics 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+!              !    name   !           title of the field          !     units      !
+!              !           !                                       !                !  
+   pisdia2d(1)  = 'Cflx     ' , 'DIC flux                          ',  'molC/m2/s    '
+   pisdia2d(2)  = 'Oflx     ' , 'Oxygen flux                       ',  'molC/m2/s    '
+   pisdia2d(3)  = 'Kg       ' , 'Gas transfer                      ',  'mol/m2/s/uatm'
+   pisdia2d(4)  = 'Delc     ' , 'Delta CO2                         ',  'uatm         '
+   pisdia2d(5)  = 'PMO      ' , 'POC export                        ',  'molC/m2/s    '
+   pisdia2d(6)  = 'PMO2     ' , 'GOC export                        ',  'molC/m2/s    '
+   pisdia2d(7)  = 'ExpFe1   ' , 'Nano iron export                  ',  'molFe/m2/s   '
+   pisdia2d(8)  = 'ExpFe2   ' , 'Diatoms iron export               ',  'molFe/m2/s   '
+   pisdia2d(9)  = 'ExpSi    ' , 'Silicate export                   ',  'molSi/m2/s   '
+   pisdia2d(10) = 'ExpCaCO3 ' , 'Calcite export                    ',  'molC/m2/s    '
+   pisdia2d(11) = 'heup     ' , 'euphotic layer depth              ',  'm            '
+   pisdia2d(12) = 'Fedep    ' , 'Iron dep                          ',  'molFe/m2/s   '
+   pisdia2d(13) = 'Nfix     ' , 'Nitrogen Fixation                 ',  'molN/m2/s    '
+   pisdia3d(1)  = 'PH       ' , 'PH                                ',  '-            '
+   pisdia3d(2)  = 'CO3      ' , 'Bicarbonates                      ',  'mol/l        '
+   pisdia3d(3)  = 'CO3sat   ' , 'CO3 saturation                    ',  'mol/l        '
+   pisdia3d(4)  = 'PAR      ' , 'light penetration                 ',  'W/m2         '
+   pisdia3d(5)  = 'PPPHY    ' , 'Primary production of nanophyto   ',  'molC/m3/s    '
+   pisdia3d(6)  = 'PPPHY2   ' , 'Primary production of diatoms     ',  'molC/m3/s    '
+   pisdia3d(7)  = 'PPNEWN   ' , 'New Primary production of nano    ',  'molC/m3/s    '
+   pisdia3d(8)  = 'PPNEWD   ' , 'New Primary production of diat    ',  'molC/m3/s    '
+   pisdia3d(9)  = 'PBSi     ' , 'Primary production of Si diatoms  ',  'molSi/m3/s   '
+   pisdia3d(10) = 'PFeN     ' , 'Primary production of nano iron   ',  'molFe/m3/s   '
+   pisdia3d(11) = 'PFeD     ' , 'Primary production of diatoms iron',  'molFe/m3/s   '
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampisdmp     !  Damping 
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_pisdmp    =  .true.     !  Relaxation fo some tracers to a mean value
+   nn_pisdmp    =  1460       !  Frequency of Relaxation 
+/
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&nampismass     !  Mass conservation
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   ln_check_mass =  .false.    !  Check mass conservation
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist_top	(revision 3437)
@@ -0,0 +1,146 @@
+!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!! NEMO/TOP1 :  1 - tracer definition                     (namtrc    )
+!!              2 - tracer data initialisation            (namtrc_dta)
+!!              3 - tracer advection                      (namtrc_adv)
+!!              4 - tracer lateral diffusion              (namtrc_ldf)
+!!              5 - tracer vertical physics               (namtrc_zdf)
+!!              6 - tracer newtonian damping              (namtrc_dmp)
+!!              7 - dynamical tracer trends               (namtrc_trd)
+!!              8 - tracer output diagonstics             (namtrc_dia)
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
+&namtrc     !   tracers definition
+!,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+   nn_dttrc      =  1        !  time step frequency for passive sn_tracers      
+   nn_writetrc   =  1460     !  time step frequency for sn_tracer outputs
+   ln_rsttr      = .false.   !  start from a restart file (T) or not (F)
+   nn_rsttr      =   0       !  restart control = 0 initial time step is not compared to the restart file value
+                             !                  = 1 do not use the value in the restart file
+                             !                  = 2 calendar parameters read in the restart file
+   cn_trcrst_in  = "restart_trc"   !  suffix of pass. sn_tracer restart name (input)
+   cn_trcrst_out = "restart_trc"   !  suffix of pass. sn_tracer restart name (output)
+   ln_trcdta     =   .true.  !  Initialisation from data input file (T) or not (F)
+   ln_trcdmp     =  .false.  !  add a damping termn (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 !
+!                !                          !  (if <0  months)  !   name     !   (logical)  !  (T/F) ! 'monthly' ! filename ! pairing  !
+   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'  , ''       , ''
+!
+   cn_dir        =  './'      !  root directory for the location of the data files
+   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_cen2   =  .false.  !  2nd order centered scheme   
+   ln_trcadv_tvd    =  .false.  !  TVD scheme
+   ln_trcadv_muscl  =  .true.   !  MUSCL scheme
+   ln_trcadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries
+   ln_trcadv_ubs    =  .false.  !  UBS scheme
+   ln_trcadv_qck    =  .false.  !  QUICKEST scheme
+/
+!-----------------------------------------------------------------------
+&namtrc_ldf    !   lateral diffusion scheme for passive tracer 
+!-----------------------------------------------------------------------
+   ln_trcldf_diff   =  .true.   !  performs lateral diffusion (T) or not (F)
+!                               !  Type of the operator : 
+   ln_trcldf_lap    =  .true.   !     laplacian operator       
+   ln_trcldf_bilap  =  .false.  !     bilaplacian operator     
+                                !  Direction of action  :
+   ln_trcldf_level  =  .false.  !     iso-level                
+   ln_trcldf_hor    =  .false.  !     horizontal (geopotential)         (require "key_ldfslp" when ln_sco=T)
+   ln_trcldf_iso    =  .true.   !     iso-neutral                       (require "key_ldfslp")
+!                               !  Coefficient
+   rn_ahtrc_0       =  2000.    !  horizontal eddy diffusivity for tracers [m2/s]
+   rn_ahtrb_0       =     0.    !     background eddy diffusivity for ldf_iso [m2/s]
+/
+!-----------------------------------------------------------------------
+&namtrc_zdf        !   vertical physics
+!-----------------------------------------------------------------------
+   ln_trczdf_exp   =  .false.  !  split explicit (T) or implicit (F) time stepping
+   nn_trczdf_exp   =   3       !  number of sub-timestep for ln_trczdfexp=T
+/
+!-----------------------------------------------------------------------
+&namtrc_rad        !  treatment of negative concentrations 
+!-----------------------------------------------------------------------
+   ln_trcrad   =  .true.  !  artificially correct negative concentrations (T) or not (F)
+/
+!-----------------------------------------------------------------------
+&namtrc_dmp    !   passive tracer newtonian damping   
+!-----------------------------------------------------------------------
+   nn_hdmp_tr  =   -1      !  horizontal shape =-1, damping in Med and Red Seas only
+                           !                   =XX, damping poleward of XX degrees (XX>0)
+                           !                      + F(distance-to-coast) + Red and Med Seas
+   nn_zdmp_tr  =    1      !  vertical   shape =0    damping throughout the water column
+                           !                   =1 no damping in the mixing layer (kz  criteria)
+                           !                   =2 no damping in the mixed  layer (rho crieria)
+   rn_surf_tr  =   50.     !  surface time scale of damping   [days]
+   rn_bot_tr   =  360.     !  bottom  time scale of damping   [days]
+   rn_dep_tr   =  800.     !  depth of transition between rn_surf and rn_bot [meters]
+   nn_file_tr  =    0      !  create a damping.coeff NetCDF file (=1) or not (=0)
+/
+!-----------------------------------------------------------------------
+&namtrc_trd       !   diagnostics on tracer trends        ('key_trdtrc')
+!                          or mixed-layer trends          ('key_trdmld_trc')
+!----------------------------------------------------------------------
+   nn_trd_trc  =  1460      !  time step frequency and tracers trends
+   nn_ctls_trc =   0        !  control surface type in mixed-layer trends (0,1 or n<jpk)
+   rn_ucf_trc  =   1        !  unit conversion factor (=1 -> /seconds ; =86400. -> /day)
+   ln_trdmld_trc_restart = .false.  !  restart for ML diagnostics
+   ln_trdmld_trc_instant = .true.  !  flag to diagnose trends of instantantaneous or mean ML T/S
+   ln_trdtrc(1)  =   .true.
+   ln_trdtrc(2)  =   .true.
+   ln_trdtrc(23) =   .true.
+/
+!-----------------------------------------------------------------------
+&namtrc_dia       !   parameters for passive tracer additional diagnostics
+!----------------------------------------------------------------------
+   ln_diatrc     =  .true.   !  save additional diag. (T) or not (F)
+   nn_writedia   =  1460     !  time step frequency for diagnostics
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/xmlio_server.def	(revision 3437)
@@ -0,0 +1,35 @@
+! xmlio_server namelist
+!
+! using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+! using_oasis : .TRUE.(.FALSE.) if nemo is coupled through OASIS
+! client_id   : used only for OASIS, NEMO      id in the namecouple 
+! server_id   : used only for OASIS, io_server id in the namecouple
+!
+&coupling_param
+  using_server = .FALSE.
+  using_oasis  = .FALSE.
+  client_id    = 'nemo.x'
+  server_id    = 'ionemo'
+/
+
+! global_mpi_buffer_size: size in Mo of the MPI buffer used by the io_server
+&mpi_param
+  global_mpi_buffer_size = 512
+/  
+
+!!======================================================================
+!!   namnc4            netcdf4 chunking and compression settings
+!!======================================================================
+!-----------------------------------------------------------------------
+&namnc4         !  netcdf4 chunking and compression settings
+                !  (benign if "key_netcdf4" is not used)
+!-----------------------------------------------------------------------
+   nn_nchunks_i   =   4       !  number of chunks in i-dimension
+   nn_nchunks_j   =   4       !  number of chunks in j-dimension
+   nn_nchunks_k   =   31      !  number of chunks in k-dimension
+                              !  setting nn_nchunks_k = jpk will give a chunk size of 1 in the vertical which
+                              !  is optimal for postprocessing which works exclusively with horizontal slabs
+   ln_nc4zip      =   .TRUE.  !  (T) use netcdf4 chunking and compression
+                              !  (F) ignore chunking information and produce netcdf3-compatible files  
+/
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.card	(revision 3437)
@@ -0,0 +1,65 @@
+[Compatibility]
+libIGCM=1.0
+
+[UserChoices]
+OPA_NDT_DAY=4
+#==============================================================
+#-- Name of directory related to dynamical 
+#-- available directories are:  v3, cpl
+#-- NOTE: if you use your own directory you have to comment it
+OPA_dyn=v3
+#==============================================================
+
+[InitialStateFiles]
+List= ()
+
+[BoundaryFiles]
+List=	()
+ListNonDel= (${R_BC}/${config_UserChoices_TagName}/DYN/${pisces_UserChoices_OPA_dyn}/NEMOV3_mesh_mask.nc, mesh_mask.nc), \
+            (${R_BC}/${config_UserChoices_TagName}/DYN/${pisces_UserChoices_OPA_dyn}/NEMOV3_5d_21210101_21211231_grid_T.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/DYN/${pisces_UserChoices_OPA_dyn}/NEMOV3_5d_21210101_21211231_grid_U.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/DYN/${pisces_UserChoices_OPA_dyn}/NEMOV3_5d_21210101_21211231_grid_V.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/DYN/${pisces_UserChoices_OPA_dyn}/NEMOV3_5d_21210101_21211231_grid_W.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_DIC_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_Alkalini_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_O2_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_NO3_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_PO4_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_Si_nomask.nc,  .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_DOC_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/INI/data_1m_Fer_nomask.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/ANC/kRGB61.txt, .), \
+            (${R_BC}/${config_UserChoices_TagName}/ANC/dust.orca.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/ANC/bathy.orca.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/ANC/river.orca.nc, .), \
+            (${R_BC}/${config_UserChoices_TagName}/ANC/ndeposition.orca.nc, .)
+
+[ParametersFiles]
+List=	(${SUBMIT_DIR}/PARAM/namelist, .), \
+        (${SUBMIT_DIR}/PARAM/namelist_top, .), \
+        (${SUBMIT_DIR}/PARAM/namelist_pisces, .), \
+        (${SUBMIT_DIR}/PARAM/iodef.xml, .), \
+        (${SUBMIT_DIR}/PARAM/xmlio_server.def, .)
+
+[RestartFiles]
+List=	(${config_UserChoices_JobName}_${NEMO_END}_restart_trc.nc,  restart_trc.nc, restart_trc.nc)
+
+[OutputText]
+List=   (ocean.output)
+
+[OutputFiles]
+List=   (${PREFIX_WFT1}_ptrc_T.nc, ${R_OUT_MBG_WFT1}/${PREFIX}_${WFT1}_ptrc_T.nc, NONE), \
+        (${PREFIX_WFT1}_diad_T.nc, ${R_OUT_MBG_WFT1}/${PREFIX}_${WFT1}_diad_T.nc, NONE), \
+        (${PREFIX_WFT2}_ptrc_T.nc, ${R_OUT_MBG_WFT2}/${PREFIX}_${WFT2}_ptrc_T.nc, Post_1M_ptrc_T), \
+        (${PREFIX_WFT3}_diad_T.nc, ${R_OUT_MBG_WFT3}/${PREFIX}_${WFT3}_diad_T.nc, Post_5D_diad_T)
+
+[Post_1M_ptrc_T]
+Patches= ()
+GatherWithInternal = (nav_lon, nav_lat, deptht, time_counter)
+TimeSeriesVars = (DCHL, NCHL, NO3)
+
+[Post_5D_diad_T]
+Patches = ()
+GatherWithInternal = (nav_lon, nav_lat, time_counter)
+TimeSeriesVars = (Cflx)
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.driver
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.driver	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/COMP/pisces.driver	(revision 3437)
@@ -0,0 +1,192 @@
+#!/bin/ksh
+
+#-----------------------------------
+function MBG_Initialize
+{ 
+    IGCM_debug_PushStack "MBG_Initialize"
+
+    JOB_NAME=${config_UserChoices_JobName}
+    OPA_NDT_DAY=${pisces_UserChoices_OPA_NDT_DAY:=4}
+
+# Local function to find namelists parameters
+supergrep () {
+    grep "^ *$1 *=" $2 | sed -e "s% *\!.*%%"
+}
+
+    ##--Variables used by OPA --
+
+    # cexper experience name for vairmer format
+    # nit000 number of the first time step
+    # nitend number of the last time step
+    # nleapy leap year calendar (0/1) (30 for 360d)
+    # nwrite frequency of OUTPUT file
+    # ln_rstart boolean term for restart (true or false)
+    # nstock frequency of restart file
+    # ndate0 initial calendar date aammjj
+    # rdt time step in seconds (coming from namelist)
+
+
+    PAT_CEXPER=$( supergrep cn_exp      ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NIT000=$( supergrep nn_it000    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NITEND=$( supergrep nn_itend    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NLEAPY=$( supergrep nn_leapy    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NSTOCK=$( supergrep nn_stock    ${SUBMIT_DIR}/PARAM/namelist )
+    PAT_NDATE0=$( supergrep nn_date0    ${SUBMIT_DIR}/PARAM/namelist )
+
+
+    OPA_RDT=$( supergrep rn_rdt  ${SUBMIT_DIR}/PARAM/namelist | sed 's/ *rn_rdt *=//' | sed 's/\. *,//' )
+
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # /!\ Needed by OPA namelist to compute file names /!\
+    (( DaysSinceJC = $( IGCM_date_DaysSinceJC ${DateBegin} ) + 1 ))
+
+    ##--Variables used by MBG --
+
+    # lrsttr    boolean term for tracer model restart (true or false)
+    # nrsttr    control of the time step (0, 1 or 2)
+    
+    ##--Variables used by PISCES --
+ 
+    PAT_TOP_LRSTTR=$( supergrep ln_rsttr                 ${SUBMIT_DIR}/PARAM/namelist_top )
+    PAT_TOP_NRSTTR=$( supergrep nn_rsttr                 ${SUBMIT_DIR}/PARAM/namelist_top )
+    PAT_PIS_LRIVER=$( supergrep ln_river                 ${SUBMIT_DIR}/PARAM/namelist_pisces )
+
+    ##--Variables used for XMLIO_SERVER configuration file
+
+    # using_server: .TRUE.(.FALSE.) to use(bypass) the io_server
+
+    PAT_SERVER=$( supergrep using_server ${SUBMIT_DIR}/PARAM/xmlio_server.def )
+
+
+    IGCM_debug_PopStack "MBG_Initialize"
+}
+
+#-----------------------------------
+function MBG_Update
+{
+    IGCM_debug_PushStack "MBG_Update"
+
+    # Period Length In Days between DateBegin and first day of calendar 0001 01 01
+    # Needed by OPA namelist to compute correct file names 
+    (( PeriodDaysSinceJC =  $( IGCM_date_DaysSinceJC ${PeriodDateBegin} ) + 1  ))
+
+    ## Count of number of time steps from begin of OPA job
+    (( OPA_NIT000 = ( PeriodDaysSinceJC - DaysSinceJC ) * OPA_NDT_DAY + 1 ))
+    (( OPA_NDT   = PeriodLengthInDays * OPA_NDT_DAY ))
+    (( OPA_NITEND = OPA_NIT000 + OPA_NDT - 1))
+
+    ## Forcing to write one restart file at the end of period
+    OPA_NSTOCK="${OPA_NITEND}"
+
+    ## Verification of number of time steps per day
+    (( NB_SEC_DAY_MODEL = OPA_NDT_DAY * OPA_RDT ))
+    (( NB_SEC_DAY = 60 * 60 * 24 ))
+
+    if [ ${NB_SEC_DAY_MODEL} -ne ${NB_SEC_DAY} ]
+        then
+        echo " VERIFY OPA_NDT_DAY in pisces.card "
+        exit
+    fi
+
+     ## nleapy configuration
+        case ${config_UserChoices_CalendarType} in
+                leap)
+                OPA_NLEAPY=1;;
+                noleap)
+                OPA_NLEAPY=0;;
+                360d)
+                OPA_NLEAPY=30;;
+        esac
+
+
+        typeset -r PRECIS=8
+        NEMO_END=$( echo $( awk "BEGIN { printf \"%0${PRECIS}d\",${OPA_NITEND} }" ) )
+
+    sed -e "s%${PAT_CEXPER}%       cn_exp=\"${config_UserChoices_JobName}\"%" \
+        -e "s%${PAT_NIT000}%       nn_it000=${OPA_NIT000}%"                    \
+        -e "s%${PAT_NITEND}%       nn_itend=${OPA_NITEND}%"                    \
+        -e "s%${PAT_NSTOCK}%       nn_stock=${OPA_NSTOCK}%"                    \
+        -e "s%${PAT_NDATE0}%       nn_date0=${PeriodDateBegin}%"                \
+        -e "s%${PAT_NLEAPY}%       nn_leapy=${OPA_NLEAPY}%"                     \
+        namelist > namelist.tmp
+
+    IGCM_sys_Mv namelist.tmp namelist
+
+    ##--Write Frequency Purpose
+    Nbfreq=$( echo ${config_MBG_WriteFrequency} | wc -w )
+    typeset -Z1 i=1
+    while [ $i -le ${Nbfreq} ]; do
+       topfrequency=$( echo ${config_MBG_WriteFrequency} | awk -v var="$i" "-F " '{print $var}' )
+       topfactor=$( echo ${topfrequency} | sed -e "s/[yYmMdD]//" )
+       case ${topfrequency} in
+         *Y|*y)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}y_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_Y} ;
+            eval WFT${i}=${topfactor}Y ;;
+         *M|*m)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}m_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_M} ;
+            eval WFT${i}=${topfactor}M ;;
+         *D|*d)
+            eval PREFIX_WFT${i}=${config_UserChoices_JobName}_${topfactor}d_${DatesPeriod} ;
+            eval R_OUT_MBG_WFT${i}=${R_OUT_MBG_O_D} ;
+            eval WFT${i}=${topfactor}D ;;
+         *)
+      esac
+       let i=$i+1
+    done
+
+    ##-- Restart configuration
+    if ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_MBG_Restart}" = "n" ] ) ; then
+
+        #echo "NO RESTART FOR TOP"
+        TOP_LRSTTR=.FALSE.
+        TOP_NRSTTR=0
+
+        PISCES_LRIVER=.FALSE.
+
+    elif ( [ "${CumulPeriod}" -eq 1 ] && [ "${config_MBG_Restart}" = "y" ] ) ; then
+
+        #echo "RESTART TOP"
+        TOP_LRSTTR=.TRUE.
+        TOP_NRSTTR=0
+
+        PISCES_LRIVER=.TRUE.
+
+    else
+
+        #echo "RESTART TOP"
+        TOP_LRSTTR=.TRUE.
+        TOP_NRSTTR=2
+
+        PISCES_LRIVER=.TRUE.
+
+    fi
+
+# on force les sorties PISCES comme les sorties OPA
+
+    sed -e "s%${PAT_TOP_LRSTTR}%          ln_rsttr=${TOP_LRSTTR}%"                   \
+        -e "s%${PAT_TOP_NRSTTR}%          nn_rsttr=${TOP_NRSTTR}%"                   \
+        namelist_top > namelist_top.tmp
+
+    IGCM_sys_Mv namelist_top.tmp namelist_top
+
+    sed -e "s%${PAT_PIS_LRIVER}%          ln_river=${PISCES_LRIVER}%"                \
+        namelist_pisces > namelist_pisces.tmp
+
+    IGCM_sys_Mv namelist_pisces.tmp namelist_pisces
+
+
+    IGCM_debug_PopStack "MBG_Update"
+}
+
+#-----------------------------------
+function MBG_Finalize
+{
+    IGCM_debug_PushStack "MBG_Finalize"
+
+    echo FINALIZE MBG !!!
+
+    IGCM_debug_PopStack "MBG_Finalize"
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/README	(revision 3437)
@@ -0,0 +1,58 @@
+ config.card
+ ORCA2_OFF_PISCES
+ 5 years run -  trunk of 1 year per job with diagnostics ( key_trc_diaadd & key_trc_dia3d activated )
+
+ - NEMO    trunk revision 1656
+ - mpi on 4 processors ( 1x4 domain decomposition )
+ - libIGCM trunk revision 183
+ - dynamical files from IPSLCM5-VA66 runs from Olivier Marti
+
+without monitoring and atlas
+
+Tested on  NEC SX9 mercure at CCRT.
+
+Ouputs on : /dmnfs10/cont003/p48ethe/IGCM_OUT/ORCA2_OFF_PISCES/VA66P
+
+========================================================================
+run.card
+
+# $Date: $
+# $Name: $
+# $Revision: $
+# IPSL (2006)
+#  This software is governed by the CeCILL licence see libIGCM/libIGCM_CeCILL.LIC
+
+#========================================================================
+[Configuration]
+#last PREFIX
+OldPrefix= VA66P_20051231
+#Compute date of loop
+PeriodDateBegin= 2006-01-01
+PeriodDateEnd= 2006-12-31
+CumulPeriod= 6
+# State of Job "Start", "Running", "OnQueue", "Completed"
+PeriodState= Completed
+
+#========================================================================
+[PostProcessing]
+
+#RebuildRunning=y/n
+#RebuildToComplete=number of dir to rebuild
+#RebuildDateID=PeriodDateEnd correspondant au dernier flag de RebuildFrequency=true
+
+TimeSeriesRunning=n
+TimeSeriesCompleted=
+
+#========================================================================
+[Log]
+# Executables Size
+LastExeSize= ( 11596207 )
+
+#------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+# CumulPeriod | PeriodDateBegin |   PeriodDateEnd |        RunDateBegin |          RunDateEnd |     RealCpuTime |     UserCpuTime |      SysCpuTime | ExeDate
+#------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+#           1 |        20010101 |        20011231 | 2009-10-14T15:05:34 | 2009-10-14T15:10:39 |       304.19207 |      1191.95484 |         4.41881 | MBG_Oct_14_15:02
+#           2 |        20020101 |        20021231 | 2009-10-14T15:14:18 | 2009-10-14T15:20:13 |       354.59008 |      1412.65806 |         2.16025 | MBG_Oct_14_15:02
+#           3 |        20030101 |        20031231 | 2009-10-14T15:24:17 | 2009-10-14T15:30:10 |       353.09587 |      1407.03031 |         2.22349 | MBG_Oct_14_15:02
+#           4 |        20040101 |        20041231 | 2009-10-14T15:34:16 | 2009-10-14T15:40:18 |       362.49957 |      1430.77230 |         3.31767 | MBG_Oct_14_15:02
+#           5 |        20050101 |        20051231 | 2009-10-14T15:44:16 | 2009-10-14T15:50:17 |       360.82695 |       717.62953 |         1.79535 | MBG_Oct_14_15:02
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/config.card
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/config.card	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/IGCM00/config.card	(revision 3437)
@@ -0,0 +1,96 @@
+#
+# This is config.card file for NEMO ORCA2_LIM_PISCES configuration
+#
+#========================================================================
+#D-- Compatibility -
+[Compatibility]
+libIGCM=1.0
+#D-- UserChoices -
+[UserChoices]
+#============================
+#-- (<8 chars MAX for JobName)
+JobName=PISCES
+LongName="SCRIPT_V1"
+TagName=ORCA2_OFF_PISCES
+#============================
+#-- leap, noleap, 360d
+CalendarType=noleap
+#-- Begin and end of Job
+#-- "YYYY-MM-DD"
+DateBegin=2001-01-01
+DateEnd=2005-12-31
+#============================
+#-- 1Y, 1M, 5D, 1D
+PeriodLength=1Y
+#============================
+#-- PBS Class (required on brodie mono/multi)
+JobClass=mono
+#JobClass=multi
+#============================
+#-- Total Number of Processors
+JobNumProcTot=1
+#JobNumProcTot=8
+#============================
+#-- Run Options : 
+#JobRunOptions=''
+JobRunOptions='"-np "${BATCH_NUM_PROC_TOT}"'
+#============================
+#============================
+# config.card configuration options :
+# config.card configuration options :
+###R_BC=/u/rech/eee/reee451/IGCM/BC
+R_BC=/dmnfs/cont003/p48ethe/IGCM/BC
+#========================================================================
+#D-- ListOfComponents -
+[ListOfComponents]
+#D- For each component, Name of component, Tag of component
+MBG= (pisces, PISCES)
+#========================================================================
+#D-- Executable -
+[Executable]
+Name=nemo
+#D- For each component, Real name of executable
+MBG= (nemo.exe, nemo)
+#========================================================================
+#D-- Restarts -
+[Restarts]
+#D- If you want a GENERAL RULE FOR RESTARTS, put this flag to 'y'
+OverRule=n
+#D- Last day of the experience used as restart
+RestartDate=2000-12-31
+#D- Define restart simulation name
+RestartJobName=OROFP
+#D- Path Server Group Login
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_OFF_PISCES
+
+#========================================================================
+#D-- Post -
+[Post]
+#D- Do we rebuild parallel output, this flag determines
+#D- frequency of rebuild submission
+#D- BETA FEATURE
+RebuildFrequency=NONE
+#D- If you want to produce time series, this flag determines
+#D- frequency of post-processing submission
+RebuildFromArchive=false
+#D- If you want to produce time series, this flag determines
+#D- frequency of post-processing submission
+TimeSeriesFrequency=NONE
+#D- If you want to produce seasonal average, this flag determines
+#D- the period of this average
+SeasonalFrequency=NONE
+#========================================================================
+#D-- MBG -
+[MBG]
+##-- frequency 
+WriteFrequency="1Y 1M 5D"
+##--  restart
+Restart= n
+##-- Last day of the experience used as restart
+RestartDate=2000-12-31
+# Define restart simulation name
+RestartJobName=OROFP1
+RestartPath=${ARCHIVE}/IGCM_OUT/ORCA2_OFF_PISCES
+# Old component name for restart (if empty, use new name)
+OldName=
+#========================================================================
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm	(revision 3437)
@@ -0,0 +1,1 @@
+bld::tool::fppkeys key_trabbl key_orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/cfg.txt
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/cfg.txt	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/cfg.txt	(revision 3437)
@@ -0,0 +1,8 @@
+GYRE OPA_SRC
+GYRE_LOBSTER OPA_SRC TOP_SRC
+ORCA2_LIM3 OPA_SRC LIM_SRC_3
+AMM12 OPA_SRC
+ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
+AMM12_PISCES OPA_SRC TOP_SRC
+ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
+ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/makenemo
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/makenemo	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/CONFIG/makenemo	(revision 3437)
@@ -0,0 +1,329 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u 
+#set -e
+#+
+#
+# ===============
+# makenemo
+# ===============
+#
+# --------------------------
+# Compile NEMO
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ makenemo
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# This script aims :
+#
+# - to choose MYCONFIG
+# - to choose compiler options  
+# - to create the CONFIG/MYCONFIG/WORK directory
+# - to compile this configuration
+#
+#  Variables used :
+#
+#  From user input
+#
+# - NEW_CONF    : configuration to be created
+# - REF_CONF    : reference configuration to build the new one 
+# - CMP_NAM     : compiler name 
+# - NBR_PRC     : number of processes used to compile  
+# - NEM_SUBDIR  : NEMO subdirectory used (specified)
+#
+#  Locally defined :
+#
+# - TAB         : NEMO subdirectory used (read)  
+# - MAIN_DIR    : self explaining
+# - CONFIG_DIR  :   "    "    "   
+# - MODELES_DIR :   "    "    " 
+# - TOOLS_DIR   :   "    "    " 
+# - NEMO_DIR    :   "    "    "
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./makenemo -m ifort_osx - j3 -n ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#-
+#- Initialization of the options ---
+x_d="";
+x_h="";
+x_n="";
+x_r="";
+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
+#-
+#- FCM and functions location ---
+export PATH=${MAIN_DIR}/EXTERNAL/fcm/bin:$PATH
+
+#-
+#- Choice of the options ---
+while getopts :hd:n:r:m:j:e:s:v:t: V
+do
+    case $V in
+	(h) x_h=${OPTARG};
+        echo "Usage	 : "${b_n} \
+	    " [-h] [-n name] [-m arch] [-d "dir1 dir2"] [-r conf] [-s Path] [-e Path] [-j No] [-v No]";
+	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 " -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 " -t dir       : temporary directory for compilation"
+	echo "";
+	echo "Example to install a new configuration MY_CONFIG";
+	echo "with OPA_SRC and LIM_SRC_2 ";
+	echo "makenemo -n MY_CONFIG -d \"OPA_SRC LIM_SRC_2\"";
+	echo "";
+	echo "Available configurations :"; cat ${CONFIG_DIR}/cfg.txt; 
+	echo "";
+	echo "Example to remove bad configuration ";
+	echo "./makenemo -n MY_CONFIG clean_config";
+	echo "";
+	echo "Example to clean ";
+	echo "./makenemo clean";
+	echo "";
+	echo "Example to add and remove keys";
+	echo "./makenemo add_key \"key_iomput key_mpp_mpi\" del_key \"key_agrif\" ";
+	echo "";
+	echo "Example to add and remove keys for a new configuration, and do not compile";
+	echo "./makenemo -n MY_CONFIG -j0 add_key \"key_iomput key_mpp_mpi\" del_key \"key_agrif\" ";
+	echo "";
+	. ${COMPIL_DIR}/Flist_archfile.sh ${x_h}  ;
+	echo "";
+	echo "Default : previous configuration and compiler";
+	exit 0;;
+	(d)  x_d=${OPTARG};;
+	(n)  x_n=${OPTARG};;
+	(r)  x_r=${OPTARG};;
+	(m)  x_m=${OPTARG};;
+	(j)  x_j=${OPTARG};;
+	(t)  x_t=${OPTARG};;
+    (e)  x_e=${OPTARG};;
+    (s)  x_s=${OPTARG};;
+    (v)  x_v=${OPTARG};;
+	(:)  echo ${b_n}" : -"${OPTARG}" option : missing value" 1>&2;
+	exit 2;;
+	(\?) echo ${b_n}" : -"${OPTARG}" option : not supported" 1>&2;
+	exit 2;;
+    esac
+done
+shift $(($OPTIND-1));
+
+while [ ${#1} -gt 0 ]   # Get clean, clean_config options
+do
+    case "$1" in
+	clean)
+	    x_c="--$1"
+	    ;;
+	clean_config)
+	    . ${COMPIL_DIR}/Fclean_config.sh
+	    exit
+	    ;;
+	add_key)
+	    list_add_key=$2
+	    export ${list_add_key}
+	    shift
+	    ;;
+	del_key)
+	    list_del_key=$2
+	    export ${list_del_key}
+	    shift
+	    ;;
+	*)
+	    echo " \"$1\" BAD OPTION" 
+	    exit
+	    ;;
+	
+    esac
+    shift
+done
+
+
+#-
+#- Go to NEMOGCM/config directory ---
+cd ${CONFIG_DIR}
+
+#-
+#- Initialisation from input ---
+export NEW_CONF=${x_n}
+NBR_PRC=${x_j}
+CMP_NAM=${x_m}
+NEM_SUBDIR=${x_d}
+REF_CONF=${x_r}
+NEMO_TDIR=${x_t:-$NEMO_TDIR}
+export NEMO_TDIR=${NEMO_TDIR:-$CONFIG_DIR}
+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
+    exit
+fi
+[ "${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_nemo.fcm ${CMP_NAM} || exit
+
+#-
+#- Choose a default configuration if needed ---
+#- ORCA2_LIM or last one used ---
+. ${COMPIL_DIR}/Fcheck_config.sh cfg.txt ${NEW_CONF} || exit 
+
+
+if [ ${#NEW_CONF} -eq 0 ] ; then
+    if [ ${#NEM_SUBDIR} -eq 0 -a ${#REF_CONF} -eq 0 ]; then
+	echo "You are  installing a new configuration"
+	ind=0
+	. ${COMPIL_DIR}/Fread_dir.sh OPA_SRC	 YES 
+	. ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_2   YES 
+	. ${COMPIL_DIR}/Fread_dir.sh LIM_SRC_3   NO  
+	. ${COMPIL_DIR}/Fread_dir.sh TOP_SRC	 NO  
+	. ${COMPIL_DIR}/Fread_dir.sh NST_SRC	 YES 
+	. ${COMPIL_DIR}/Fread_dir.sh OFF_SRC	 NO  
+	REF_CONF=ORCA2_LIM
+    elif [ ${#NEM_SUBDIR} -gt 0 ] && [ ${#REF_CONF} -eq 0 ]; then
+	echo "You are  installing a new configuration"
+	TAB=( ${NEM_SUBDIR} )
+	REF_CONF=ORCA2_LIM
+    elif [ ${#NEM_SUBDIR} -eq 0 ] && [ ${#REF_CONF} -gt 0 ]; then
+	echo "You are  installing a new configuration based on ${REF_CONF}"
+	. ${COMPIL_DIR}/Fcopy_dir.sh ${REF_CONF}  
+    fi
+    NEW_CONF=${x_n}
+    . ${COMPIL_DIR}/Fmake_config.sh ${NEW_CONF} ${REF_CONF}
+else
+    sed -e "/${NEW_CONF} /d"  ${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
+
+#- At this stage new configuration has been added,
+#- We add or remove keys
+if [ ${#list_add_key} -ne 0 ] ; then
+    . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key} 
+fi
+
+if [ ${#list_del_key} -ne 0 ] ; then
+    . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}
+fi
+
+#- At this stage the configuration has beeen chosen
+#- We coose the default light file
+export USEBLD=bldxioxag.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
+
+#- and test whether we need to build the ioserver
+grep key_iomput ${COMPIL_DIR}/cpp.fcm && export USEBLD=${USEBLD/xio/}
+
+#-
+#_ END OF CONFIGURATION PHASE
+#_
+
+#-
+#- Compile ---
+
+if [ "${NBR_PRC}" -gt 0 ]; then
+    cd ${NEMO_TDIR}/${NEW_CONF} || cd -
+
+#if AGRIF we do a first preprocessing
+    if [ ${#x_c} -eq 0 ]; then
+        [ "$AGRIFUSE" == 1 ] && fcm build --ignore-lock -s 2 ${COMPIL_DIR}/$USEBLD
+        [ "$AGRIFUSE" == 1 ] && rm -rf  ${NEMO_TDIR}/${NEW_CONF}/BLD/*
+    fi
+    fcm build ${x_c} --ignore-lock -v ${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
+    [ -f ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/server.exe ] && ln -sf ${NEMO_TDIR}/${NEW_CONF}/BLD/bin/server.exe  ${CONFIG_DIR}/${NEW_CONF}/EXP00/server.exe
+
+#add remove for clean option
+    if  [ ${#x_c} -ne 0 ]; then
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/WORK
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/BLD
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/EXP00/opa
+        rm -rf ${NEMO_TDIR}/${NEW_CONF}/EXP00/server.exe
+        echo "cleaning ${NEW_CONF} WORK, BLD"
+    fi
+
+fi
+
+#- Come back to original directory ---
+cd -
+
+#-
+#- Unset variables
+${COMPIL_DIR}/Fclean_var.sh
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F	(revision 3437)
@@ -0,0 +1,1175 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Arrays
+C      
+      Module Agrif_Arrays
+      Use Agrif_Types
+C
+      implicit none
+C      
+      Contains
+C     **************************************************************************
+CCC   Subroutine Agrif_Childbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Childbounds(nbdim,lboundloc,uboundloc,
+     &                 pttab,petab,pttruetab,cetruetab,memberin)
+C
+CCC   Description:
+CCC   Subroutine calculating the global indices of the child grid
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lboundloc,uboundloc
+      INTEGER,DIMENSION(nbdim) :: pttab,petab,pttruetab,cetruetab
+      LOGICAL :: memberin
+C
+C     Local variables
+      INTEGER :: i,lbglob,ubglob
+C
+#ifdef key_mpp_mpi
+      INTEGER :: indglob1,indglob2
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        lbglob = lboundloc(i)
+        ubglob = uboundloc(i)
+C
+#ifdef key_mpp_mpi
+C
+        Call AGRIF_InvLoc(lbglob,Agrif_ProcRank,i,indglob1)
+C
+        Call AGRIF_InvLoc(ubglob,Agrif_ProcRank,i,indglob2)
+C
+        pttruetab(i) = max(pttab(i),indglob1)        
+C
+        cetruetab(i) = min(petab(i),indglob2)                 
+C
+#else
+C
+        pttruetab(i) = max(pttab(i),lbglob)        
+C
+        cetruetab(i) = min(petab(i),ubglob)
+C
+#endif
+C
+      enddo
+
+      memberin = .TRUE.
+
+      do i=1,nbdim
+        IF (cetruetab(i) < pttruetab(i)) THEN
+          memberin = .FALSE.
+          EXIT
+        ENDIF
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Childbounds
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Get_bound
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound(Variable,
+     &                           lower,upper,indice,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C     table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      INTEGER              :: lower,upper ! output data
+      ! direction in wich we want to know the dimension
+      INTEGER              :: indice      
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables
+C
+
+      lower = Variable % lb(indice)
+      upper = Variable % ub(indice)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound       
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Get_bound_dimension
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Get_bound_dimension(Variable,
+     &                              lower,upper,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      ! we want extract boundaries of this table
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: lower,upper ! output data
+C
+C     Local variables       
+C
+      lower = Variable % lb(1:nbdim)
+      upper = Variable % ub(1:nbdim)
+      return
+C
+      End Subroutine Agrif_nbdim_Get_bound_dimension     
+      
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_allocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_allocation(Variable,inf,sup,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to Allocate the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         allocate(Variable%array1(
+     &            inf(1):sup(1)))
+      CASE (2)
+          allocate(Variable%array2(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2)))
+      CASE (3)
+         allocate(Variable%array3(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3)))
+      CASE (4)
+         allocate(Variable%array4(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4)))
+      CASE (5)
+         allocate(Variable%array5(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5)))
+      CASE (6)
+         allocate(Variable%array6(
+     &            inf(1):sup(1),
+     &            inf(2):sup(2),
+     &            inf(3):sup(3),
+     &            inf(4):sup(4),
+     &            inf(5):sup(5),
+     &            inf(6):sup(6)))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_allocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_deallocation
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_deallocation(Variable,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable    
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+
+      SELECT CASE (nbdim)
+      CASE (1)
+         Deallocate(Variable%array1)
+      CASE (2)
+         Deallocate(Variable%array2)
+      CASE (3)
+         Deallocate(Variable%array3)
+      CASE (4)
+         Deallocate(Variable%array4)
+      CASE (5)
+         Deallocate(Variable%array5)
+      CASE (6)
+         Deallocate(Variable%array6)
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_deallocation
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQreal(Variable,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to get the lower and the upper boundaries of a
+C        table. Output datas are scalar.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+        Variable%array1 = Value      
+      CASE (2)
+        Variable%array2 = Value
+      CASE (3)
+        Call Agrif_set_tozero3D(Variable%array3)
+!        Variable%array3 = Value
+      CASE (4)
+        Variable%array4 = Value
+      CASE (5)
+        Variable%array5 = Value
+      CASE (6)
+        Variable%array6 = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQreal   
+      
+      Subroutine Agrif_set_tozero3D(tab3D)
+      real,dimension(:,:,:),target :: tab3D
+      
+      tab3D = 0.
+      
+      end subroutine agrif_set_tozero3D    
+C
+C
+#if !defined key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQreal
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQreal(Variable,inf,sup,Value,nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the same value to a part of 
+C        the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer :: Variable    
+      REAL                 :: Value       
+      INTEGER              :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(
+     &             inf(1):sup(1)
+     &             )  = Value
+      CASE (2)
+         Variable%array2(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2)
+     &             )  = Value
+      CASE (3)
+         Variable%array3(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3)
+     &             )  = Value
+      CASE (4)
+         Variable%array4(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4)
+     &             )  = Value
+      CASE (5)
+         Variable%array5(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5)
+     &             )  = Value
+      CASE (6)
+         Variable%array6(
+     &             inf(1):sup(1),
+     &             inf(2):sup(2),
+     &             inf(3):sup(3),
+     &             inf(4):sup(4),
+     &             inf(5):sup(5),
+     &             inf(6):sup(6)
+     &             )  = Value
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQreal       
+#endif
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_VarEQvar(Variable,inf,sup,
+     &                                Variable2,inf2,sup2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of a part of the table 
+C        Variable2 to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+      INTEGER,DIMENSION(nbdim) :: inf,sup
+      INTEGER,DIMENSION(nbdim) :: inf2,sup2
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         Variable%array1(inf(1):sup(1)) = 
+     &         Variable2%array1(inf2(1):sup2(1))
+      CASE (2)
+     
+      Call Agrif_Copy_2d(Variable%array2,Variable2%array2,
+     &  lbound(Variable%array2),
+     &  lbound(Variable2%array2),
+     &  inf,sup,inf2,sup2)
+          
+      CASE (3)
+
+      Call Agrif_Copy_3d(Variable%array3,Variable2%array3,
+     &  lbound(Variable%array3),
+     &  lbound(Variable2%array3),
+     &  inf,sup,inf2,sup2)
+
+      CASE (4)
+      
+      Call Agrif_Copy_4d(Variable%array4,Variable2%array4,
+     &  lbound(Variable%array4),
+     &  lbound(Variable2%array4),
+     &  inf,sup,inf2,sup2)
+     
+      CASE (5)
+        Variable%array5(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4), 
+     &                         inf(5):sup(5)) = 
+     &         Variable2%array5(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5))
+      CASE (6)
+        Variable%array6(inf(1):sup(1),
+     &                         inf(2):sup(2),
+     &                         inf(3):sup(3),
+     &                         inf(4):sup(4),
+     &                         inf(5):sup(5),
+     &                         inf(6):sup(6)) = 
+     &         Variable2%array6(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4),
+     &                          inf2(5):sup2(5),
+     &                          inf2(6):sup2(6))
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_VarEQvar
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_nbdim_Full_VarEQvar
+C     **************************************************************************
+C
+      Subroutine Agrif_nbdim_Full_VarEQvar(Variable,Variable2,
+     &                                nbdim)
+C
+CCC   Description:
+CCC   This subroutine is used to give the value of the table Variable2 
+C        to the table Variable
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_Variable), Pointer     :: Variable
+      TYPE(AGRIF_Variable), Pointer     :: Variable2
+      INTEGER                  :: nbdim       ! dimension of the table
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+          Variable%array1 = Variable2%array1
+      CASE (2)
+          Variable%array2 = Variable2%array2
+      CASE (3)
+          Variable%array3 = Variable2%array3
+      CASE (4)
+          Variable%array4 = Variable2%array4
+      CASE (5)
+          Variable%array5 = Variable2%array5
+      CASE (6)
+          Variable%array6 = Variable2%array6
+      END SELECT
+C
+      return
+C
+      End Subroutine Agrif_nbdim_Full_VarEQvar
+C
+C
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab_mpi
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab_mpi(Variable1,Variable2,
+     &                  bound1,lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(:,:,:) :: bound1
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           bound1(1,1,2):bound1(1,2,2)) 
+     &            == Value)
+             Variable2 % array1(bound1(1,1,1):bound1(1,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &           bound1(2,1,2):bound1(2,2,2)) 
+     &            == Value)
+             Variable2 % array2(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2)) 
+     &            == Value)
+             Variable2 % array3(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2)) 
+     &            == Value)
+             Variable2 % array4(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2)) 
+     &            == Value)
+             Variable2 % array5(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           bound1(1,1,2):bound1(1,2,2),
+     &                       bound1(2,1,2):bound1(2,2,2),
+     &                       bound1(3,1,2):bound1(3,2,2),
+     &                       bound1(4,1,2):bound1(4,2,2),
+     &                       bound1(5,1,2):bound1(5,2,2),
+     &                       bound1(6,1,2):bound1(6,2,2)) 
+     &            == Value)
+             Variable2 % array6(bound1(1,1,1):bound1(1,2,1),
+     &                       bound1(2,1,1):bound1(2,2,1),
+     &                       bound1(3,1,1):bound1(3,2,1),
+     &                       bound1(4,1,1):bound1(4,2,1),
+     &                       bound1(5,1,1):bound1(5,2,1),
+     &                       bound1(6,1,1):bound1(6,2,1))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab_mpi    
+
+C     **************************************************************************
+CCC   Subroutine GiveAgrif_SpecialValueToTab
+C     **************************************************************************
+C
+      Subroutine GiveAgrif_SpecialValueToTab(Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer    :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+             Where (Variable1 % array1(
+     &           lower(1):upper(1))
+     &            == Value)
+             Variable2 % array1(lower(1):upper(1))
+     &                        = Value
+C      
+              End Where
+      CASE (2)
+             Where (Variable1 % array2(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2)) 
+     &            == Value)
+             Variable2 % array2(lower(1):upper(1),
+     &                          lower(2):upper(2))
+     &                        = Value
+C      
+              End Where
+      CASE (3)
+             Where (Variable1 % array3(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3)) 
+     &            == Value)
+             Variable2 % array3(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3))
+     &                         = Value
+C      
+              End Where
+      CASE (4)
+             Where (Variable1 % array4(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2), 
+     &           lower(3):upper(3),
+     &           lower(4):upper(4)) 
+     &            == Value)
+             Variable2 % array4(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4))
+     &                        = Value
+C      
+              End Where
+      CASE (5)
+             Where (Variable1 % array5(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(3):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5)) 
+     &            == Value)
+             Variable2 % array5(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5))
+     &                        = Value
+C      
+              End Where
+      CASE (6)
+             Where (Variable1 % array6(
+     &           lower(1):upper(1),
+     &           lower(2):upper(2),
+     &           lower(2):upper(3),
+     &           lower(4):upper(4),
+     &           lower(5):upper(5),
+     &           lower(6):upper(6)) 
+     &            == Value)
+             Variable2 % array6(lower(1):upper(1),
+     &                          lower(2):upper(2),
+     &                          lower(3):upper(3),
+     &                          lower(4):upper(4),
+     &                          lower(5):upper(5),
+     &                          lower(6):upper(6))
+     &                        = Value
+C      
+              End Where
+      END SELECT
+C
+      return
+C
+      End Subroutine GiveAgrif_SpecialValueToTab   
+
+C
+C
+#ifdef key_mpp_mpi
+C     **************************************************************************
+CCC   Subroutine Where_ValTabToTab_mpi
+C     **************************************************************************
+C
+      Subroutine Where_ValTabToTab_mpi(
+     &                  Variable1,Variable2,
+     &                  lower,upper,Value,nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+C
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable1
+      TYPE(AGRIF_VARIABLE), Pointer     :: Variable2
+      INTEGER                  :: nbdim
+      INTEGER,DIMENSION(nbdim) :: lower,upper
+      REAL                     :: Value
+      INTEGER :: i,j,k,l,m,n
+C
+C     Local variables       
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+            DO i = lower(1),upper(1)
+              IF (variable1%array1(i) == Value) then
+                variable1%array1(i)=Variable2%array1(i)
+              ENDIF
+            ENDDO
+      CASE (2)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array2(i,j) == Value) then
+                variable1%array2(i,j)=Variable2%array2(i,j)
+              ENDIF
+            ENDDO
+            ENDDO
+      CASE (3)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array3(i,j,k) == Value) then
+                variable1%array3(i,j,k)=Variable2%array3(i,j,k)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (4)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array4(i,j,k,l) == Value) then
+                variable1%array4(i,j,k,l)=Variable2%array4(i,j,k,l)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (5)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array5(i,j,k,l,m) == Value) then
+              variable1%array5(i,j,k,l,m)=Variable2%array5(i,j,k,l,m)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      CASE (6)
+            DO n = lower(6),upper(6)
+            DO m = lower(5),upper(5)
+            DO l = lower(4),upper(4)
+            DO k = lower(3),upper(3)
+            DO j = lower(2),upper(2)
+            DO i = lower(1),upper(1)
+              IF (variable1%array6(i,j,k,l,m,n) == Value) then
+            variable1%array6(i,j,k,l,m,n)=Variable2%array6(i,j,k,l,m,n)
+              ENDIF
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+            ENDDO
+      END SELECT
+C
+      return
+C
+      End Subroutine Where_ValTabToTab_mpi    
+#endif
+
+C     **************************************************************************
+CCC   Subroutine PreProcessToInterpOrUpdate
+C     **************************************************************************
+C
+      Subroutine PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child,
+     &             pttab_Child,pttab_Parent,
+     &             s_Child,s_Parent,
+     &             ds_Child,ds_Parent,
+     &             nbdim)
+C
+CCC   Description:
+CCC   
+C
+C     Declarations:
+C      
+C     arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+      INTEGER :: nbdim                  
+      INTEGER,DIMENSION(6) :: pttab_child  
+      INTEGER,DIMENSION(6) :: petab_child      
+      INTEGER,DIMENSION(6) :: pttab_parent  
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      REAL, DIMENSION(6) :: s_child,s_parent
+      REAL, DIMENSION(6) :: ds_child,ds_parent
+C     locals variables
+      INTEGER :: n
+      
+C
+C     Arguments      
+C
+
+C
+C     Local variables       
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+C
+      root => child % var % root_var 
+C
+C     Number of dimensions of the current grid
+      nbdim = root % nbdim
+C      
+      do n=1,nbdim
+C            
+        Select case(root % interptab(n))
+C
+C       Value of interptab(n) can be either x,y,z or N for a no space 
+C       DIMENSION            
+C
+C         The DIMENSION is 'x'
+          case('x')
+C
+            pttab_Child(n) = root % point(1)
+C            
+            pttab_Parent(n) = root % point(1)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+              petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(1)
+C        
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                              Agrif_Child_Gr%nb(1) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif                  
+C
+C         The DIMENSION is 'y'
+          case('y')
+C
+            pttab_Child(n) = root % point(2)
+C            
+            pttab_Parent(n) = root % point(2)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(2)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                       Agrif_Child_Gr%nb(2) - 1
+C          
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif
+            
+C
+C         The DIMENSION is 'z'                            
+          case('z')
+C
+            pttab_Child(n) = root % point(3)
+C            
+            pttab_Parent(n) = root % point(3)
+C        
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+C
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+C        
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+C
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+C                      
+            if (root % posvar(n).EQ.1) then
+C          
+             petab_Child(n) = pttab_Child(n) + Agrif_Child_Gr%nb(3)
+C          
+              else
+C          
+                petab_Child(n) = pttab_Child(n) + 
+     &                      Agrif_Child_Gr%nb(3) - 1
+C
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+C
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+C        
+            endif       
+C 
+C         The DIMENSION is not space                            
+          case('N')
+C
+C         The next coefficients are calculated in order to do a simple copy of 
+C         values of the grid variable when the procedure of interpolation is 
+C         called for this DIMENSION 
+C      
+            Call Agrif_nbdim_Get_bound(child % var,
+     &                           pttab_Child(n),petab_Child(n),n,nbdim)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C
+            pttab_Parent(n) = pttab_Child(n)
+C              
+            s_Child(n)=0.
+C      
+            s_Parent(n)=0. 
+C      
+            ds_Child(n)=1.
+C      
+            ds_Parent(n)=1.
+C
+        End select
+C            
+      enddo     
+C
+      return
+C
+      End Subroutine PreProcessToInterpOrUpdate     
+
+#ifdef key_mpp_mpi
+C
+C     **************************************************************************
+CCC   Subroutine GetLocalBoundaries
+C     **************************************************************************
+C
+      Subroutine GetLocalBoundaries(tab1,tab2,i,lb,ub,deb,fin)
+C
+CCC   Descritpion:
+C 
+C
+C     Declarations:
+C
+
+C
+C
+C     Scalar arguments
+      INTEGER  ::  tab1,tab2
+      INTEGER  ::  i
+      INTEGER  ::  lb,ub
+      INTEGER  ::  deb,fin
+C
+C     Local scalars
+      INTEGER  ::  imin,imax
+      INTEGER  ::  i1,i2
+C
+C
+      Call AGRIF_InvLoc(lb,AGRIF_ProcRank,i,imin)
+C
+      Call AGRIF_InvLoc(ub,AGRIF_ProcRank,i,imax)
+C
+C
+      if (imin > tab2) then
+C
+          i1 = imax - imin
+C
+        else
+C
+          i1 = max(tab1 - imin,0)
+C
+      endif
+C
+      if (imax < tab1) then
+C
+          i2 = -(imax - imin)
+C
+        else
+C
+          i2 = min(tab2 - imax,0)
+C
+      endif
+C
+      deb = lb + i1
+C
+      fin = ub + i2
+C
+C
+      End Subroutine GetLocalBoundaries
+C
+#endif
+C
+C
+#ifdef key_mpp_mpi
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_GlobtoLocInd2
+C     **************************************************************************
+C
+      Subroutine Agrif_GlobtoLocInd2(tabarray,lboundl,uboundl,tab1,tab2,
+     &                              nbdim,rank,member)
+C
+CCC   Description:
+CCC   For a global index located on the current processor, tabarray gives the 
+CCC   corresponding local index   
+C
+C
+C     Declarations:
+C
+
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: tab1,tab2
+      INTEGER,DIMENSION(nbdim,2,2 ) :: tabarray
+      INTEGER,DIMENSION(nbdim) :: lboundl,uboundl
+      INTEGER :: rank
+      LOGICAL :: member
+C    
+C     Local variables
+      INTEGER :: i,i1,k
+      INTEGER :: nbloc(nbdim)
+C
+C
+      tabarray(:,1,:) =  HUGE(1)
+      tabarray(:,2,:) =  -HUGE(1)
+
+      nbloc = 0
+C        
+      do i = 1,nbdim
+C       
+        Call Agrif_Invloc(lboundl(i),rank,i,i1)
+        
+        do k=tab1(i)+lboundl(i)-i1,tab2(i)+lboundl(i)-i1
+          IF ((k .GE. lboundl(i)) .AND. (k.LE.uboundl(i))) THEN
+            nbloc(i) = 1
+            tabarray(i,1,1) = min(tabarray(i,1,1),k-lboundl(i)+i1)
+            tabarray(i,2,1) = max(tabarray(i,2,1),k-lboundl(i)+i1)
+        
+            tabarray(i,1,2) = min(tabarray(i,1,2),k)
+            tabarray(i,2,2) = max(tabarray(i,2,2),k)
+          ENDIF
+        enddo
+C
+      enddo
+
+      member = .FALSE.
+      IF (sum(nbloc) == nbdim) member = .TRUE.
+C
+      Return
+C
+C
+      End Subroutine Agrif_GlobtoLocInd2
+C
+#endif      
+
+      Subroutine Agrif_Copy_2d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(2) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):) :: tabout
+      real,target,dimension(m(1):,m(2):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2))
+      End Subroutine Agrif_Copy_2d
+      
+      Subroutine Agrif_Copy_3d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(3) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3))
+      End Subroutine Agrif_Copy_3d
+      
+      Subroutine Agrif_Copy_4d(tabout,tabin,l,m,inf,sup,inf2,sup2)
+      integer,dimension(4) :: l,m,inf,sup,inf2,sup2
+      real,target,dimension(l(1):,l(2):,l(3):,l(4):) :: tabout
+      real,target,dimension(m(1):,m(2):,m(3):,m(4):) :: tabin
+          tabout(inf(1):sup(1),
+     &                         inf(2):sup(2), 
+     &                         inf(3):sup(3), 
+     &                         inf(4):sup(4)) = 
+     &         tabin(inf2(1):sup2(1),
+     &                          inf2(2):sup2(2),
+     &                          inf2(3):sup2(3),
+     &                          inf2(4):sup2(4))
+      End Subroutine Agrif_Copy_4d      
+
+      End Module Agrif_Arrays
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F	(revision 3437)
@@ -0,0 +1,1337 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Boundary 
+C 
+      Module Agrif_Boundary  
+C
+CCC   Description:
+CCC   Module to calculate the boundary conditions on the child grids from their
+CCC   parent grids.
+C
+C     Modules used:  
+C   
+      Use Agrif_Interpolation        
+C
+      IMPLICIT NONE
+C        
+      CONTAINS   
+C     Define procedures contained in this module
+C
+C
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_1d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 1D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray1 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_1D
+C
+      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_2d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 2D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child 
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations are
+                                            ! done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2) 
+     &    ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for  
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid
+C     variable.   
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var
+C      
+C     Values of the grid variable
+      childtemp % var % parray2 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation 
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub         
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+
+C   
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp
+C         
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_3d(TypeInterp,parent,child,tab,deb,fin,
+     &                              weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 3D 
+CCC   variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments 
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp    ! TYPE of interpolation (linear, 
+                                            ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent       ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child        ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp    ! Temporary variable on the child
+                                            ! grid
+      INTEGER :: deb,fin                    ! Positions where interpolations 
+                                            ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                    ! Indicates if weight is used for 
+                                            ! the temporal interpolation 
+      REAL :: weight                        ! Coefficient for the time 
+                                            ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var       
+C      
+C     Values of the grid variable
+      childtemp % var % parray3 => tab
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation  
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+C
+C     Call to the procedure for the calculations of the boundary conditions     
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_3D               
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_4d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 4D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &        ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray4 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp 
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_5d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 5D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      External :: procname
+      Optional :: procname     
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray5 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub
+                     
+C
+C     Call to the procedure for the calculations of the boundary conditions  
+      IF (present(procname)) THEN
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight,procname)
+      ELSE
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+      ENDIF
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_bc_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_bc_6d(TypeInterp,parent,child,tab,deb,fin,
+     &                             weight,pweight)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid for a 6D 
+CCC   grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER,DIMENSION(6,6) :: TypeInterp      ! TYPE of interpolation (linear, 
+                                              ! lagrange, spline, ... )
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp      ! Temporary varaiable on the child
+                                              ! grid
+      INTEGER :: deb,fin                      ! Positions where interpolations 
+                                              ! are done on the fine grid 
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &         ), Target :: tab ! Values of the grid variable
+      LOGICAL :: pweight                      ! Indicates if weight is used for 
+                                              ! the temporal interpolation 
+      REAL :: weight                          ! Coefficient for the time 
+                                              ! interpolation
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE representing the grid 
+C     variable.  
+C
+      allocate(childtemp % var)  
+C
+      childtemp % var % root_var => child % var % root_var 
+C      
+C     Values of the grid variable
+      childtemp % var % parray6 => tab  
+C
+C     Temporary results for the time interpolation before and after the space 
+C     interpolation       
+      childtemp % var % oldvalues2D => child % var % oldvalues2D
+C 
+C     Index indicating if a space interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &                 child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp  
+      
+      childtemp % var% lb = child % var % lb
+      childtemp % var% ub = child % var % ub               
+C
+C     Call to the procedure for the calculations of the boundary conditions
+      Call Agrif_CorrectVariable
+     &     (TypeInterp,parent,childtemp,deb,fin,pweight,weight)
+C
+      child % var % oldvalues2D => childtemp % var % oldvalues2D
+      child % var % list_interp => childtemp % var %list_interp      
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_bc_6D
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CorrectVariable
+C     **************************************************************************
+C
+      Subroutine AGRIF_CorrectVariable(TypeInterp,parent,child,deb,fin,
+     &                                 pweight,weight,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions on a fine grid.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      TYPE(AGRIF_PVariable) :: parent         ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child          ! Variable on the child grid
+      INTEGER,DIMENSION(6,6)  :: TypeInterp     ! TYPE of interpolation
+                                              !    (linear,lagrange,...)
+      INTEGER               :: deb,fin        ! Positions where boundary
+                                              !    conditions are calculated
+      LOGICAL               :: pweight        ! Indicates if weight is used 
+                                              !    for the time interpolation 
+      REAL                  :: weight         ! Coefficient for the time
+                                              !    interpolation
+C
+C     Local scalars
+      TYPE(Agrif_Grid)    , Pointer :: Agrif_Child_Gr,Agrif_Parent_Gr
+      TYPE(AGRIF_Variable), Pointer :: root   ! Variable on the root grid
+      INTEGER                       :: nbdim  ! Number of dimensions of 
+                                              !    the grid variable 
+      INTEGER                       :: n
+      INTEGER,DIMENSION(6)          :: pttab_child  ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the child grid variable
+      INTEGER,DIMENSION(6)          :: pttab_parent ! Index of the first point
+                                                    !    inside the domain for
+                                                    !    the parent grid
+                                                    !    variable
+      INTEGER,DIMENSION(6)          :: nbtab_Child  ! Number of the cells
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                                    !    variable on the cell 
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                                    !    grid has a common
+                                                    !    border with the root
+                                                    !    grid      
+      REAL, DIMENSION(6)            :: s_child,s_parent   ! Positions of the
+                                                    !    parent and child grids
+      REAL, DIMENSION(6)            :: ds_child,ds_parent ! Space steps of the
+                                                    !    parent and child grids 
+C
+C
+      loctab_child(:) = 0
+C
+      Agrif_Child_Gr => Agrif_Curgrid
+      Agrif_Parent_Gr => Agrif_Curgrid % parent
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)      
+      enddo
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(1)
+            pttab_Child(n) = root % point(1)
+            pttab_Parent(n) = root % point(1)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(1)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(1)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(1)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(1)
+            if (root % posvar(n) == 2) then
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif
+C
+            if (Agrif_CURGRID % NearRootBorder(1)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(1))
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(1)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(1))) 
+     &         loctab_child(n) = -3
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(2)
+            pttab_Child(n) = root % point(2)
+            pttab_Parent(n) = root % point(2)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(2)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(2) 
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(2)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(2)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(2)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(2)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(2)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(2))) 
+     &         loctab_child(n) = -3
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Child_Gr % nb(3)
+            pttab_Child(n) = root % point(3)
+            pttab_Parent(n) = root % point(3)
+            s_Child(n) = Agrif_Child_Gr % Agrif_x(3)
+            s_Parent(n) = Agrif_Parent_Gr % Agrif_x(3)
+            ds_Child(n) = Agrif_Child_Gr % Agrif_d(3)
+            ds_Parent(n) = Agrif_Parent_Gr % Agrif_d(3)
+            if (root % posvar(n) == 2) then        
+                s_Child(n) = s_Child(n) + ds_Child(n)/2.
+                s_Parent(n) = s_Parent(n) + ds_Parent(n)/2.
+            endif        
+C
+            if (Agrif_CURGRID % NearRootBorder(3)) 
+     &         loctab_child(n) = -1
+            if (Agrif_CURGRID % DistantRootBorder(3)) 
+     &         loctab_child(n) = -2
+            if ((Agrif_CURGRID % NearRootBorder(3)) .AND. 
+     &          (Agrif_CURGRID % DistantRootBorder(3))) 
+     &         loctab_child(n) = -3
+C
+          case('N') ! No space DIMENSION      
+C
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+            pttab_Child(n) = child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable
+C      
+            posvartab_child(n) = 1
+            pttab_Parent(n)= pttab_Child(n)
+            s_Child(n)=0.
+            s_Parent(n)=0. 
+            ds_Child(n)=1.
+            ds_Parent(n)=1.
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+C
+         IF (present(procname)) THEN
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)
+        ELSE
+          Call AGRIF_CorrectnD
+     &         (TypeInterp,parent,child,deb,fin,pweight,weight,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+C
+C
+      End subroutine AGRIF_CorrectVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Correctnd
+C     **************************************************************************
+C
+      Subroutine AGRIF_Correctnd(TypeInterp,parent,child,deb,fin,
+     &                           pweight,weight,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER,DIMENSION(6,6) :: TypeInterp ! TYPE of interpolation (linear, 
+                                         !   spline,...)  
+      TYPE(AGRIF_PVariable)    :: parent ! Variable on the parent grid
+      TYPE(AGRIF_PVariable)    :: child  ! Variable on the child grid 
+      INTEGER                  :: deb,fin ! Positions where interpolations 
+                                         !    are done
+      LOGICAL                  :: pweight ! Indicates if weight is used for 
+                                         !    the temporal interpolation
+      REAL                     :: weight ! Coefficient for the temporal
+                                         !    interpolation
+      INTEGER                  :: nbdim  ! Number of dimensions of the grid
+                                         !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child ! Index of the first point inside
+                                         !    the domain for the parent 
+                                         !    grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent ! Index of the first point 
+                                         !   inside the domain for the 
+                                         !   child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child ! Number of cells of the child
+                                         !    grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child ! Position of the grid
+                                         !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child ! Indicates if the child 
+                                        !    grid has a common border with 
+                                        !    the root grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent ! Positions of the parent 
+                                        !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the 
+                                        !    parent and child grids
+C
+C     Local variables
+      TYPE(AGRIF_PVariable)        :: restore ! Variable on the parent     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i          
+      INTEGER                      :: kindex  ! Index used for safeguard 
+                                       !    and time interpolation
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits 
+                                       !    of the child     
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where 
+                                       !   boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres,ptres2 ! calculated
+      INTEGER                      :: nb,ndir,n,sizetab(1)
+      REAL, DIMENSION(:), Allocatable :: tab ! Array used for the interpolation
+      REAL    :: c1t,c2t               ! Coefficients for the time interpolation
+                                       !    (c2t=1-c1t) 
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lower,upper
+      INTEGER,DIMENSION(nbdim)   :: ltab,utab
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif            
+C      
+C
+      indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim)
+     &          + deb
+      indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( fin - deb )
+       
+      indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - fin
+      indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - deb
+                  
+      WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+      END WHERE
+      
+
+#if !defined key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lubglob(:,1),
+     &              lubglob(:,2),nbdim)
+C
+#else
+C     
+      Call Agrif_nbdim_Get_bound_dimension(child%var,lb,ub,nbdim)
+      
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+
+                              
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)  
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -1 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -2 
+     &                                 .OR. loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                                 + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i)
+     &                                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+#if defined key_mpp_mpi
+                 Call Agrif_nbdim_Get_bound_dimension
+     &                    (child%var,lower,upper,nbdim)
+
+              do i = 1,nbdim
+C
+                 Call GetLocalBoundaries(ptres(i,1,ndir,nb),
+     &                                  ptres(i,2,ndir,nb),i,
+     &                                  lower(i),upper(i),
+     &                                  ltab(i),utab(i))
+                 ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) 
+                 ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                 if ((i == nb) .AND. (ndir == 1)) then 
+                     ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                 elseif ((i == nb) .AND. (ndir == 2)) then
+                     ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) 
+                 endif
+C
+              enddo
+#else
+              ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif      
+            
+        endif
+      
+        enddo
+       enddo
+C
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep .OR.
+     &    child%var%Interpolationshouldbemade ) then
+C
+C     Space interpolation 
+C      
+      kindex = 1    
+      
+
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then  
+C
+              IF (present(procname)) THEN
+              Call Agrif_InterpnD
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim,procname)
+              ELSE
+              Call Agrif_InterpnD              
+     &             (TYPEInterp(nb,:),parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              restore,.FALSE.,nbdim)
+              ENDIF
+     
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C     
+C             Safeguard of the values of the grid variable (at times n and n+1
+C                on the parent grid)
+C      
+              sizetab(1) = 1
+C
+              do i = 1,nbdim
+C          
+                sizetab(1) = sizetab(1)
+     &              * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+C      
+              enddo
+
+              Call saveAfterInterp(child,
+     &           ptres2(:,:,ndir,nb),kindex,sizetab(1),nbdim)
+C
+           ENDIF
+C
+          endif
+C
+        enddo       
+C
+      enddo     
+C
+C
+      child % var % interpIndex = Agrif_Curgrid % parent % ngridstep
+C
+C
+      endif  
+      
+              IF (.NOT. child%var%interpolationshouldbemade) THEN
+C
+C
+C     Calculation of the coefficients c1t and c2t for the temporary
+C        interpolation
+      if (pweight) then
+C
+          c1t = weight
+C
+        else
+C
+          c1t = (REAL(AGRIF_Nbstepint()) + 1.) / Agrif_Rhot()
+C
+      endif
+C                                  
+      c2t = 1. - c1t
+C           
+C     Time interpolation
+C
+      kindex = 1
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2      
+C
+          if (loctab_child(nb) /= (-ndir) 
+     &        .AND. loctab_child(nb) /= -3) then
+
+              Call timeInterpolation
+     &             (child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+          endif
+C
+        enddo
+C      
+      enddo
+C      
+
+       ENDIF
+C  
+      End Subroutine Agrif_Correctnd
+C
+C
+C     **************************************************************************
+CCC   Subroutine saveAfterInterp
+C     **************************************************************************
+C
+      Subroutine saveAfterInterp(child,bounds,kindex,newsize,nbdim)
+C
+CCC   Descritpion:
+CCC   Subroutine used to save the values of the grid variable on the fine grid 
+CCC   after the space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child   ! The fine grid variable
+      INTEGER                :: kindex  ! Index indicating where this safeguard 
+                                        ! is done on the fine grid
+      INTEGER :: nbdim, newsize
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+C
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr
+C
+C
+C     Allocation of the array oldvalues2d
+
+C
+      if (newsize .LE. 0) return
+C
+      Call Agrif_Checksize
+     &     (child,kindex+newsize)  
+
+      if (child % var % interpIndex 
+     &        /= Agrif_Curgrid % parent % ngridstep ) then
+       child%var%oldvalues2d(1,kindex:kindex+newsize-1)=
+     &        child%var%oldvalues2d(2,kindex:kindex+newsize-1)
+      endif
+
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray1(ir)
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray2(ir,jr)
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray3(ir,jr,kr)
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+            child%var%oldvalues2d(2,kindex) =
+     &           child%var%parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+C
+C                                                  
+      End subroutine saveAfterInterp
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine timeInterpolation
+C     **************************************************************************
+C
+      Subroutine timeInterpolation(child,bounds,kindex,c1t,c2t,nbdim) 
+C
+CCC   Descritpion:
+CCC   Subroutine for a linear time interpolation on the child grid. 
+C
+C     Declarations:
+C
+      
+C
+C     argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,2) :: bounds
+      INTEGER                :: kindex ! Index indicating the values of the fine
+                                       ! grid got before and after the space 
+                                       ! interpolation and used for the time 
+                                       ! interpolation
+      REAL                   :: c1t,c2t! coefficients for the time interpolation
+                                       ! (c2t=1-c1t)  
+C
+C     Local aruments      
+      INTEGER :: i
+C     Local scalars
+      INTEGER                      :: ir,jr,kr,lr,mr,nr      
+C
+C
+      
+      SELECT CASE (nbdim)
+      CASE (1)
+
+!CDIR ALTCODE
+         do ir=bounds(1,1),bounds(1,2)
+                child%var%parray1(ir) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex)    
+            kindex = kindex + 1
+         enddo       
+C
+      CASE (2)
+
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+           do ir=bounds(1,1),bounds(1,2)
+                child%var%parray2(ir,jr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+           enddo
+         enddo      
+C
+      CASE (3)
+        do kr=bounds(3,1),bounds(3,2)
+          do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+             do ir=bounds(1,1),bounds(1,2)
+                child%var%parray3(ir,jr,kr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+             enddo
+           enddo
+         enddo       
+C
+      CASE (4)
+          do lr=bounds(4,1),bounds(4,2)
+           do kr=bounds(3,1),bounds(3,2)
+             do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+               do ir=bounds(1,1),bounds(1,2)
+                child%var%parray4(ir,jr,kr,lr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+               enddo
+             enddo
+           enddo
+         enddo         
+C
+      CASE (5)
+         do mr=bounds(5,1),bounds(5,2)
+           do lr=bounds(4,1),bounds(4,2)
+            do kr=bounds(3,1),bounds(3,2) 
+              do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                 do ir=bounds(1,1),bounds(1,2)
+                child%var%parray5(ir,jr,kr,lr,mr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo   
+C
+      CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+           do mr=bounds(5,1),bounds(5,2)
+             do lr=bounds(4,1),bounds(4,2)
+               do kr=bounds(3,1),bounds(3,2)
+                do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+                   do ir=bounds(1,1),bounds(1,2)
+                child%var%parray6(ir,jr,kr,lr,mr,nr) =
+     &           c2t*child % var % oldvalues2d(1,kindex)   
+     &         + c1t*child % var % oldvalues2d(2,kindex) 
+            kindex = kindex + 1
+                   enddo
+                 enddo
+               enddo
+             enddo
+           enddo
+         enddo       
+      END SELECT
+                                                   
+C
+C
+      End subroutine timeInterpolation      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Checksize
+C     **************************************************************************
+C
+      Subroutine Agrif_Checksize(child,newsize)
+C
+CCC   Descritpion:
+CCC   Subroutine used in the saveAfterInterp procedure to allocate the 
+CCC   oldvalues2d array. 
+C
+C     Declarations:
+C
+      
+C      
+C     TYPE argument
+      TYPE (AGRIF_PVariable) :: child  ! The fine grid variable
+C 
+C     Scalar arguments
+      INTEGER :: newsize               ! Size of the domains where the boundary 
+                                       ! conditions are calculated  
+C
+C     Local arrays
+      REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+C                
+C
+      if (.NOT. associated(child % var % oldvalues2d)) then
+C
+          allocate(child % var % oldvalues2d(2,newsize))
+C  
+          child % var % oldvalues2d=0.
+C
+        else
+C
+          if (SIZE(child % var % oldvalues2d,2) < newsize) then   
+C
+              allocate(tempoldvalues(2,SIZE(child % var %
+     &                                    oldvalues2d,2)))
+C
+              tempoldvalues = child % var % oldvalues2d
+C
+              deallocate(child % var % oldvalues2d)
+C
+              allocate(child % var % oldvalues2d(2,newsize))
+C            
+              child%var%oldvalues2d=0.
+C
+              child % var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = 
+     &        tempoldvalues(:,:)
+C
+              deallocate(tempoldvalues)
+C
+          endif 
+C
+      endif                                                    
+C
+C
+      End  Subroutine Agrif_Checksize
+C
+C
+C
+C      
+      End Module AGRIF_boundary
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F	(revision 3437)
@@ -0,0 +1,2448 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_bcfunction
+C
+C 
+      Module  Agrif_bcfunction
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C  
+      Use Agrif_Boundary
+      Use Agrif_Update
+      Use Agrif_fluxmod
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C
+      interface Agrif_Bc_variable
+          module procedure Agrif_Bc_variable0d,
+     &                     Agrif_Bc_variable1d,
+     &                     Agrif_Bc_variable2d,
+     &                     Agrif_Bc_variable3d,
+     &                     Agrif_Bc_variable4d,
+     &                     Agrif_Bc_variable5d
+      end interface       
+C
+      interface Agrif_Set_Parent
+          module procedure Agrif_Set_Parent_int,
+     &                     Agrif_Set_Parent_real
+      end interface       
+C
+      interface Agrif_Interp_variable
+          module procedure Agrif_Interp_var0d,
+     &                     Agrif_Interp_var1d,
+     &                     Agrif_Interp_var2d,
+     &                     Agrif_Interp_var3d,
+     &                     Agrif_Interp_var4d,
+     &                     Agrif_Interp_var5d
+      end interface       
+C
+      interface Agrif_Init_variable
+          module procedure Agrif_Init_variable0d,
+     &                     Agrif_Init_variable1d,
+     &                     Agrif_Init_variable2d,
+     &                     Agrif_Init_variable3d,
+     &                     Agrif_Init_variable4d
+      end interface       
+C
+      interface Agrif_update_variable
+          module procedure Agrif_update_var0d,
+     &                     Agrif_update_var1d,
+     &                     Agrif_update_var2d,
+     &                     Agrif_update_var3d,
+     &                     Agrif_update_var4d,
+     &                     Agrif_update_var5d
+      end interface       
+      
+      interface Agrif_Save_Forrestore
+         module procedure Agrif_Save_Forrestore0d,    
+     &                    Agrif_Save_Forrestore2d,    
+     &                    Agrif_Save_Forrestore3d,    
+     &                    Agrif_Save_Forrestore4d
+      end interface
+C
+      Contains 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_type
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_type(tabvarsindic,posvar,point)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % posvar)) then
+      Allocate( 
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var % posvar(dimensio))
+      endif 
+            
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % posvar(i)
+     &                       = posvar(i)
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % point(i) 
+     &                       = point(i)
+      enddo
+C
+C
+      End Subroutine Agrif_Set_type
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_int
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_int(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &         var % iarray0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_int
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_parent_real
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_parent_real(tabvarsindic,value)
+C
+CCC   Description:
+CCC   To set the TYPE of the variable.
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      REAL :: Value
+C
+C     Begin 
+C
+      Agrif_Curgrid % parent % tabvars(tabvarsindic) % 
+     &          var % array0 = value
+C
+C
+      End Subroutine Agrif_Set_parent_real
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_raf
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_raf(tabvarsindic,tabraf)
+C
+CCC   Description:
+CCC   Attention tabraf est de taille trois si on ne raffine pas suivant z la
+CCC             troisieme entree du tableau tabraf est 'N'
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      CHARACTER(*) ,DIMENSION(:) :: tabraf
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: dimensio ! DIMENSION of the variable
+      INTEGER :: i
+C
+C
+C     Begin 
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim
+C        
+      if (.not.associated(Agrif_Mygrid % tabvars(tabvarsindic)
+     &                                 %var % interptab)) then 
+      Allocate(
+     & Agrif_Mygrid % tabvars(tabvarsindic)%var% interptab(dimensio))
+      endif
+
+      do i = 1 , dimensio
+         Agrif_Mygrid % tabvars(tabvarsindic) %var % interptab(i) 
+     &                 = TRIM(tabraf(i))
+      enddo
+C
+      End Subroutine Agrif_Set_raf
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bc
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bc(tabvarsindic,point,
+     &          Interpolationshouldbemade)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+      LOGICAL, OPTIONAL :: Interpolationshouldbemade
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      endif  
+      
+      if (Agrif_Curgrid % fixedrank .NE. 0) then  
+       IF (.Not.Associated(tabvars%var% interpIndex)) THEN
+        Allocate(tabvars%var % interpIndex)
+          tabvars%var % interpIndex = -1
+
+        Allocate(tabvars%var % oldvalues2D(2,1))
+          tabvars%var % oldvalues2D = 0. 
+       ENDIF      
+       if ( PRESENT(Interpolationshouldbemade) ) then
+         tabvars%var %
+     &     Interpolationshouldbemade = Interpolationshouldbemade
+       endif
+
+      endif
+C
+      tabvars%var % bcinf = point(1)
+      tabvars%var % bcsup = point(2)
+C
+      End Subroutine Agrif_Set_bc
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_interp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_interp(tabvarsindic,interp,interp1,interp2,
+     &                interp3)
+C
+CCC   Description:
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif      
+C
+C     Begin 
+C
+      tabvars % var % Typeinterp = 
+     &    Agrif_Constant
+      IF (present(interp)) THEN
+      tabvars % var % Typeinterp = 
+     &           interp
+      ENDIF
+      IF (present(interp1)) THEN
+      tabvars % var % Typeinterp(1) = 
+     &           interp1
+      ENDIF
+      IF (present(interp2)) THEN
+      tabvars % var % Typeinterp(2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp3)) THEN
+      tabvars % var % Typeinterp(3) = 
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_interp
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_bcinterp
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_bcinterp(tabvarsindic,interp,interp1,
+     &      interp2,interp3,interp11,interp12,interp21,interp22)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL      :: interp,interp1,interp2,interp3
+      INTEGER, OPTIONAL      :: interp11,interp12,interp21,interp22
+C
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars
+      
+    
+C
+C
+C     Begin 
+C
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Mygrid % tabvars(indic)
+      endif 
+C
+      tabvars% var % bctypeinterp = 
+     &           Agrif_Constant   
+      IF (present(interp)) THEN
+      tabvars% var % bctypeinterp = 
+     &           interp
+      ENDIF       
+      IF (present(interp1)) THEN
+      tabvars% var % bctypeinterp(1:2,1) = 
+     &           interp1
+      ENDIF       
+      IF (present(interp11)) THEN
+      tabvars% var % bctypeinterp(1,1) = 
+     &           interp11
+      ENDIF
+      IF (present(interp12)) THEN
+      tabvars% var % bctypeinterp(1,2) = 
+     &           interp12
+      ENDIF          
+      IF (present(interp2)) THEN
+      tabvars% var % bctypeinterp(1:2,2) = 
+     &           interp2
+      ENDIF
+      IF (present(interp21)) THEN
+      tabvars% var % bctypeinterp(2,1) = 
+     &           interp21
+      ENDIF      
+      IF (present(interp22)) THEN
+      tabvars% var % bctypeinterp(2,2) = 
+     &           interp22
+      ENDIF            
+      IF (present(interp3)) THEN
+      tabvars% var % bctypeinterp(1:2,3) =
+     &           interp3
+      ENDIF
+C
+      End Subroutine Agrif_Set_bcinterp
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_Update
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_Update(tabvarsindic,point)
+C
+CCC   Description:
+CCC
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, DIMENSION(2) :: point
+C
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C
+C
+C     Begin 
+C
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf = point(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup = point(2)
+C
+      End Subroutine Agrif_Set_Update
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_UpdateType
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_UpdateType(tabvarsindic,
+     &                                  update,update1,update2,
+     &                                  update3,update4,update5)
+C
+CCC   Description:
+
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER, OPTIONAL           :: update, update1,
+     &       update2, update3,update4,update5
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer :: roottabvars      
+C
+C
+C     Begin 
+
+      indic = tabvarsindic
+
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+C
+      roottabvars% var % typeupdate = 
+     &                   Agrif_Update_Copy
+      
+      IF (present(update)) THEN
+        roottabvars% var % typeupdate = 
+     &           update
+      ENDIF
+      IF (present(update1)) THEN
+        roottabvars% var % typeupdate(1) = 
+     &           update1
+      ENDIF  
+      IF (present(update2)) THEN
+        roottabvars% var % typeupdate(2) = 
+     &           update2
+      ENDIF  
+      IF (present(update3)) THEN
+        roottabvars% var % typeupdate(3) = 
+     &           update3
+      ENDIF 
+      IF (present(update4)) THEN
+        roottabvars% var % typeupdate(4) = 
+     &           update4
+      ENDIF       
+      IF (present(update5)) THEN
+        roottabvars% var % typeupdate(5) = 
+     &           update5
+      ENDIF                  
+C
+      End Subroutine Agrif_Set_UpdateType           
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Set_restore
+C     **************************************************************************
+C 
+      Subroutine Agrif_Set_restore(tabvarsindic)
+C
+CCC   Description:
+CCC   
+C
+C     Modules used:
+C      
+
+C
+C     Declarations:
+C      
+C     Arguments      
+C
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+C
+C     Begin 
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif  
+C
+      Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE.
+C
+      End Subroutine Agrif_Set_restore
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable0d(tabvarsindic0,tabvarsindic,
+     &        procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(tabvarsindic0,indic,procname)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(tabvarsindic0,indic)
+      CALL Agrif_Bc_variable(tabvarsindic0,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+      End Subroutine Agrif_Init_variable1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      integer :: indic
+
+C
+      if (Agrif_Root()) Return
+C
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+
+      End Subroutine Agrif_Init_variable2d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable3d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Init_variable4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C
+      if (present(procname)) then
+      CALL Agrif_Interp_variable(q,indic,procname)
+      CALL Agrif_Bc_variable(q,indic,1.,procname)
+      else
+      CALL Agrif_Interp_variable(q,indic)
+      CALL Agrif_Bc_variable(q,indic,1.)
+      endif
+
+C
+      End Subroutine Agrif_Init_variable4d      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable0d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable0d(tabvarsindic0,tabvarsindic,
+     &                               calledweight,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+C        
+      External :: procname
+      Optional ::  procname
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+C
+      INTEGER :: dimensio      
+
+      if (Agrif_Root()) Return
+C
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim    
+C
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+C      
+C
+
+      
+      if ( dimensio .EQ. 1 ) Call Agrif_Interp_Bc_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array1,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)
+      ELSE
+          
+      Call Agrif_Interp_Bc_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array2,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array3,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array4,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array5,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      endif
+C
+      if ( dimensio .EQ. 6 ) Call Agrif_Interp_Bc_6D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % bctypeinterp,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) %var % array6,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % bcsup,
+     & weight,
+     & pweight)
+C
+C
+      End Subroutine Agrif_Bc_variable0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable1d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable1d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif         
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_1D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable1d 
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable2d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable2d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_2D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable2d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable3d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable3d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_3D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable3d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable4d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable4d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_4D(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable4d
+            
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Bc_variable5d
+C     **************************************************************************
+      Subroutine Agrif_Bc_variable5d(q,tabvarsindic,calledweight,
+     &                               procname)
+
+      REAL   , Dimension(:,:,:,:,:)          :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+C        
+      REAL, OPTIONAL :: calledweight
+      REAL    :: weight
+      LOGICAL :: pweight
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars
+C
+C      
+C      
+      If (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif      
+      
+      if ( PRESENT(calledweight) ) then
+        weight=calledweight      
+        pweight = .TRUE.
+      else
+        weight = 0.
+        pweight = .FALSE.
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      IF (present(procname)) THEN
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight,procname)      
+      ELSE
+      Call Agrif_Interp_Bc_5d(
+     & roottabvars % var % bctypeinterp,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % bcinf,
+     & tabvars % var % bcsup,
+     & weight,pweight)
+      ENDIF
+      End Subroutine Agrif_Bc_variable5d
+      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var0D
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var0d(tabvarsindic0,tabvarsindic,procname)
+
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic, indic  ! indice of the variable in tabvars
+      INTEGER :: dimensio  ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+C      
+      if (Agrif_Root()) Return
+C     
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif       
+C     
+      dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 
+C
+      if ( dimensio .EQ. 1 ) then
+       if (present(procname)) then
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+       else
+       Call Agrif_Interp_1D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 2 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_2D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 3 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_3D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 4 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_4D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      if ( dimensio .EQ. 5 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_5D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+       endif
+       endif
+C
+      if ( dimensio .EQ. 6 ) then
+      if (present(procname)) then
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname)
+      else
+       Call Agrif_Interp_6D(
+     & Agrif_Mygrid % tabvars(indic) % var %  TypeInterp,
+     & Agrif_Curgrid % parent % tabvars(indic),
+     & Agrif_Curgrid % tabvars(indic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 ,     
+     & Agrif_Mygrid % tabvars(indic) % var % restaure,
+     & Agrif_Mygrid % tabvars(indic) %var % nbdim)
+      endif
+      endif
+C
+      Return
+      End Subroutine Agrif_Interp_var0d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var1d(q,tabvarsindic,procname)
+
+      REAL, DIMENSION(:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_1D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var1d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var2d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+       if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+            
+       if (present(procname)) then
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+       else
+       Call Agrif_Interp_2D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif 
+      Return
+      End Subroutine Agrif_Interp_var2d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var3d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (present(procname)) then
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_3D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif   
+      Return
+      End Subroutine Agrif_Interp_var3d
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var4d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars  
+C
+      if (Agrif_Root()) Return
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      if (tabvars%var%restaure) then
+        if (agrif_curgrid%ngridstep == 0) then
+          call AGRIF_CopyFromold_AllOneVar
+     &            (Agrif_Curgrid,Agrif_OldMygrid,indic)
+        endif
+      endif      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+            
+      if (present(procname)) then
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_4D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif      
+
+      Return
+      End Subroutine Agrif_Interp_var4d     
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_var5d(q,tabvarsindic,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars      
+C
+      if (Agrif_Root()) Return
+C      
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      if (present(procname)) then
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim,procname)
+      else
+      Call Agrif_Interp_5D(
+     & roottabvars % var %  TypeInterp,
+     & parenttabvars,
+     & tabvars,q,
+     & roottabvars % var % restaure,
+     & roottabvars %var % nbdim)
+     
+      endif
+      Return
+      End Subroutine Agrif_Interp_var5d       
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var0d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var0d(tabvarsindic0,tabvarsindic,
+     &                              locupdate,locupdate1,
+     &                  locupdate2,procname)
+
+      INTEGER :: tabvarsindic ! indice of the variable in tabvars
+      INTEGER :: tabvarsindic0 ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER :: dimensio
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2            
+C
+      dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 
+C      
+      if (Agrif_Root()) Return
+      
+C     
+      IF (present(locupdate)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio)
+     &      = locupdate(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = locupdate(2)
+      ELSE
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:dimensio) 
+     &      = -99
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:dimensio) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1) 
+     &      = locupdate1(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2) 
+     &      = locupdate2(1)
+      Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF             
+ 
+      if ( dimensio .EQ. 1 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_1D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 2 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_2D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 3 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_3D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 4 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_4D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+      if ( dimensio .EQ. 5 ) then
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup,
+     & procname)
+      ELSE
+      Call Agrif_Update_5D(
+     & Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate,
+     & Agrif_Curgrid % parent % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic),
+     & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 ,     
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updateinf,
+     & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)      
+      ENDIF
+      endif
+
+      Return
+      End Subroutine Agrif_update_var0d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var1d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:) :: q
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      External :: procname
+      Optional ::  procname      
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars   
+C      
+      if (Agrif_Root()) Return
+C     
+
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:1) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:1) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:1) 
+     &      = -99
+      tabvars%var % updatesup(1:1) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF       
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_1D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var1d
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var2d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate 
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      
+C 
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:2) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:2) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:2) 
+     &      = -99
+      tabvars%var % updatesup(1:2) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+ 
+      IF (present(procname)) THEN
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_2D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var2d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var3d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN 
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:3) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:3) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:3) 
+     &      = -99
+      tabvars%var % updatesup(1:3) 
+     &      = -99
+      ENDIF      
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_3D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var3d
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var4d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C      
+      IF (Agrif_Root()) RETURN
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)     
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+C      
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:4) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:4) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:4) 
+     &      = -99
+      tabvars%var % updatesup(1:4) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_4D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var4d  
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_update_var5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_update_var5d(q,tabvarsindic,locupdate,
+     &  locupdate1,locupdate2,procname)
+
+      REAL,  DIMENSION(:,:,:,:,:) :: q
+      External :: procname
+      Optional ::  procname
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate1
+      INTEGER, DIMENSION(2), OPTIONAL :: locupdate2        
+      INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars
+      TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars       
+C
+      IF (Agrif_Root()) RETURN
+C      
+      indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif 
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      parenttabvars => tabvars%parent_var
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)      
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      parenttabvars => Agrif_Curgrid % parent % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+       
+      IF (present(locupdate)) THEN
+      tabvars%var % updateinf(1:5) 
+     &      = locupdate(1)
+      tabvars%var % updatesup(1:5) 
+     &      = locupdate(2)
+      ELSE
+      tabvars%var % updateinf(1:5) 
+     &      = -99
+      tabvars%var % updatesup(1:5) 
+     &      = -99
+      ENDIF
+      
+      IF (present(locupdate1)) THEN
+      tabvars%var % updateinf(1) 
+     &      = locupdate1(1)
+      tabvars%var % updatesup(1) 
+     &      = locupdate1(2)
+      ENDIF  
+      
+      IF (present(locupdate2)) THEN
+      tabvars%var % updateinf(2) 
+     &      = locupdate2(1)
+      tabvars%var % updatesup(2) 
+     &      = locupdate2(2)
+      ENDIF
+
+      IF (present(procname)) THEN
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup,
+     & procname)
+      ELSE 
+      Call Agrif_Update_5D(
+     & roottabvars % var % typeupdate,
+     & parenttabvars,
+     & tabvars,q,
+     & tabvars % var % updateinf,
+     & tabvars % var % updatesup)       
+      ENDIF
+
+      Return
+      End Subroutine Agrif_update_var5d  
+          
+      Subroutine Agrif_Declare_Flux(fluxname,profilename) 
+      character*(*) :: fluxname, profilename
+      Type(Agrif_Flux), pointer :: newflux
+      Type(Agrif_Profile), pointer  :: parcours
+      logical :: foundprofile
+      integer :: i,j,n
+            
+      foundprofile = .FALSE.
+      parcours => Agrif_Myprofiles
+      
+      Do While (Associated(parcours))
+         IF (parcours % profilename == profilename) THEN
+           foundprofile = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextprofile
+      End Do      
+      
+      IF (.NOT.foundprofile) THEN
+      write(*,*) 'The profile '''
+     &           //TRIM(profilename)//''' has not been declared'  
+      stop    
+      ENDIF
+      
+      Allocate(Newflux)
+      
+      Newflux % fluxname = fluxname
+      
+      Newflux % profile => parcours
+      
+      Newflux % nextflux => Agrif_Curgrid % fluxes
+      
+      Agrif_Curgrid % fluxes => Newflux
+      
+      End Subroutine Agrif_Declare_Flux  
+       
+      Subroutine Agrif_Save_Flux(fluxname, fluxtab)
+      character*(*) :: fluxname
+      REAL, DIMENSION(:,:) :: fluxtab
+      
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Type(Agrif_pgrid), pointer :: parcours_child
+      
+      Type(Agrif_grid), Pointer :: currentgrid,oldcurgrid
+      
+      IF (.Not.Agrif_Root()) THEN
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (.NOT.Flux%fluxallocated) THEN
+        CALL Agrif_AllocateFlux(Flux,fluxtab)
+      ENDIF
+      
+      Call Agrif_Save_Fluxtab(Flux,fluxtab)
+      
+      ENDIF
+      
+      oldcurgrid=> Agrif_Curgrid
+      
+      parcours_child => Agrif_Curgrid%child_grids
+      
+      Do While (Associated(parcours_child))
+        currentgrid => parcours_child%gr
+        Agrif_Curgrid => parcours_child%gr
+        Flux => Agrif_Search_Flux(fluxname)
+        IF (.NOT.Flux%fluxallocated) THEN
+          CALL Agrif_AllocateFlux(Flux,fluxtab)
+        ENDIF        
+        Call Agrif_Save_Fluxtab_child(Flux,fluxtab)
+        parcours_child=> parcours_child%next
+      End Do
+      
+      Agrif_Curgrid=>oldcurgrid
+      
+      End Subroutine Agrif_Save_Flux
+
+      Subroutine Agrif_Cancel_Flux(fluxname)
+      character*(*) :: fluxname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+
+      IF (Flux%FluxAllocated) Call Agrif_Cancel_Fluxarray(Flux)
+      
+      End Subroutine Agrif_Cancel_Flux
+ 
+      Subroutine Agrif_Flux_Correction(fluxname, procname)
+      character*(*) :: fluxname
+      external :: procname
+      
+      Type(Agrif_Flux), pointer :: Flux
+      
+      Flux => Agrif_Search_Flux(fluxname)
+      
+      Call Agrif_FluxCorrect(Flux, procname)
+
+      
+      End Subroutine Agrif_Flux_Correction
+
+
+      
+      Subroutine Agrif_Declare_Profile_flux(profilename,posvar,
+     &    firstpoint,raf)
+      character*(*) :: profilename
+      Type(Agrif_Profile), Pointer :: newprofile
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf      
+      INTEGER :: dimensio
+            
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newprofile)
+      Allocate(newprofile%posvar(dimensio))
+      Allocate(newprofile%interptab(dimensio))
+      newprofile%profilename = profilename
+      newprofile%interptab = raf
+      newprofile%nbdim = dimensio
+      newprofile%posvar = posvar
+      newprofile%point(1:dimensio) = firstpoint
+      
+      newprofile % nextprofile => Agrif_myprofiles
+      
+      Agrif_myprofiles => newprofile
+      
+      End Subroutine Agrif_Declare_Profile_flux
+
+      Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic)
+      integer :: tabvarsindic0, tabvarsindic
+      integer :: dimensio
+              
+      dimensio =  Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim
+      
+      select case(dimensio)
+      case(2)
+          call Agrif_Save_ForRestore2D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2,
+     &      tabvarsindic)
+      case(3)
+          call Agrif_Save_ForRestore3D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3,
+     &      tabvarsindic)
+      case(4)
+          call Agrif_Save_ForRestore4D(
+     &      Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4,
+     &      tabvarsindic)     
+      end select
+
+      Return
+      End Subroutine Agrif_Save_ForRestore0D 
+      
+    
+      
+      Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic)
+      real,dimension(:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+      if (.not.allocated(tabvars%var%array2)) then      
+      allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2)))
+      endif
+      tabvars%var%array2 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore2D  
+      
+      Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic)
+      real,dimension(:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif      
+
+      if (.not.allocated(tabvars%var%array3)) then
+      allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3)))
+      endif
+      tabvars%var%array3 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore3D
+      
+      Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic)
+      real,dimension(:,:,:,:) :: q
+      integer :: tabvarsindic, indic
+      TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars    
+ 
+       indic = tabvarsindic
+      if (tabvarsindic >=0) then
+        if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then
+          indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0
+        endif
+      endif
+      
+      if (indic <=0) then
+      tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+      roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+      else
+      tabvars=>Agrif_Curgrid % tabvars(indic)
+      roottabvars => Agrif_Mygrid % tabvars(indic)
+      endif
+
+      if (.not.allocated(tabvars%var%array4)) then         
+      allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1),
+     &                            tabvars%var%lb(2):tabvars%var%ub(2),
+     &                            tabvars%var%lb(3):tabvars%var%ub(3),
+     &                            tabvars%var%lb(4):tabvars%var%ub(4)))
+      endif
+      tabvars%var%array4 = q
+      roottabvars%var%restaure = .true.
+      
+      Return
+      End Subroutine Agrif_Save_ForRestore4D                   
+C
+      End module Agrif_bcfunction
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F	(revision 3437)
@@ -0,0 +1,1452 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module AGRIF_Clustering  
+C
+C
+      Module Agrif_Clustering 
+C
+CCC   Description:
+CCC   Module to create and initialize the grid hierarchy from the 
+CCC   AGRIF_FixedGrids.in file.
+C
+C     Modules used:
+C  
+      Use Agrif_Curgridfunctions 
+      Use Agrif_Init_Vars
+      Use Agrif_Save
+C             
+      IMPLICIT NONE
+C        
+      Contains 
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Cluster_All  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Cluster_All(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine for the clustering. A temporary grid hierarchy, pointed by 
+CCC   coarsegrid, is created.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments    
+      TYPE(AGRIF_grid)     ,pointer   :: g        ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer   :: coarsegrid
+C      
+C     Local pointer         
+      TYPE(AGRIF_lrectangle),pointer  :: parcours 
+      TYPE(AGRIF_grid)      ,pointer  :: newgrid 
+      REAL                            :: g_eps
+      INTEGER                         :: iii
+C      
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps = min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.                  
+C
+C     Necessary condition for clustering 
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                   (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C
+      Nullify(coarsegrid%childgrids)
+C
+      Call Agrif_ClusterGridnD(g,coarsegrid) 
+C
+      parcours => coarsegrid % childgrids                   
+C      
+      do while (associated(parcours))
+C      
+C       Newgrid is created. It is a copy of a fine grid created previously by
+C          clustering.      
+        Allocate(newgrid)
+C      
+        Nullify(newgrid%child_grids)
+C
+        do iii = 1 , Agrif_Probdim
+           newgrid % nb(iii) = (parcours % r % imax(iii) - 
+     &                          parcours % r % imin(iii)) *
+     &                          Agrif_Coeffref(iii)
+C        
+           newgrid % Agrif_x(iii) = g%Agrif_x(iii) + 
+     &                         (parcours %r % imin(iii) -1) 
+     &                         *g%Agrif_d(iii)
+C 
+           newgrid % Agrif_d(iii) = g%Agrif_d(iii) / Agrif_Coeffref(iii)
+C
+        enddo
+C
+        if ( Agrif_Probdim .EQ. 1 ) then
+           allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+           newgrid%tabpoint1D = 0
+        endif
+C
+        if ( Agrif_Probdim .EQ. 2 ) then
+           allocate(newgrid%tabpoint2D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1))
+           newgrid%tabpoint2D = 0      
+        endif
+C
+        if ( Agrif_Probdim .EQ. 3 ) then
+           allocate(newgrid%tabpoint3D(newgrid%nb(1)+1,
+     &                                 newgrid%nb(2)+1,
+     &                                 newgrid%nb(3)+1))
+           newgrid%tabpoint3D = 0
+        endif
+C       Points detection on newgrid
+        Call Agrif_TabpointsnD(Agrif_mygrid,newgrid) 
+C
+C       Recursive call to Agrif_Cluster_All            
+        Call Agrif_Cluster_All (newgrid, parcours % r)     
+C
+        parcours => parcours % next 
+C      
+        if ( Agrif_Probdim .EQ. 1 ) Deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim .EQ. 2 ) Deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim .EQ. 3 ) Deallocate(newgrid%tabpoint3D)
+C
+        Deallocate(newgrid)   
+C
+      enddo
+C
+C      
+      End Subroutine Agrif_Cluster_All
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_TabpointsnD
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_TabpointsnD(g,newgrid)
+C
+CCC   Description:
+CCC   Copy on newgrid of points detected on the grid hierarchy pointed by g.   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      TYPE(Agrif_Grid),pointer   :: g,newgrid
+C
+C     Local variables      
+      TYPE(Agrif_Pgrid),pointer  :: parcours
+C
+      REAL                  :: g_eps,newgrid_eps,eps
+      REAL   , DIMENSION(3) :: newmin,newmax
+      REAL   , DIMENSION(3) :: gmin,gmax
+      REAL   , DIMENSION(3) :: xmin
+      INTEGER, DIMENSION(3) :: igmin,inewmin
+      INTEGER, DIMENSION(3) :: inewmax
+      INTEGER               :: iii
+      INTEGER               :: i,j,k
+      INTEGER               :: i0,j0,k0
+C
+C     
+      parcours => g % child_grids
+C
+      do While(associated(parcours))
+        Call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+      enddo      
+C
+      g_eps = 10.
+      newgrid_eps = 10.
+C      
+      do iii = 1 , Agrif_probdim
+         g_eps = min( g_eps , g % Agrif_d(iii) )
+         newgrid_eps = min(newgrid_eps,newgrid%Agrif_d(iii))
+      enddo
+C
+      eps = min(g_eps,newgrid_eps)/100.                  
+C                   
+      do iii = 1 , Agrif_probdim
+         if (newgrid%Agrif_d(iii) .LT. (g%Agrif_d(iii)-eps)) Return
+C                   
+         gmin(iii) = g%Agrif_x(iii)
+         gmax(iii) = g%Agrif_x(iii) + g%nb(iii) * g%Agrif_d(iii)
+C 
+         newmin(iii) = newgrid%Agrif_x(iii)
+         newmax(iii) = newgrid%Agrif_x(iii) + newgrid%nb(iii) *
+     &                 newgrid%Agrif_d(iii)
+C      
+         if (gmax(iii) .LT. newmin(iii)) Return
+C
+         if (gmin(iii) .GT. newmax(iii)) Return
+C           
+         inewmin(iii) = 1 - floor(-(max(gmin(iii),newmin(iii))-
+     &                    newmin(iii))
+     &                   /newgrid%Agrif_d(iii)) 
+C          
+         xmin(iii) = newgrid%Agrif_x(iii) + (inewmin(iii)-1)*
+     &              newgrid%Agrif_d(iii)          
+C        
+         igmin(iii) = 1 + nint((xmin(iii)-gmin(iii))/g%Agrif_d(iii))
+C
+         inewmax(iii) = 1 + int((min(gmax(iii),newmax(iii))-
+     &                  newmin(iii))/newgrid%Agrif_d(iii))
+      enddo
+C                
+      if ( Agrif_probdim .EQ. 1 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max(
+     &                           newgrid%tabpoint1D(i),
+     &                           g%tabpoint1D(i0))
+         enddo
+         i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+      endif
+C
+      if ( Agrif_probdim .EQ. 2 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               newgrid%tabpoint2D(i,j) = max(
+     &                           newgrid%tabpoint2D(i,j),
+     &                           g%tabpoint2D(i0,j0))
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      if ( Agrif_probdim .EQ. 3 ) then
+         i0 = igmin(1)
+         do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+               k0 = igmin(3)
+               do k = inewmin(3),inewmax(3)
+                  newgrid%tabpoint3D(i,j,k) = max(
+     &                           newgrid%tabpoint3D(i,j,k),
+     &                           g%tabpoint3D(i0,j0,k0))
+                  k0 = k0 + int(newgrid%Agrif_d(3)/g%Agrif_d(3))
+               enddo                                        
+               j0 = j0 + int(newgrid%Agrif_d(2)/g%Agrif_d(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_d(1)/g%Agrif_d(1))
+         enddo
+      endif
+C
+      Return
+C
+C
+      End Subroutine Agrif_TabpointsnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusterGridnD
+C     **************************************************************************
+C      
+      Subroutine Agrif_ClusterGridnD(g,coarsegrid)
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by g.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Pointer arguments
+      TYPE(AGRIF_grid)     ,pointer  :: g          ! Pointer on the current grid
+      TYPE(AGRIF_rectangle),pointer  :: coarsegrid
+C
+C     Local variables      
+      TYPE(Agrif_rectangle) :: newrect
+      TYPE(Agrif_Variable)  :: newflag
+C
+      INTEGER               :: i,j,k
+      INTEGER ,DIMENSION(3) :: sx
+      INTEGER               :: bufferwidth,flagpoints
+      INTEGER               :: n1,n2,m1,m2,o1,o2
+      INTEGER               :: iii
+C
+C      
+      bufferwidth = int(Agrif_Minwidth/5.)
+C      
+      do iii = 1 , Agrif_probdim
+         sx(iii) = g % nb(iii) + 1
+      enddo
+C                  
+      if ( Agrif_probdim .EQ. 1 ) then
+         allocate(newflag%iarray1(sx(1)))
+         newflag%iarray1 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 2 ) then
+         allocate(newflag%iarray2(sx(1),sx(2)))
+         newflag%iarray2 = 0      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+         newflag%iarray3 = 0      
+      endif
+C
+      flagpoints = 0 
+C      
+      if (bufferwidth>0) then 
+C      
+         if ( Agrif_probdim .EQ. 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               if (g % tabpoint1D(i) .EQ. 1) then
+                  m1 = i - bufferwidth + 1
+                  m2 = i + bufferwidth - 1                  
+                  flagpoints = flagpoints + 1
+                  newflag%iarray1(m1:m2)=1 
+               endif 
+            enddo    
+         endif
+C
+        if ( Agrif_probdim .EQ. 2 ) then
+           do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  if (g % tabpoint2D(i,j) .EQ. 1) then
+                     n1 = j - bufferwidth + 1
+                     n2 = j + bufferwidth - 1
+                     m1 = i - bufferwidth + 1
+                     m2 = i + bufferwidth - 1                  
+                     flagpoints = flagpoints + 1
+                     newflag%iarray2(m1:m2,n1:n2)=1 
+                  endif  
+               enddo    
+            enddo
+         endif
+C
+        if ( Agrif_probdim .EQ. 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1      
+               do j = bufferwidth,sx(2)-bufferwidth+1
+                  do k = bufferwidth,sx(3)-bufferwidth+1
+                     if (g % tabpoint3D(i,j,k) .EQ. 1) then
+                        o1 = k - bufferwidth + 1
+                        o2 = k + bufferwidth - 1
+                        n1 = j - bufferwidth + 1
+                        n2 = j + bufferwidth - 1
+                        m1 = i - bufferwidth + 1
+                        m2 = i + bufferwidth - 1                  
+                        flagpoints = flagpoints + 1
+                        newflag%iarray3(m1:m2,n1:n2,o1:o2)=1 
+                     endif 
+                  enddo  
+               enddo    
+            enddo
+        endif
+      else
+          flagpoints = 1       
+C
+          if ( Agrif_probdim .EQ. 1 ) then
+          newflag%iarray1 = g % tabpoint1D
+          endif
+          if ( Agrif_probdim .EQ. 2 ) then
+          newflag%iarray2 = g % tabpoint2D
+          endif
+          if ( Agrif_probdim .EQ. 3 ) then
+          newflag%iarray3 = g % tabpoint3D
+          endif
+      endif
+C       
+      if (flagpoints .EQ. 0) then       
+          if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1) 
+          if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2) 
+          if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3) 
+          Return 
+      endif       
+C      
+      do iii = 1 , Agrif_probdim
+         newrect % imin(iii) = 1
+         newrect % imax(iii) = sx(iii)
+      enddo
+C      
+      Call Agrif_Clusternd(newflag,
+     &                     coarsegrid%childgrids,newrect) 
+C      
+      if ( Agrif_probdim .EQ. 1 ) deallocate(newflag%iarray1)
+      if ( Agrif_probdim .EQ. 2 ) deallocate(newflag%iarray2)
+      if ( Agrif_probdim .EQ. 3 ) deallocate(newflag%iarray3)
+C  
+C    
+      End Subroutine Agrif_ClusterGridnD
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ClusternD
+C     **************************************************************************
+C
+      Recursive subroutine Agrif_Clusternd(flag,boxlib,oldB) 
+C
+CCC   Description:
+CCC   Clustering on the grid pointed by oldB.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments  
+      TYPE(Agrif_rectangle) ::  oldB    
+      TYPE(Agrif_Variable)  :: flag
+c      INTEGER,DIMENSION(oldB%imin(1):oldB%imax(1),
+c     &                  oldB%imin(2):oldB%imax(2)) :: flag
+      TYPE(Agrif_lrectangle),pointer :: boxlib      
+C
+C     Local variables      
+      TYPE(Agrif_lrectangle),pointer :: tempbox,parcbox,parcbox2       
+      TYPE(Agrif_rectangle) :: newB,newB2
+      INTEGER :: i,j,k,iii
+      INTEGER,DIMENSION(:),allocatable :: i_sig 
+      INTEGER,DIMENSION(:),allocatable :: j_sig       
+      INTEGER,DIMENSION(:),allocatable :: k_sig       
+      INTEGER,DIMENSION(3) :: ipu,ipl
+      INTEGER,DIMENSION(3) :: istr,islice
+      REAL :: cureff
+      REAL :: neweff
+      INTEGER :: ValMax,ValSum,TailleTab
+      INTEGER :: nbpoints,nbpointsflag  
+      LOGICAL :: test
+C          
+      allocate(i_sig(oldB%imin(1):oldB%imax(1)))
+      if ( Agrif_probdim .GE. 2 ) 
+     & allocate(j_sig(oldB%imin(2):oldB%imax(2)))
+      if ( Agrif_probdim .EQ. 3 ) 
+     & allocate(k_sig(oldB%imin(3):oldB%imax(3)))
+C
+      test = .FALSE.
+      do iii = 1 , Agrif_probdim
+         test = test .OR. ( (oldB%imax(iii)-oldB%imin(iii)+1) 
+     &                    .LT. Agrif_Minwidth)
+      enddo
+      if ( test ) Return
+C     
+      if ( Agrif_probdim .EQ. 1 ) i_sig = flag%iarray1
+      if ( Agrif_probdim .EQ. 2 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+           i_sig(i) = SUM(flag%iarray2(i,
+     &                            oldB%imin(2):oldB%imax(2)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+           j_sig(j) = SUM(flag%iarray2(
+     &                            oldB%imin(1):oldB%imax(1),j))
+         enddo      
+      endif
+      if ( Agrif_probdim .EQ. 3 ) then
+         do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,
+     &                            oldB%imin(2):oldB%imax(2),
+     &                            oldB%imin(3):oldB%imax(3)))
+         enddo
+         do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),j,
+     &                          oldB%imin(3):oldB%imax(3)))
+         enddo
+         do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(
+     &                          oldB%imin(1):oldB%imax(1),
+     &                          oldB%imin(2):oldB%imax(2),k))
+         enddo      
+      endif
+C                    
+      do iii = 1 , Agrif_probdim
+         ipl(iii) = oldB%imin(iii)
+         ipu(iii) = oldB%imax(iii)
+      enddo
+C           
+      Call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     &   Call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))      
+      if ( Agrif_probdim .EQ. 3 ) 
+     &   Call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))      
+C     
+      test = .TRUE.
+      do iii = 1 , Agrif_probdim
+         test = test .AND. (ipl(iii).EQ.oldB%imin(iii))
+         test = test .AND. (ipu(iii).EQ.oldB%imax(iii))
+      enddo
+      
+      if (.NOT. test) then 
+          do iii = 1 , Agrif_probdim
+             newB%imin(iii) = ipl(iii)
+             newB%imax(iii) = ipu(iii)
+          enddo
+C        
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))   
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2)))   
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),
+     &                           newB%imin(2):newB%imax(2),   
+     &                           newB%imin(3):newB%imax(3)))
+C   
+          if ( Agrif_probdim .EQ. 1 ) 
+     &       TailleTab = newB%imax(1)-newB%imin(1)+1
+          if ( Agrif_probdim .EQ. 2 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)
+          if ( Agrif_probdim .EQ. 3 ) 
+     &       TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                   (newB%imax(2)-newB%imin(2)+1)*
+     &                   (newB%imax(3)-newB%imin(3)+1)
+C
+          neweff = REAL(nbpoints)/TailleTab
+C     
+          if (nbpoints.GT.0) then
+C        
+              if ((neweff .GT .Agrif_efficiency)) then
+                  Call Agrif_Add_Rectangle(newB,boxlib)
+                  Return
+              else
+C            
+                  tempbox => boxlib
+                  newB2 = newB
+                  Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C     
+C                 Compute new efficiency
+C
+                  cureff = neweff
+                  parcbox2 => boxlib
+                  nbpoints = 0
+                  nbpointsflag = 0
+C
+                  do While (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) Exit
+                    newB = parcbox2%r
+C
+                    if ( Agrif_probdim .EQ. 1 ) Valsum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim .EQ. 2 ) Valsum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim .EQ. 3 ) Valsum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                    nbpointsflag = nbpointsflag + ValSum
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next  
+                  enddo  
+C coefficient 1.05 avant 1.15 possibilité de laisser choix à l utilisateur
+                  if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &                 .LT.(1.0001*cureff)) then
+                      parcbox2 => boxlib            
+                      do While (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) Exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next             
+                      enddo      
+                      boxlib => tempbox
+                      Call Agrif_Add_Rectangle(newB2,boxlib)
+                      Return
+                  endif
+              endif         
+          endif
+          Return
+      endif 
+C       
+      do iii = 1 , Agrif_Probdim
+         istr(iii) = oldB%imax(iii)
+         islice(iii) = oldB%imin(iii)
+      enddo     
+C      
+      Call Agrif_Clusterslice(i_sig,islice(1),istr(1)) 
+      if ( Agrif_probdim .GE. 2 ) 
+     & Call Agrif_Clusterslice(j_sig,islice(2),istr(2)) 
+      if ( Agrif_probdim .EQ. 3 ) 
+     & Call Agrif_Clusterslice(k_sig,islice(3),istr(3)) 
+C      
+      ValSum = 0
+      do iii = 1 , Agrif_Probdim
+         Valsum = valSum + islice(iii)
+      enddo
+C      
+      if ( Valsum .EQ. -Agrif_Probdim ) then 
+          Call Agrif_Add_Rectangle(oldB,boxlib) 
+          Return 
+      endif 
+C       
+      nullify(tempbox)
+      tempbox => boxlib
+      if ( Agrif_probdim .EQ. 1 ) 
+     &      cureff  = oldB%imax(1)-oldB%imin(1)+1
+      if ( Agrif_probdim .EQ. 2 ) 
+     &      cureff  = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)
+      if ( Agrif_probdim .EQ. 3 ) 
+     &       cureff = (oldB%imax(1)-oldB%imin(1)+1)*
+     &                (oldB%imax(2)-oldB%imin(2)+1)*
+     &                (oldB%imax(3)-oldB%imin(3)+1)
+      Nullify(parcbox)
+C 
+      do iii = 1 , Agrif_Probdim
+          newB%imax(iii) = oldB%imax(iii)            
+          newB%imin(iii) = oldB%imin(iii)
+      enddo     
+C
+      ValMax = 0
+      do iii = 1 , Agrif_Probdim
+         ValMax = Max(ValMax,istr(iii))
+      enddo
+C
+      if (istr(1) .EQ. ValMax ) then
+          newB%imax(1) = islice(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)                   
+          newB%imin(1) = islice(1)+1
+          newB%imax(1) = oldB%imax(1)
+          Call Agrif_Add_Rectangle(newB,parcbox)
+      elseif ( Agrif_probdim .GE. 2 ) then
+         if (istr(2) .EQ. ValMax ) then
+            newB%imax(2) = islice(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         elseif ( Agrif_probdim .EQ. 3 ) then
+            newB%imax(3) = islice(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            Call Agrif_Add_Rectangle(newB,parcbox)
+         endif
+      endif
+C      
+      do While (associated(parcbox))
+        newB = parcbox%r            
+C
+        if ( Agrif_probdim .EQ. 1 ) nbpoints = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim .EQ. 2 ) nbpoints = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim .EQ. 3 ) nbpoints = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C      
+       if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+       if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+       if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+        neweff = REAL(nbpoints) / TailleTab
+C     
+        if (nbpoints .GT. 0) then
+C      
+            if ((neweff .GT .Agrif_efficiency)) then
+                Call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                Call Agrif_Clusternd(flag,
+     &                      boxlib,newB)
+C
+C               Compute new efficiency
+C
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+C
+                do While (associated(parcbox2))
+                  if (associated(parcbox2,tempbox)) Exit
+                  newB = parcbox2%r
+C
+                  if ( Agrif_probdim .EQ. 1 ) ValSum = 
+     &                                 SUM(flag%iarray1(
+     &                                 newB%imin(1):newB%imax(1)))
+                  if ( Agrif_probdim .EQ. 2 ) ValSum = 
+     &                                 SUM(flag%iarray2(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2)))
+                  if ( Agrif_probdim .EQ. 3 ) ValSum = 
+     &                                 SUM(flag%iarray3(
+     &                                 newB%imin(1):newB%imax(1),
+     &                                 newB%imin(2):newB%imax(2),
+     &                                 newB%imin(3):newB%imax(3)))
+C
+                  nbpointsflag = nbpointsflag + ValSum
+C
+                    if ( Agrif_probdim .EQ. 1 ) 
+     &                 TailleTab = newB%imax(1)-newB%imin(1)+1
+                    if ( Agrif_probdim .EQ. 2 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim .EQ. 3 ) 
+     &                 TailleTab = (newB%imax(1)-newB%imin(1)+1)*
+     &                             (newB%imax(2)-newB%imin(2)+1)*
+     &                             (newB%imax(3)-newB%imin(3)+1)
+
+                  nbpoints = nbpoints + TailleTab
+C              
+                  parcbox2 => parcbox2%next  
+                enddo   
+C            
+                if  (REAL(nbpointsflag)/REAL(nbpoints)
+     &               .LT.(1.15*cureff)) then
+                    parcbox2 => boxlib            
+                    do While (associated(parcbox2))
+                      if (associated(parcbox2,tempbox)) Exit
+                      deallocate(parcbox2%r)
+                      parcbox2 => parcbox2%next             
+                    enddo
+                    boxlib => tempbox
+                    Call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+      enddo
+C      
+C      
+      Return
+C      
+      End Subroutine Agrif_Clusternd 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterslice
+C     **************************************************************************
+C                           
+      Subroutine Agrif_Clusterslice(sig,slice,str) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments 
+      INTEGER                      :: slice,str
+      INTEGER,DIMENSION(slice:str) :: sig 
+C
+C     Local variables      
+      INTEGER                      :: ideb,ifin
+      INTEGER                      :: i,t,a,di,ts 
+      INTEGER,DIMENSION(slice:str) :: lap 
+C
+C    
+      ideb = slice
+      ifin = str
+C    
+      if (SIZE(sig) <= 2*Agrif_Minwidth) then
+          str = -1 
+          slice = -1 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C
+      do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+          if (sig(i) .EQ. 0) then
+              if ((i-ideb) < (ifin-i)) then
+                  di = i - ideb
+                else 
+                  di = ifin - i 
+              endif
+C
+              if (di > t) then
+                a = i 
+                t = di 
+              endif
+         endif
+      enddo
+C      
+      if (a .NE. (-1)) then
+          slice = a 
+          str = t 
+          Return
+      endif
+C      
+      t = -1 
+      a = -1 
+C      
+      do i = ideb+1,ifin-1 
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) 
+      enddo
+C      
+      do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) .LE. 0) then
+            ts = ABS(lap(i+1) - lap(i)) 
+            if (ts > t) then
+                t = ts 
+                a = i
+            endif
+       endif
+      enddo
+C      
+      if (a .EQ. (ideb + Agrif_Minwidth - 1)) then
+          a = -1
+          t = -1
+      endif
+C      
+      slice = a 
+      str = t 
+C
+C      
+      End Subroutine Agrif_Clusterslice       
+C
+C
+C    
+C     **************************************************************************
+CCC   Subroutine Agrif_Clusterprune
+C     **************************************************************************
+C      
+      Subroutine Agrif_Clusterprune(sig,pl,pu) 
+C
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C     Arguments
+      INTEGER                  :: pl,pu 
+      INTEGER,DIMENSION(pl:pu) :: sig
+C
+C     Local variables      
+      INTEGER :: ideb,ifin       
+      INTEGER :: diff,addl,addu,udist,ldist  
+C
+C      
+      ideb = pl
+      ifin = pu
+C      
+      if (SIZE(sig) <= Agrif_Minwidth) then
+          return 
+      endif 
+C       
+      do While ((sig(pl) .EQ. 0) .AND. (pl < ifin)) 
+        pl = pl + 1 
+      enddo 
+C       
+      do While ((sig(pu) .EQ. 0) .AND. (pu > ideb)) 
+        pu = pu - 1 
+      enddo 
+C       
+      if ((pu-pl) < Agrif_Minwidth) then
+          diff = Agrif_Minwidth - (pu - pl + 1) 
+          udist = ifin - pu 
+          ldist = pl - ideb
+          addl = diff / 2 
+          addu = diff - addl 
+          if (addu > udist) then
+              addu = udist 
+              addl = diff - addu 
+          endif
+C         
+          if (addl > ldist) then
+              addl = ldist 
+              addu = diff - addl
+          endif
+C         
+          pu = pu + addu 
+          pl = pl - addl         
+C      
+      endif 
+C       
+C
+      End Subroutine Agrif_Clusterprune
+C
+C
+C              
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_Rectangle 
+C     **************************************************************************
+C        
+      Subroutine Agrif_Add_Rectangle(R,LR)
+C
+CCC   Description:
+CCC   Subroutine to add the Agrif_Rectangle R in a list managed by LR.
+C
+C     Declarations:
+C
+C     Arguments               
+      TYPE(AGRIF_rectangle)           :: R  
+      TYPE(AGRIF_lrectangle), Pointer :: LR
+C
+C     Local variable        
+      TYPE(AGRIF_lrectangle), Pointer :: newrect  
+C
+      INTEGER                         :: iii 
+C
+C        
+      allocate(newrect)
+      allocate(newrect % r)
+C
+      newrect % r = R
+C      
+      do iii = 1 , Agrif_Probdim
+         newrect % r % spaceref(iii) = Agrif_Coeffref(iii)
+         newrect % r % timeref(iii) = Agrif_Coeffreft(iii)
+      enddo
+C              
+      newrect % r % number = -1            
+      Nullify(newrect % r % childgrids)
+      newrect % next => LR  
+      LR => newrect  
+C
+C      
+      End Subroutine Agrif_Add_Rectangle   
+C  
+C
+C  
+C     **************************************************************************
+CCC   Subroutine Agrif_Read_Fix_Grd  
+C     **************************************************************************
+C      
+      Recursive Subroutine Agrif_Read_Fix_Grd(coarsegrid,j,nunit)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from the reading of the 
+CCC   AGRIF_FixedGrids.in file.
+C
+CC    Method:
+CC    Recursive subroutine and creation of a first grid hierarchy from the
+CC    reading of the AGRIF_FixedGrids.in file.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_rectangle), Pointer   :: coarsegrid ! Pointer on the first grid
+                                                     ! of the grid hierarchy
+C                                    
+C     Scalar arguments                                    
+      INTEGER                          :: j          ! Number of the new grid
+      INTEGER                          :: nunit      ! unit associated with file
+C      
+C     Local variables      
+      TYPE(AGRIF_rectangle)            :: newrect    ! Pointer on a new grid   
+      TYPE(AGRIF_lrectangle), Pointer  :: parcours   ! Pointer for the recursive
+                                                     !    procedure
+      TYPE(AGRIF_lrectangle), Pointer  :: newlrect
+      TYPE(AGRIF_lrectangle), Pointer  :: end_list       
+      INTEGER                          :: i          ! for each child grid
+      INTEGER                          :: nb_grids   ! Number of child grids
+      INTEGER                          :: iii
+C          
+C
+      Nullify(newrect%childgrids)
+C      
+C     Reading of the number of child grids        
+      read(nunit,*) nb_grids
+C      
+C     coarsegrid%nbgridchild = nb_grids
+C      
+      allocate(end_list)
+C
+      nullify(end_list % r)
+      nullify(end_list % next)
+C      
+      coarsegrid % childgrids => end_list
+C
+C     Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+C        time refinement factors for each child grid.
+C     Creation and addition of the new grid to the grid hierarchy. 
+C
+      do i = 1,nb_grids
+        allocate(newlrect)      
+        newrect % number = j   ! Number of the grid
+C
+        if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1),newrect % timeref(2),
+     &                    newrect % timeref(3)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1),newrect % timeref(2)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+        else
+           if (Agrif_Probdim == 3) then  
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % imin(2), newrect % imax(2),
+     &                    newrect % imin(3), newrect % imax(3),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % spaceref(3),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 2) then            
+            read(nunit,*) newrect % imin(1),newrect % imax(1),
+     &                  newrect % imin(2),newrect % imax(2),
+     &                    newrect % spaceref(1),newrect % spaceref(2),
+     &                    newrect % timeref(1)
+           elseif (Agrif_Probdim == 1) then
+            read(nunit,*) newrect % imin(1), newrect % imax(1),
+     &                    newrect % spaceref(1),
+     &                    newrect % timeref(1)
+           endif
+C
+           if ( Agrif_probdim .GE. 2 ) then
+              do iii = 2 , Agrif_probdim
+                 newrect % timeref(iii) = newrect % timeref(1) 
+              enddo
+           endif
+C
+        endif
+C
+C       Addition to the grid hierarchy
+C
+        nullify(newrect % childgrids)
+        j = j + 1
+        Allocate(newlrect%r)
+        newlrect % r = newrect 
+        nullify(newlrect % next)
+        end_list % next => newlrect
+        end_list => end_list % next
+      enddo
+C      
+      coarsegrid % childgrids => coarsegrid % childgrids % next
+      parcours => coarsegrid % childgrids
+C
+C     Recursive operation to create the grid hierarchy branch by branch
+C
+      do while (associated(parcours))
+        call Agrif_Read_Fix_Grd (parcours % r,j,nunit)
+        parcours => parcours % next
+      enddo
+C      
+C
+      End Subroutine Agrif_Read_Fix_Grd        
+C        
+C 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_Grids  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Create_Grids(g,coarsegrid)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy (g) from the one created with the
+CCC   Agrif_Read_Fix_Grd or Agrif_Cluster_All procedures (coarsegrid).
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer arguments        
+      TYPE(AGRIF_grid)     , Pointer  :: g          ! Pointer on the root coarse
+                                                    ! grid
+      TYPE(AGRIF_rectangle), Pointer  :: coarsegrid ! Pointer on the root coarse
+                                                    ! grid of the grid hierarchy
+                                                    ! created with the
+                                                    ! Agrif_Read_Fix_Grd
+                                                    ! subroutine
+C
+C     Local pointers
+      TYPE(Agrif_grid)      , Pointer :: newgrid    ! New grid
+      TYPE(Agrif_pgrid)     , Pointer :: newpgrid
+      TYPE(Agrif_pgrid)     , Pointer :: parcours2
+      TYPE(Agrif_lrectangle), Pointer :: parcours
+      TYPE(Agrif_pgrid)     , Pointer :: end_list
+      TYPE(Agrif_pgrid)     , Pointer :: parcours3
+C
+C     Local scalars      
+      LOGICAL                         :: nullliste
+      INTEGER                         :: iii
+      INTEGER                         :: moving_grid_id = 0      
+
+C
+      parcours3 => g % child_grids
+C     
+      if (associated(parcours3)) then
+          do While (associated(parcours3 % next))
+            parcours3 => parcours3 % next
+          enddo
+          end_list => parcours3
+          nullliste=.FALSE.
+        else
+          allocate(end_list)
+          nullify(end_list % gr)
+          nullify(end_list % next)      
+          g % child_grids => end_list 
+          parcours3 => end_list      
+          nullliste=.TRUE.
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C      
+C     Creation of the grid hierarchy from the one created by using the 
+C     Agrif_Read_Fix_Grd subroutine 
+C
+      do while (associated(parcours))
+        allocate(newgrid)        
+        moving_grid_id=moving_grid_id+1
+        newgrid % grid_id = moving_grid_id
+        do iii = 1 , Agrif_Probdim
+           newgrid % spaceref(iii) = parcours % r % spaceref(iii)
+           newgrid % timeref(iii) = parcours % r % timeref(iii)
+        enddo
+C
+        do iii = 1 , Agrif_Probdim
+          newgrid % nb(iii) = (parcours % r % imax(iii) 
+     &                       - parcours % r % imin(iii)) 
+     &                       * parcours % r % spaceref(iii)
+C     
+          newgrid % ix(iii) =  parcours % r % imin(iii)
+C
+          newgrid % Agrif_d(iii) = g % Agrif_d(iii) 
+     &                  / REAL(newgrid % spaceref(iii))
+C
+          newgrid % Agrif_x(iii) = g % Agrif_x(iii) +
+     &      (parcours % r % imin(iii) - 1)* g % Agrif_d(iii)
+C      
+        enddo
+C
+C       Pointer on the parent grid                        
+C
+        newgrid % parent => g      
+
+C       Level of the current grid
+        newgrid % level = newgrid % parent % level + 1
+        if (newgrid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = newgrid%level
+        endif
+
+C      
+C       Grid pointed by newgrid is a fixed grid      
+C
+        if (parcours % r % number .GT. 0) then      
+            newgrid % fixed = .true.  
+          else
+            newgrid % fixed = .false.
+        endif
+C
+C       Number of the grid pointed by newgrid
+        newgrid % fixedrank = parcours % r % number
+C           
+C       No time calculation on this grid         
+        newgrid % ngridstep = 0      
+C
+C       Test indicating if the current grid has a common border with the root 
+C       coarse grid in the x direction
+        do iii = 1 , Agrif_Probdim
+           newgrid % NearRootBorder(iii) = .FALSE.
+C        
+           if ((newgrid % parent % NearRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) == 1)) then
+               newgrid % NearRootBorder(iii) = .TRUE.
+           endif
+C
+           newgrid % DistantRootBorder(iii) = .FALSE.
+C 
+           if ((newgrid % parent % DistantRootBorder(iii)) .AND. 
+     &         (newgrid % ix(iii) + 
+     &         (newgrid % nb(iii)/newgrid % spaceref(iii))  
+     &          - 1  == newgrid % parent % nb(iii))) then
+               newgrid % DistantRootBorder(iii) = .TRUE.
+           endif
+        enddo
+C
+C       Writing in output files
+C
+        newgrid % oldgrid = .FALSE.      
+C
+C     
+C       Definition of the CHARACTERistics of the variable of the grid pointed by
+C       newgrid 
+        Call Agrif_Create_Var (newgrid)
+C      
+C       Instanciation of the grid pointed by newgrid and its variables
+        Call Agrif_Instance (newgrid)
+C       
+C       Nullify the variable of the grid pointed by newgrid
+C
+C
+C       Addition of this grid to the grid hierarchy 
+C      
+        nullify(newgrid % child_grids)
+        allocate(newpgrid)  
+        newpgrid % gr => newgrid
+        nullify(newpgrid % next)
+        end_list % next => newpgrid
+        end_list => end_list % next               
+        parcours => parcours % next
+C
+C       Updating the total number of fixed grids
+        if (newgrid % fixed) then
+            AGRIF_nbfixedgrids = AGRIF_nbfixedgrids + 1
+        endif
+C                  
+      enddo
+C
+C
+      if (nullliste) then
+          g % child_grids => g % child_grids % next
+          parcours2 => g % child_grids
+          deallocate(parcours3)
+        else
+          parcours2 => parcours3 % next
+      endif
+C      
+      parcours => coarsegrid % childgrids
+C
+C     Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the
+C     grid hierarchy
+C      
+      do while (associated(parcours))
+        Call Agrif_Create_Grids (parcours2 % gr,parcours % r)
+        parcours => parcours % next
+        parcours2 => parcours2 % next
+      enddo 
+C      
+      Return      
+C                  
+      End Subroutine Agrif_Create_Grids
+C
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Hierarchy  
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Init_Hierarchy(g) 
+C
+CCC   Description:
+CCC   Subroutine to initialize all the grids except the root coarse grid (this 
+CCC   one, pointed by AGRIF_mygrid, is initialized by the subroutine 
+CCC   Agrif_Init_Grids defi ned in the module Agrif_Util and called in the main 
+CCC   program ). 
+C
+CC    Method:
+CC    Recursive subroutine.        
+C
+C     Declarations:
+C
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: g         ! Pointer on the root coarse grid 
+C      
+C     Local variables      
+      TYPE(AGRIF_pgrid), Pointer :: parcours  ! Pointer for the recursive call
+      LOGICAL                    :: Init_Hierarchy
+C      
+C
+      parcours=>g%child_grids
+C      
+      do while (associated(parcours))
+        Init_Hierarchy = .false.
+        if ( AGRIF_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &       AGRIF_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+           if ((parcours%gr%fixed) 
+     &         .AND. (Agrif_mygrid%ngridstep == 0)) then
+              Init_Hierarchy = .true.
+           endif      
+       endif
+C
+       if (.NOT. parcours%gr%fixed) Init_Hierarchy = .true.
+       if (parcours % gr % oldgrid) Init_Hierarchy = .false.
+C
+       if (Init_Hierarchy) then 
+C
+C           Instanciation of the grid pointed by parcours%gr and its variables 
+            Call Agrif_Instance (parcours % gr)
+C    
+C           Allocation of the arrays containing values of the variables of the
+C           grid pointed by parcours%gr      
+C      
+            Call Agrif_Allocation (parcours % gr)   
+C            
+            Call Agrif_initialisations(parcours % gr)              
+C       
+            Call Agrif_Instance(parcours % gr)
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+              Call Agrif_Allocate_Restore (parcours % gr)
+            endif
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C              Initialization by copy of the grids created by clustering 
+               Call AGRIF_CopyFromold_All (parcours%gr,
+     &                                     Agrif_oldmygrid)
+            endif
+C
+C           Initialization by interpolation 
+C           (this routine is written by the user) 
+            Call Agrif_InitValues()
+C
+            if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+               Call Agrif_Free_Restore (parcours % gr)
+            endif
+C
+       endif                                  
+       parcours => parcours % next 
+C         
+      enddo
+C
+      parcours => g % child_grids
+C      
+C     Recursive operation to initialize all the grids
+      do while (associated(parcours))
+        Call Agrif_Init_Hierarchy (parcours%gr)
+        parcours => parcours%next
+      enddo
+C      
+      End Subroutine Agrif_Init_Hierarchy 
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocate_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Allocate_Restore(Agrif_Gr)
+C      
+C      
+C     Modules used:
+C
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+C     
+      INTEGER                    :: i
+C
+        do i = 1 , Agrif_NbVariables
+            if ( Agrif_Mygrid%tabvars(i)%var % restaure ) then
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 1 ) then    
+            Allocate( Agrif_Gr%tabvars(i)%var%  
+     &    Restore1D(lbound(Agrif_Gr%tabvars(i)%var%array1,1) 
+     &    :ubound(Agrif_Gr%tabvars(i)%var%array1,1))) 
+            Agrif_Gr%tabvars(i)%var%Restore1D = 0
+C
+            endif
+            if ( Agrif_Gr%tabvars(i)%var % nbdim .EQ. 2 ) then
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore2D(  
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,1):         
+     &      ubound(Agrif_Gr%tabvars(i)%var%array2,1),         
+     &      lbound(Agrif_Gr%tabvars(i)%var%array2,2)          
+     &      :ubound(Agrif_Gr%tabvars(i)%var%array2,2)))         
+            Agrif_Gr%tabvars(i)%var%Restore2D = 0
+C
+            endif
+            if ( Agrif_Mygrid%tabvars(i)%var % nbdim .EQ. 3 ) then
+C     
+            Allocate( Agrif_Gr%tabvars(i)%var%Restore3D( 
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,1):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,1),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,2):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,2),        
+     &      lbound(Agrif_Gr%tabvars(i)%var%array3,3):        
+     &      ubound(Agrif_Gr%tabvars(i)%var%array3,3)))  
+            Agrif_Gr%tabvars(i)%var%Restore3D = 0
+            endif
+C 
+            endif
+          enddo
+C
+      Return
+C
+C      
+      End Subroutine Agrif_Allocate_Restore      
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_Restore  
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_Restore(Agrif_Gr)
+C
+C      
+C     Pointer argument      
+      TYPE(AGRIF_grid), Pointer  :: Agrif_Gr   ! Pointer on the root coarse grid
+      INTEGER :: i     
+C
+      do i = 1 , Agrif_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+C  
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore1D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore1D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore2D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore2D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore3D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore3D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore4D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore4D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore5D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore5D)
+            endif
+            if (associated(Agrif_Gr%tabvars(i)%var%Restore6D)) then
+               Deallocate(Agrif_Gr%tabvars(i)%var%Restore6D)
+            endif
+C 
+        endif
+      enddo
+C 
+      Return
+C
+C      
+      End Subroutine Agrif_Free_Restore
+C
+C
+C
+      End Module Agrif_Clustering
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F	(revision 3437)
@@ -0,0 +1,990 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_CurgridFunctions      
+C      
+      Module Agrif_CurgridFunctions    
+C  
+CCC   Description:
+CCC   Module to define some procedures concerning the current grid
+C
+C     Modules used: 
+C
+      Use Agrif_Init
+C
+      IMPLICIT NONE
+C
+C
+      Contains
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+CCC   Function Agrif_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_Rhot = float(res)
+C
+C
+      End function Agrif_rhot
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_IRhot
+C     **************************************************************************
+C
+      Function Agrif_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % timeref(iii))
+      enddo
+C
+      Agrif_IRhot = res
+C
+C
+      End function Agrif_IRhot
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_Rhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      REAL :: Agrif_Parent_Rhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_Rhot = float(res)
+C
+C
+      End function Agrif_Parent_Rhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_IRhot
+C     **************************************************************************
+C
+      Function Agrif_Parent_IRhot()
+C  
+CCC   Description:
+CCC   Function returning the time refinement factor of the parent grid of the 
+CCC   current grid.
+C
+C     Declarations:
+C  
+      
+C
+      INTEGER :: Agrif_Parent_IRhot  ! Result
+C
+C     Local scalar      
+      INTEGER :: res         ! Intermediate result
+      INTEGER :: iii
+C
+C
+      res=1
+C
+      do iii = 1 , Agrif_Probdim
+         res = max(res, AGRIF_Curgrid % parent % timeref(iii))
+      enddo
+C
+      Agrif_Parent_IRhot = res
+C
+C
+      End function Agrif_Parent_IRhot      
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_nbstepint  ! result
+C
+C
+      Agrif_nbstepint = mod(AGRIF_CURGRID % ngridstep,
+     &                      int(AGRIF_rhot()))
+C
+C
+      End function Agrif_Nbstepint
+C
+C
+C
+CC    **************************************************************************
+CCC   Function Agrif_Parent_Nbstepint
+C     **************************************************************************
+C
+      Function Agrif_Parent_Nbstepint()
+C  
+CCC   Description:
+CCC   Function for the calculation of the coefficients used for the time 
+CCC   interpolation (module Agrif_Boundary).
+C
+C     Declarations:
+C  
+      
+C            
+      INTEGER :: Agrif_Parent_Nbstepint  ! result
+C
+C
+      Agrif_Parent_Nbstepint = mod(AGRIF_CURGRID % parent % ngridstep, 
+     &                             int(AGRIF_Parent_Rhot()))
+C
+C
+      End function Agrif_Parent_Nbstepint
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.   
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderX 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderX
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderX()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the x direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(1) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderX                 
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderY
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderY
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderY()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the y direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(2) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderY      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpNearBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpNearBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a near border of 
+CCC   the current grid if this one has a common border with the root coarse 
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % NearRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpNearBorderZ
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpDistantBorderZ
+C     **************************************************************************
+C
+      Subroutine Agrif_InterpDistantBorderZ()
+C  
+CCC   Description:
+CCC   Subroutine allowing to interpole (in the z direction) on a distant border 
+CCC   of the current grid if this one has a common border with the root coarse  
+CCC   grid.
+C
+C     Declarations:
+C  
+      
+C
+C
+      AGRIF_CURGRID % DistantRootBorder(3) = .FALSE.             
+C
+C
+      End Subroutine Agrif_InterpDistantBorderZ
+C 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Nb_Step
+C     ************************************************************************** 
+C 
+      Function AGRIF_Parent_Nb_Step() 
+C  
+CCC   Description:
+CCC   Function returning the number of time steps of the parent grid of the
+CCC   current grid.
+C
+C     Declarations:
+C    
+      
+C
+      INTEGER :: AGRIF_Parent_Nb_Step ! Result 
+C
+C
+      if (Agrif_Root()) then  
+C     
+          Agrif_Parent_Nb_Step = -1 
+C       
+        else
+C       
+          Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+C     
+      endif
+C
+C     
+      End function Agrif_Parent_Nb_Step    
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Root
+C     **************************************************************************
+C
+      Function Agrif_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the current grid is or not the root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % fixedrank .EQ. 0) then
+C          
+          Agrif_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Root
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Root
+C     **************************************************************************
+C
+      Function Agrif_Parent_Root()
+C     
+CCC   Description:
+CCC   Function indicating if the parent grid of the current grid is or not the 
+CCC   root grid.
+C
+C     Declarations:
+C
+      
+C
+      LOGICAL :: Agrif_Parent_Root   ! Result
+C    
+C
+      if (AGRIF_CURGRID % parent % fixedrank .EQ. 0) then
+C          
+          Agrif_Parent_Root = .TRUE.
+C    
+        else
+C    
+          Agrif_Parent_Root = .FALSE.
+C     
+      endif
+C
+C    
+      End function Agrif_Parent_Root     
+C 
+C
+C 
+C     **************************************************************************
+CCC   Function Agrif_Fixed
+C     **************************************************************************
+C 
+      Function Agrif_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Fixed = Agrif_Curgrid % fixedrank 
+C
+        else
+C     
+         Agrif_Fixed = -1
+C        
+      endif
+C
+C     
+      End function Agrif_Fixed 
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Fixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      INTEGER Agrif_Parent_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Fixed = AGRIF_CURGRID % parent % fixedrank 
+C
+        else
+C     
+         Agrif_Parent_Fixed = 0
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % fixed) then
+C     
+          Agrif_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Is_Fixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Parent_Is_Fixed
+C     **************************************************************************
+ 
+      Function Agrif_Parent_Is_Fixed()
+C  
+CCC   Description:
+CCC   Function returning true if the parent grid of the current grid is fixed.
+C
+C     Declarations:
+C   
+      
+C
+      LOGICAL Agrif_Parent_Is_Fixed   ! Result 
+C 
+C
+      if (Agrif_Curgrid % parent % fixed) then
+C     
+          Agrif_Parent_Is_Fixed = .true.
+C
+        else
+C     
+          Agrif_Parent_Is_Fixed = .false.
+C        
+      endif
+C
+C     
+      End function Agrif_Parent_Is_Fixed            
+C
+C 
+C
+C     **************************************************************************
+CCC   Function AGRIF_CFixed
+C     **************************************************************************
+ 
+            Function AGRIF_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+           if (fixed .LE. 9) then
+C
+               write(cfixed,'(i1)')fixed
+C 
+           else
+C   
+               write(cfixed,'(i2)')fixed
+C      
+           endif
+C
+           AGrif_Cfixed=cfixed
+C      
+      else
+C
+      print*,'Call to AGRIF_CFixed() on a moving grid'
+      stop
+C
+      endif     
+
+      End function AGRIF_CFixed
+C
+C
+C
+C     **************************************************************************
+CCC   Function AGRIF_Parent_CFixed
+C     **************************************************************************
+ 
+      Function AGRIF_Parent_CFixed()
+C  
+CCC   Description:
+CCC   Function returning the number of the parent grid of the current grid.
+C
+C     Declarations:
+C   
+      
+C
+      CHARACTER(3) AGRIF_Parent_CFixed   ! Result 
+C
+C     Local variables      
+      CHARACTER(3) cfixed
+      INTEGER fixed
+C 
+C
+      fixed = Agrif_Parent_Fixed()
+C      
+      if(fixed.NE.-1) then
+C
+          if (fixed .LE. 9) then
+C
+              write(cfixed,'(i1)')fixed
+C      
+          else
+C        
+              write(cfixed,'(i2)')fixed
+C      
+          endif
+C
+          AGrif_Parent_Cfixed=cfixed
+C
+      else
+C
+      print*,'Illegal call to AGRIF_Parent_CFixed()'
+      stop     
+C
+      endif
+
+      End function AGRIF_Parent_CFixed      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ChildGrid_to_ParentGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ChildGrid_to_ParentGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the parent
+CCC   grid of the current grid.
+C
+C     Declarations:
+C  
+      
+C
+      
+      Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid
+C
+      Call Agrif_Instance(Agrif_Curgrid%parent)            
+C
+C
+      End Subroutine Agrif_ChildGrid_to_ParentGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_ParentGrid_to_ChildGrid
+C     **************************************************************************
+C
+      Subroutine Agrif_ParentGrid_to_ChildGrid()
+C  
+CCC   Description:
+CCC   Subroutine allowing to make the pointer AGRIF_CURGRID point on the child 
+CCC   grid after having called the Agrif_ChildGrid_to_ParentGrid subroutine.
+C
+C     Declarations:
+C  
+      
+C
+C
+      Call Agrif_Instance(Agrif_Curgrid%save_grid)
+C
+C
+      End Subroutine Agrif_ParentGrid_to_ChildGrid
+C
+C
+C
+C     **************************************************************************
+CCC   Function Agrif_Get_Unit
+C     **************************************************************************
+C
+      Function Agrif_Get_Unit()
+
+CCC   Description : return a unit not connected to any file
+C
+C     Declarations
+C
+      
+C
+      INTEGER Agrif_Get_Unit
+C
+C     Local scalars
+      INTEGER n
+      LOGICAL op
+C
+      INTEGER :: nunit
+      INTEGER :: iii,out,iiimax
+      Logical :: BEXIST
+      INTEGER,DIMENSION(1:1000) :: ForbiddenUnit
+C
+C
+C     Load forbidden Unit if the file Agrif_forbidenUnit exist
+C      
+
+      INQUIRE(FILE='Agrif_forbiddenUnit.txt',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+c          File Agrif_forbiddenUnit.txt not found
+      Else
+           nunit = 777
+           open(nunit,file='Agrif_forbiddenUnit.txt',form='formatted',
+     &          status="old")
+              iii = 1
+              do while ( .TRUE. )
+                 read(nunit,*,END = 99) ForbiddenUnit(iii)
+                 iii = iii + 1
+              enddo
+   99         CONTINUE
+              iiimax = iii
+           close(nunit)
+      endif     
+C 
+      do n = 7,1000
+C 
+        Inquire(Unit=n,Opened=op)
+C
+        out = 0
+        if ( BEXIST .AND. .NOT.op) then
+           do iii = 1 , iiimax
+              if ( n .EQ. ForbiddenUnit(iii) ) out = 1
+           enddo
+        endif
+C
+        if (.NOT.op .AND. out .EQ. 0) exit
+C      
+      enddo
+C
+      Agrif_Get_Unit=n
+C
+C
+      End Function Agrif_Get_Unit
+      
+      Subroutine Agrif_Set_Efficiency(eff)
+      REAL :: eff
+      
+      IF ((eff.LT.0.).OR.(eff.GT.1)) THEN
+      write(*,*)'Error Efficiency should be between 0 and 1'
+      stop
+      ELSE
+      Agrif_efficiency = eff
+      ENDIF
+      End Subroutine Agrif_Set_Efficiency
+      
+      Subroutine Agrif_Set_Regridding(regfreq)
+      INTEGER :: regfreq
+      
+      IF (regfreq.LT.0) THEN
+      write(*,*)'Regridding frequency should be positive'
+      stop
+      ELSE
+      Agrif_regridding = regfreq
+      ENDIF
+      End Subroutine Agrif_Set_Regridding
+C
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffref_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffref_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffref(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffref_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_x
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_x(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(1) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_x
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_y
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_y(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(2) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_y
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_coeffreft_z
+C     **************************************************************************
+      subroutine Agrif_Set_coeffreft_z(coefref)
+
+      integer :: coefref
+
+      if (coefref.LT.0) then
+         write(*,*)'Coefficient of time raffinement should be positive'
+         stop
+      else
+         AGRIF_coeffreft(3) = coefref
+      endif
+      end subroutine Agrif_Set_coeffreft_z
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Minwidth
+C     **************************************************************************
+      subroutine Agrif_Set_Minwidth(coefminwidth)
+
+      integer :: coefminwidth
+
+      if (coefminwidth.LT.0) then
+         write(*,*)'Coefficient of Minwidth should be positive'
+         stop
+      else
+         Agrif_Minwidth = coefminwidth
+      endif
+      end subroutine Agrif_Set_Minwidth
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Set_Rafmax
+C     **************************************************************************
+      subroutine Agrif_Set_Rafmax(coefrafmax)
+
+      integer :: coefrafmax
+      integer :: i
+      real :: res
+
+      if (coefrafmax.LT.0) then
+         write(*,*)'Coefficient of  should be positive'
+         stop
+      else
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(1))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(1) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(2))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(2) = 1. / res
+C
+         res = 1.
+         do i = 1 , coefrafmax - 1
+            res = res * FLOAT(AGRIF_coeffref(3))
+         enddo
+         if ( res .EQ. 0 ) res = 1
+         Agrif_Mind(3) = 1. / res
+C
+      endif
+      end subroutine Agrif_Set_Rafmax
+C
+C     **************************************************************************
+CCC   subroutine Agrif_Open_File
+C     **************************************************************************
+      subroutine Agrif_Open_File(num_id,name_file)
+
+      integer :: num_id
+      character(*) :: name_file
+
+      num_id = Agrif_Get_Unit()
+      if ( .NOT. Agrif_Root() ) then
+         name_file = TRIM(Agrif_CFixed())//'_'//TRIM(name_file)
+      endif
+
+      end subroutine Agrif_Open_File
+
+C     **************************************************************************
+CCC    subroutine Agrif_Set_MaskMaxSearch
+C     **************************************************************************
+      subroutine Agrif_Set_MaskMaxSearch(mymaxsearch)
+      integer mymaxsearch
+      MaxSearch = mymaxsearch
+      end subroutine Agrif_Set_MaskMaxSearch
+      
+C *****************************************************************
+CCC  subroutine Agrif_Level
+C *****************************************************************
+      Function Agrif_Level()
+      Integer :: Agrif_Level
+     
+      Agrif_Level = Agrif_Curgrid % level
+     
+      End Function Agrif_Level
+      
+C *****************************************************************
+CCC  subroutine Agrif_MaxLevel
+C *****************************************************************
+      Function Agrif_MaxLevel()
+      Integer :: Agrif_MaxLevel
+     
+      Agrif_MaxLevel = Agrif_MaxLevelLoc
+     
+      End Function Agrif_MaxLevel      
+
+      End Module Agrif_CurgridFunctions 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modflux.F	(revision 3437)
@@ -0,0 +1,339 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_fluxmod
+C
+      Module Agrif_fluxmod
+      Use Agrif_types
+      Use Agrif_Arrays
+      Use Agrif_Curgridfunctions
+      
+      CONTAINS  
+      
+      
+      Subroutine Agrif_AllocateFlux(Flux,fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: fluxtab
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: unitarray
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Integer :: nbout
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+      
+      unitarray = 1
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            Allocate(Flux%fluxtabx)
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            Allocate(Flux%fluxtaby)
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            Allocate(Flux%fluxtabz)
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          ALLOCATE(fluxtabvar%iarray2(2,6))
+          normalsizes=>fluxtabvar%iarray2
+          normalsizes(1,1) = 2
+          nbout = 1
+          DO n2 = 1,dimensio
+            IF (n2 .NE. n) THEN
+              nbout = nbout + 1
+              If ((Profile%posvar(n2) == 1)
+     &            .OR.(Profile%posvar(n2) == 2)) THEN
+                IF (Profile%interptab(n2) == 'x') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(1)/agrif_Curgrid%spaceref(1)
+                ELSE IF (Profile%interptab(n2) == 'y') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(2)/agrif_Curgrid%spaceref(2)
+                ELSE IF (Profile%interptab(n2) == 'z') THEN
+                  normalsizes(2,n2) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                  normalsizes(1,nbout) = 
+     &                Agrif_Curgrid%nb(3)/agrif_Curgrid%spaceref(3)
+                ENDIF
+              ELSE
+                normalsizes(2,n2) = SIZE(fluxtab,n2)
+                normalsizes(1,nbout) = SIZE(fluxtab,n2)
+              ENDIF
+            ENDIF
+          ENDDO          
+        ENDIF
+      enddo
+      
+      
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF
+          Call Agrif_nbdim_allocation(fluxtabvar,unitarray(1:dimensio),
+     &          fluxtabvar%iarray2(1,1:dimensio),dimensio)
+        ENDIF
+      enddo
+      
+      Flux%fluxallocated = .TRUE.
+      
+      End Subroutine Agrif_AllocateFlux
+      
+      FUNCTION Agrif_Search_Flux(fluxname)
+      character*(*) fluxname
+      Type(Agrif_Flux), Pointer :: Agrif_Search_Flux
+      
+      Type(Agrif_Flux), pointer :: parcours
+      Logical :: foundflux
+      
+      foundflux = .FALSE.
+      parcours => Agrif_Curgrid%fluxes
+      
+      Do While (Associated(parcours))
+         IF (parcours % fluxname == fluxname) THEN
+           foundflux = .TRUE.
+           EXIT
+         ENDIF
+         parcours => parcours%nextflux
+      End Do
+      
+      IF (.NOT.foundflux) THEN
+      write(*,*) 'The array flux '''
+     &           //TRIM(fluxname)//''' has not been declared'
+      stop
+      ENDIF      
+      
+      Agrif_Search_Flux => parcours
+      
+      End Function Agrif_Search_Flux
+      
+      Subroutine Agrif_Save_Fluxtab(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j,j1,j2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)
+          normalsizes3(n) = Profile%point(n) 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            do j2 = j1,j1+Agrif_curgrid%spaceref(2)
+!            print *,'flux stocke fiun = ',j2,fluxtab(unitarray3(1),j2)
+            enddo
+            fluxtabvar%array2(1:1,j) = 
+     &      fluxtabvar%array2(1:1,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+          END SELECT
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%nb(n)
+          normalsizes3(n) = Profile%point(n)+Agrif_Curgrid%nb(n) 
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            j1 = unitarray3(2)
+            Do j=unitarray3(2),normalsizes3(2)
+            fluxtabvar%array2(2:2,j) = 
+     &      fluxtabvar%array2(2:2,j) +
+     &             SUM(fluxtab(unitarray3(1):normalsizes3(1),
+     &                        j1:j1+Agrif_Curgrid%spaceref(2)))
+             j1 = j1+Agrif_Curgrid%spaceref(2)
+            EndDo
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab
+
+      Subroutine Agrif_Save_Fluxtab_child(Flux,Fluxtab)
+      Type(Agrif_Flux), Pointer :: Flux
+      Real, Dimension(:,:) :: Fluxtab
+      INTEGER, DIMENSION(:,:), Pointer :: normalsizes
+      INTEGER, DIMENSION(6) :: normalsizes2, normalsizes3
+      INTEGER, DIMENSION(6) :: unitarray2, unitarray3
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+          normalsizes => fluxtabvar%iarray2
+          unitarray2 = 1
+          unitarray3 = 1
+          normalsizes2 = normalsizes(1,:)
+          normalsizes3 = normalsizes(2,:)
+          
+          unitarray3(n) = Profile%point(n)+Agrif_Curgrid%ix(n)
+          normalsizes3(n) = unitarray3(n)
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(1:1,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))
+!        print *,'flux stocke = ',fluxtab(unitarray3(1):normalsizes3(1),
+!     &                        unitarray3(2):normalsizes3(2))
+          END SELECT
+          
+          unitarray3(n) = unitarray3(n)+
+     &         Agrif_Curgrid%nb(n)/Agrif_Curgrid%spaceref(n)
+          normalsizes3(n) = unitarray3(n)
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2(2:2,
+     &                        unitarray2(2):normalsizes2(2)) = 
+     &      - fluxtab(unitarray3(1):normalsizes3(1),
+     &                        unitarray3(2):normalsizes3(2))    
+         END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Save_Fluxtab_child
+      
+      Subroutine Agrif_Cancel_Fluxarray(Flux)
+      Type(Agrif_Flux), Pointer :: Flux
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+            
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+            fluxtabvar%array2 = 0.
+          END SELECT
+        ENDIF
+      enddo
+                  
+      End Subroutine Agrif_Cancel_Fluxarray  
+      
+      Subroutine Agrif_FluxCorrect(Flux, procname)
+      Type(Agrif_Flux), Pointer :: Flux
+      External :: procname
+      Type(Agrif_Variable), Pointer :: fluxtabvar
+      Type(Agrif_Profile), Pointer :: Profile
+      Integer :: dimensio,n,n2,j1,j2
+      Integer, Dimension(:), Allocatable :: Loctab
+      Integer :: locind
+      
+      Profile => Flux%profile
+      dimensio = Profile%nbdim
+
+      do n=1,dimensio
+        IF (Profile%posvar(n) == 1) THEN
+          IF (Profile%interptab(n) == 'x') THEN
+            fluxtabvar => Flux%fluxtabx
+            locind = 1
+          ELSE IF (Profile%interptab(n) == 'y') THEN
+            fluxtabvar => Flux%fluxtaby
+            locind = 2
+          ELSE IF (Profile%interptab(n) == 'z') THEN
+            fluxtabvar => Flux%fluxtabz
+            locind = 3
+          ENDIF 
+                              
+          SELECT CASE(dimensio)
+          CASE(1)
+          CASE(2)
+           Allocate(Loctab(2))
+           Loctab(1) = Agrif_Curgrid%ix(locind)
+           Loctab(2) = Agrif_Curgrid%ix(locind)+
+     &         Agrif_Curgrid%nb(locind)/Agrif_Curgrid%spaceref(locind)
+           j1 = agrif_curgrid%ix(2)
+           j2 = agrif_curgrid%ix(2)+
+     &        agrif_curgrid%nb(2)/Agrif_curgrid%spaceref(2)
+           Call Agrif_ChildGrid_to_ParentGrid()
+            Call procname(fluxtabvar%array2,Loctab(1),Loctab(2),j1,j2)
+           Call Agrif_ParentGrid_to_ChildGrid()
+          END SELECT
+        ENDIF
+      enddo
+      
+      If (Allocated(Loctab)) Deallocate(Loctab)
+                  
+      End Subroutine Agrif_FluxCorrect 
+          
+      End Module Agrif_fluxmod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F	(revision 3437)
@@ -0,0 +1,252 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init
+C
+      Module Agrif_Init 
+C
+CCC   Description:
+CCC   Several operations on the variables of the current grid (creation,
+CCC   instanciation, ...) used during the creation of the grid hierarchy and
+CCC   during the time integration.
+C
+C     Modules used: 
+C
+      Use Agrif_Types 
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Allocation  
+C     **************************************************************************
+C  
+      Subroutine Agrif_Allocation(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to allocate the arrays containing the values of the variables 
+CCC   of the current grd.
+C
+CC    Method:
+CC    Use of the allocate function.  
+C
+C     Declarations:
+C      
+C     Pointer argument:
+      TYPE(AGRIF_grid), Pointer :: Agrif_Gr  ! Pointer on the current grid
+C 
+C     Allocation of the arrays of the variables  
+C     We cut this in several files to avoid long compilation timings
+C
+      Call Agrif_Allocationcalls(Agrif_Gr)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+         if ( Agrif_Probdim .EQ. 1 ) 
+     &      Allocate(Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1))
+         if ( Agrif_Probdim .EQ. 2 ) 
+     &      Allocate(Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1))      
+         if ( Agrif_Probdim .EQ. 3 ) 
+     &      Allocate(Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1,
+     &       Agrif_Gr%nb(2)+1,Agrif_Gr%nb(3)+1))      
+C
+      endif
+C 
+      End Subroutine Agrif_Allocation
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Instance 
+C     **************************************************************************
+C 
+      Subroutine Agrif_Instance(Agrif_Gr)
+C
+CCC   Description:
+CCC   Subroutine to do an instance of the common variables to the variables of  
+CCC   the current grid.
+C
+CC    Method:
+CC    Pointing the common variables on these of the current grid.  
+C
+C     Declarations:
+C        
+
+C
+C
+
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+C 
+C
+      Agrif_Curgrid => Agrif_Gr
+      Agrif_tabvars => Agrif_Curgrid % tabvars
+C
+      Call Agrif_Get_numberofcells(Agrif_Gr)
+C
+C
+C     Calculation of isf,jsf,nzsf and of the index of the output file 
+      Call Agrif_InitWorkSpace() 
+C
+C 
+      End Subroutine Agrif_Instance
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_initialisations  
+C     **************************************************************************
+      Subroutine Agrif_initialisations(Agrif_Gr)
+C
+CCC   Description:
+C
+CC    Method:
+C
+C     Declarations:
+C        
+      INTEGER :: i
+C
+C     Pointer argument: 
+      Type(Agrif_Grid), Pointer  :: Agrif_Gr
+      
+C
+      do i = 1 , Agrif_NbVariables
+C 
+         Agrif_Gr % tabvars(i) % var % nbdim = 0
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+             Agrif_Gr % tabvars(i) % var % lb(1:1) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array1)
+             Agrif_Gr % tabvars(i) % var % ub(1:1) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array1)     
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+             Agrif_Gr % tabvars(i) % var % lb(1:2) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array2)
+             Agrif_Gr % tabvars(i) % var % ub(1:2) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array2)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+             Agrif_Gr % tabvars(i) % var % lb(1:3) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array3)
+             Agrif_Gr % tabvars(i) % var % ub(1:3) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array3)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+             Agrif_Gr % tabvars(i) % var % lb(1:4) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array4)
+             Agrif_Gr % tabvars(i) % var % ub(1:4) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array4)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+             Agrif_Gr % tabvars(i) % var % lb(1:5) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array5)
+             Agrif_Gr % tabvars(i) % var % ub(1:5) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array5)
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+             Agrif_Gr % tabvars(i) % var % lb(1:6) = 
+     &         lbound(Agrif_Gr%tabvars(i)%var%array6)
+             Agrif_Gr % tabvars(i) % var % ub(1:6) = 
+     &         ubound(Agrif_Gr%tabvars(i)%var%array6)
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 3
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 4
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 5
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 6
+         endif
+C
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 1
+         endif
+         if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then
+             Agrif_Gr % tabvars(i) % var % nbdim = 2
+         endif
+C 
+      enddo
+C
+      Return
+C 
+C
+      End Subroutine Agrif_initialisations
+C 
+C
+      End Module AGRIF_Init 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinitvars.F	(revision 3437)
@@ -0,0 +1,125 @@
+!
+! $Id$
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Init_Vars
+C
+      Module Agrif_Init_Vars
+C
+CCC   Description:
+CCC   Initialization of the variables of the current grid.
+C
+C     Modules used: 
+C      
+      Use Agrif_Types
+      Use Agrif_link
+C   
+      IMPLICIT NONE
+C
+      Contains
+C     Defininition of the procedures contained in this module 
+C  
+C 
+C     **************************************************************************
+CCC   Subroutine Agrif_Create_var 
+C     **************************************************************************
+C  
+      Subroutine Agrif_Create_Var(Agrif_Gr)
+C
+CCC   Description:
+CCC   Allocation of the field "var" of the grid variables.
+CCC   Fields "root_var", "nbdim" and "parent_var" of the grid variables.
+CCC   Array "tabvars" of the current grid. 
+C
+CC    Method:                  
+C 
+C     Declarations:
+C
+      
+C
+C     Pointer argument:
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER :: nb
+C
+C     Array "tabvars" of the current grid. 
+C
+      Allocate(Agrif_Gr % tabvars(Agrif_NbVariables))
+C      
+      do nb = 1, Agrif_NbVariables
+        Allocate(Agrif_Gr % tabvars(nb) % var)
+      enddo
+
+C     Fields "root_var", "nbdim" and "parent_var" of the grid variables.     
+      if (Agrif_Gr % fixedrank .NE.0) then
+         do nb = 1, Agrif_NbVariables     
+            Agrif_Gr % tabvars(nb) % parent_var => 
+     &      Agrif_Gr % parent %tabvars(nb)
+            Agrif_Gr % tabvars(nb) % var % nbdim =
+     &      Agrif_Mygrid % tabvars(nb) % var % nbdim
+            Agrif_Gr % tabvars(nb) % var % root_var =>
+     &      Agrif_Mygrid % tabvars(nb) % var          
+         enddo
+      endif
+C           
+      End Subroutine Agrif_Create_Var
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CreateVar
+C     **************************************************************************
+C 
+      Subroutine Agrif_CreateVar(Agrif_Gr)            
+C
+CCC   Description:
+CCC   This subroutine allows to make a link between Mygrid and the current grid 
+C
+C     Modules used:
+C      
+C
+C     Declarations:
+C      
+C
+C
+C     Arguments      
+C
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr    ! Pointer on the current grid
+      INTEGER                    :: i           ! Loop
+C
+      if (Agrif_Gr % fixedrank .NE. 0) then
+C  
+         do i = 1 , Agrif_NbVariables 
+            Agrif_Gr % tabvars(i) % parent_var => 
+     &      Agrif_Gr % parent % tabvars(i) 
+            Agrif_Gr % tabvars(i) % var % root_var => 
+     &      Agrif_Mygrid % tabvars(i) % var
+            Agrif_Gr % tabvars(i) % var % nbdim  = 
+     &      Agrif_Gr % parent % tabvars(i) % var % nbdim
+         enddo 
+C	 
+      endif 
+C       
+      End Subroutine Agrif_CreateVar
+C
+C
+C
+      End Module Agrif_Init_Vars
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F	(revision 3437)
@@ -0,0 +1,2270 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpolation
+C
+      Module Agrif_Interpolation
+C
+CCC   Description:
+CCC   Module to initialize a fine grid from its parent grid, by using a space 
+CCC   interpolation
+C
+C     Modules used:
+C  
+      Use Agrif_Interpbasic
+      Use Agrif_Arrays
+      Use Agrif_Mask 
+      Use Agrif_CurgridFunctions
+#if defined key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C      
+      IMPLICIT NONE
+      logical,  private:: precomputedone(7) = .FALSE.
+C
+      CONTAINS
+C     Define procedures contained in this module        
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
+     &    torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray1 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray1 = child % var % array1
+C          
+          childtemp % var % restore1D => child % var % restore1D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore1D)
+C      
+      endif     
+C 
+C     Index indicating (in the Agrif_Interp1D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade 
+      childtemp % var % list_interp => child % var% list_interp            
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
+     &                           torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C      
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim
+C
+C     Tab is the result of the interpolation
+      childtemp % var % parray2 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub
+      
+C
+      if (torestore) then      
+C 
+          childtemp % var % parray2 = child % var % array2          
+C 
+          childtemp % var % restore2D => child % var % restore2D        
+C      
+        else
+C        
+          Nullify(childtemp % var % restore2D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp2D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex       
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C     
+C     Tab is the result of the interpolation 
+      childtemp % var % parray3 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+C      
+      if (torestore) then
+C     
+          childtemp % var % parray3 = child % var % array3
+C
+          childtemp % var % restore3D => child % var % restore3D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore3D)
+C      
+      endif
+C 
+C     Index indicating (in the Agrif_Interp3D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C     
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp     
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_3D               
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray4 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C 
+      if (torestore) then
+C 
+          childtemp % var % parray4 = child % var % array4
+C
+          childtemp % var % restore4D => child % var % restore4D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore4D)
+C      
+      endif        
+C 
+C     Index indicating (in the Agrif_Interp4D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+      childtemp % var % list_interp => child % var% list_interp           
+C     
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
+     &   torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray5 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray5 = child % var % array5
+C
+          childtemp % var % restore5D => child % var % restore5D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore5D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp5D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade   
+      childtemp % var % list_interp => child % var% list_interp          
+C      
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+     
+      child % var % list_interp => childtemp % var %list_interp
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_5D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
+     &  torestore,nbdim,procname)            
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
+C        grid variable.
+C
+C     Declarations:
+C      
+      
+C
+C     Arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
+                                             !    (linear,lagrange,spline)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+                                             !    grid
+      LOGICAL :: torestore
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+      External :: procname
+      Optional ::  procname
+C
+C
+      allocate(childtemp % var)  
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = nbdim  
+C      
+C     Tab is the result of the interpolation
+      childtemp % var % parray6 => tab  
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      
+      if (torestore) then
+C 
+          childtemp % var % parray6 = child % var % array6
+C
+          childtemp % var % restore6D => child % var % restore6D
+C      
+        else
+C        
+          Nullify(childtemp % var % restore6D)
+C      
+      endif       
+C 
+C     Index indicating (in the Agrif_Interp6D procedure) if a space
+C        interpolation is necessary
+      childtemp % var % interpIndex => child % var % interpIndex    
+      childtemp % var % Interpolationshouldbemade = 
+     &    child % var % Interpolationshouldbemade  
+     
+      childtemp % var % list_interp => child % var% list_interp           
+C      
+
+      if (present(procname)) then
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore,procname)
+      else
+      Call Agrif_InterpVariable
+     &     (TypeInterp,parent,childtemp,torestore)
+      endif
+
+
+C      
+      child % var % list_interp => childtemp % var %list_interp
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Interp_6D
+C
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpVariable    
+C     **************************************************************************
+C   
+      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore,
+     &            procname)
+C
+CCC   Description:
+CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
+CCC   DIMENSION of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C
+C     Scalar argument
+      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
+                                        !    (linear,spline,...)
+C     Data TYPE arguments                                   
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
+C
+C     LOGICAL argument      
+      LOGICAL:: torestore               ! Its value is .false., it indicates the
+                                        ! results of the interpolation are    
+                                        ! applied on the whole current grid   
+C
+C     Local scalars      
+      INTEGER               :: nbdim          ! Number of dimensions of the
+                                              !    current grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      External :: procname
+      Optional ::  procname
+
+C
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+C     Call to a procedure of interpolation against the number of dimensions of 
+C     the grid variable
+C
+
+      if (present(procname)) then
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim,procname)
+      else
+      call Agrif_InterpnD
+     &            (TYPEinterp,parent,child,
+     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             child,torestore,nbdim)
+
+      endif
+C
+      Return
+C
+C
+      End subroutine Agrif_InterpVariable       
+C
+C
+C     **************************************************************************
+C     Subroutine Agrif_InterpnD  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,ds_Child,ds_Parent,
+     &                          restore,torestore,nbdim,procname)
+C
+C     Description:
+C     Subroutine to interpolate a nD grid variable from its parent grid,
+C     by using a space interpolation. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+        INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      External :: procname
+      Optional :: procname
+      INTEGER                    :: nbdim
+      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
+                                                       !    (linear,...)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !    grid
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !    grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !    point inside the
+                                                       !    domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the child
+                                                       !    grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !    point inside the
+                                                       !    domain for the
+                                                       !    parent grid variable
+      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
+                                                       !    interpolation
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !    and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !    parent and child
+                                                       !    grids
+      LOGICAL                        :: torestore      ! Indicates if the array
+                                                       !    restore is used
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempP,tempPextend  ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE),SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars        
+      INTEGER                     :: i,j,k,l,m,n
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: memberin,member
+      TYPE(AGRIF_PVARIABLE),SAVE                      ::  parentvalues
+      LOGICAL :: find_list_interp
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2      
+C
+#ifdef key_mpp_mpi
+C
+      LOGICAL :: memberout
+      INTEGER,PARAMETER                          :: etiquette = 100
+      INTEGER                                    :: code
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(1) :: memberin1
+C
+#endif      
+C     
+
+C   
+C     Boundaries of the current grid where interpolation is done
+
+      IF (Associated(child%var%list_interp)) THEN
+      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &       indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,find_list_interp
+#if defined key_mpp_mpi
+     &       ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      ELSE
+      find_list_interp = .FALSE.
+      ENDIF
+      
+      IF (.not.find_list_interp) THEN
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+      
+      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
+     &                                   pttab,petab,
+     &                                   pttruetab,cetruetab,memberin)
+     
+C
+      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttab,petab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+       
+#ifdef key_mpp_mpi
+       IF (memberin) THEN
+        Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                        s_Parent_temp,s_Child_temp,
+     &                        s_Child,ds_Child,
+     &                        s_Parent,ds_Parent,
+     &                        pttruetab,cetruetab,
+     &                        pttab_Child,pttab_Parent,
+     &                        child%var%root_var%posvar,
+     &                        child % var % root_var % interptab)
+      ENDIF
+       
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+       
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+       endif
+       
+      Call Agrif_ParentGrid_to_ChildGrid()
+#else
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+#endif
+
+      ELSE
+      
+#if !defined key_mpp_mpi
+      parentarray(:,1,1) = indminglob
+      parentarray(:,2,1) = indmaxglob
+      parentarray(:,1,2) = indminglob
+      parentarray(:,2,2) = indmaxglob
+      indmin = indminglob
+      indmax = indmaxglob
+      member = .TRUE.
+      s_Parent_temp = s_Parent + (indminglob - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child
+#else      
+      s_Parent_temp = s_Parent + (indmin - pttab_Parent)*ds_Parent
+      s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+#endif      
+           
+      ENDIF
+
+      IF (member) THEN
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+
+C
+      Call Agrif_nbdim_allocation(tempP%var,
+     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+      Call Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempP%var%array1,
+     &                          parentarray(1,1,2),parentarray(1,2,2))
+        CASE(2)
+          CALL procname(tempP%var%array2,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2))
+        CASE(3)
+          CALL procname(tempP%var%array3,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2))
+        CASE(4)
+          CALL procname(tempP%var%array4,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2))
+        CASE(5)
+          CALL procname(tempP%var%array5,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2))
+        CASE(6)
+          CALL procname(tempP%var%array6,
+     &                          parentarray(1,1,2),parentarray(1,2,2),
+     &                          parentarray(2,1,2),parentarray(2,2,2),
+     &                          parentarray(3,1,2),parentarray(3,2,2),
+     &                          parentarray(4,1,2),parentarray(4,2,2),
+     &                          parentarray(5,1,2),parentarray(5,2,2),
+     &                          parentarray(6,1,2),parentarray(6,2,2))
+            END SELECT
+      Call Agrif_ParentGrid_to_ChildGrid()
+      ELSE
+
+      Call Agrif_nbdim_VarEQvar(tempP%var,
+     &        parentarray(:,1,1),parentarray(:,2,1),
+     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
+     &        nbdim)
+      ENDIF
+            endif
+
+#ifdef key_mpp_mpi
+      if (.not.find_list_interp) then
+      tab3(:,1) = indminglob2(:)
+      tab3(:,2) = indmaxglob2(:)
+      tab3(:,3) = indmin(:)
+      tab3(:,4) = indmax(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+      enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+          
+      endif     
+           
+!      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin,
+!     &            memberinall)
+     
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,
+     &            tempPextend)
+#else
+      tempPextend%var => tempP%var
+#endif
+
+      if (.not.find_list_interp) then
+      Call Agrif_Addto_list_interp(child%var%list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &   indminglob,indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &   pttruetab,cetruetab,member,memberin,nbdim
+#if defined key_mpp_mpi
+     &   ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+      endif   
+C
+C
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+C
+
+      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
+
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+          noraftab(1:nbdim) =
+     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+          IF (.not.associated(parentvalues%var))
+     &            Allocate(parentvalues%var)
+C
+          Call Agrif_nbdim_allocation
+     &               (parentvalues%var,indmin,indmax,nbdim)
+          Call Agrif_nbdim_Full_VarEQvar
+     &               (parentvalues%var,tempPextend%var,nbdim)
+C
+          Call Agrif_CheckMasknD(tempPextend,
+     &                           parentvalues,
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           indmin(1:nbdim),indmax(1:nbdim),
+     &                           noraftab(1:nbdim),nbdim)
+C
+          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
+C          Deallocate(parentvalues%var)
+C
+C
+      endif      
+
+C
+C
+C     Interpolation of the current grid
+
+      IF (memberin) THEN
+      if ( nbdim .EQ. 1 ) then
+         Call Agrif_Interp_1D_recursive(TypeInterp,
+     &           tempPextend%var%array1,tempC%var%array1,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 2 ) then
+
+         Call Agrif_Interp_2D_recursive(TypeInterp,
+     &           tempPextend%var%array2,tempC%var%array2,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 3 ) then
+
+         Call Agrif_Interp_3D_recursive(TypeInterp,
+     &           tempPextend%var%array3,tempC%var%array3,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 4 ) then
+         Call Agrif_Interp_4D_recursive(TypeInterp,
+     &           tempPextend%var%array4,tempC%var%array4,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 5 ) then
+         Call Agrif_Interp_5D_recursive(TypeInterp,
+     &           tempPextend%var%array5,tempC%var%array5,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      elseif ( nbdim .EQ. 6 ) then
+         Call Agrif_Interp_6D_recursive(TypeInterp,
+     &           tempPextend%var%array6,tempC%var%array6,
+     &           indmin,indmax,
+     &           pttruetab,cetruetab,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+       endif
+
+
+C  
+
+      Call Agrif_nbdim_Get_bound_dimension(child % var,
+     &                               lowerbound,upperbound,nbdim)
+
+#ifdef key_mpp_mpi
+      Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     memberout)
+
+#else
+       childarray(:,1,1) = pttruetab
+       childarray(:,2,1) = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+ccccccccccccccc       memberout = .TRUE.
+#endif
+
+
+C
+C
+C     Special values on the child grid  
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+
+          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
+     &                 childarray,
+     &                 pttruetab,cetruetab,
+     &                 Agrif_SpecialValueFineGrid,nbdim)
+
+C        
+      endif
+      
+      endif
+
+C
+      if (torestore) then
+C
+#ifdef key_mpp_mpi
+C
+        SELECT CASE (nbdim)
+        CASE (1)
+             do i = pttruetab(1),cetruetab(1)         
+ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
+ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
+ChildarrayAModifier     &                                 ) = 
+ChildarrayAModifier     &                tempC%var%array1(i)
+             enddo
+        CASE (2)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
+ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2)) = 
+ChildarrayAModifier     &                tempC%var%array2(i,j)
+             enddo
+             enddo
+        CASE (3)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)  
+             do k = pttruetab(3),cetruetab(3)
+ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
+ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2)) = 
+ChildarrayAModifier     &                tempC%var%array3(i,j,k)
+             enddo
+             enddo
+             enddo
+        CASE (4)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
+ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
+ChildarrayAModifier     &                                       childarray(j,2,2),
+ChildarrayAModifier     &                                       childarray(k,3,2),
+ChildarrayAModifier     &                                       childarray(l,4,2)) = 
+ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (5)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
+ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2)) = 
+ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        CASE (6)
+             do i = pttruetab(1),cetruetab(1)
+             do j = pttruetab(2),cetruetab(2)
+             do k = pttruetab(3),cetruetab(3)
+             do l = pttruetab(4),cetruetab(4)
+             do m = pttruetab(5),cetruetab(5)
+             do n = pttruetab(6),cetruetab(6)
+ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
+ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
+ChildarrayAModifier     &                                 childarray(j,2,2),
+ChildarrayAModifier     &                                 childarray(k,3,2),
+ChildarrayAModifier     &                                 childarray(l,4,2),
+ChildarrayAModifier     &                                 childarray(m,5,2),
+ChildarrayAModifier     &                                 childarray(n,6,2)) = 
+ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+             enddo
+        END SELECT
+C
+#else
+        SELECT CASE (nbdim)
+        CASE (1)
+           do i = pttruetab(1),cetruetab(1)         
+            if (restore%var%restore1D(i) == 0)
+     &            child % var % parray1(i) = 
+     &            tempC % var % array1(i)    
+          enddo
+        CASE (2)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore2D(i,j) == 0)     
+     &              child % var % parray2(i,j) = 
+     &              tempC % var % array2(i,j)    
+              enddo
+             enddo
+        CASE (3)
+           do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1) 
+              if (restore%var%restore3D(i,j,k) == 0)
+     &                  child % var % parray3(i,j,k) =
+     &                  tempC % var % array3(i,j,k)    
+                  enddo
+              enddo
+             enddo
+        CASE (4)
+           do l = pttruetab(4),cetruetab(4)
+           do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore4D(i,j,k,l) == 0)
+     &                 child % var % parray4(i,j,k,l) = 
+     &                 tempC % var % array4(i,j,k,l)    
+             enddo
+             enddo
+              enddo
+             enddo
+        CASE (5)
+           do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+           do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore5D(i,j,k,l,m) == 0)
+     &                  child % var % parray5(i,j,k,l,m) = 
+     &                  tempC % var % array5(i,j,k,l,m)    
+             enddo
+             enddo
+                  enddo
+              enddo
+             enddo
+        CASE (6)
+           do n = pttruetab(6),cetruetab(6)
+          do m = pttruetab(5),cetruetab(5)
+          do l = pttruetab(4),cetruetab(4)
+         do k = pttruetab(3),cetruetab(3)
+          do j = pttruetab(2),cetruetab(2)
+             do i = pttruetab(1),cetruetab(1)
+                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
+     &                      child % var % parray6(i,j,k,l,m,n) = 
+     &                      tempC % var % array6(i,j,k,l,m,n)    
+             enddo
+            enddo
+                      enddo
+                  enddo
+              enddo
+             enddo
+        END SELECT
+C
+#endif
+C        
+        else
+C
+C
+          IF (memberin) THEN
+          SELECT CASE (nbdim)
+          CASE (1)
+            child%var%parray1(childarray(1,1,2):childarray(1,2,2)) =
+     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
+          CASE (2)
+            child%var%parray2(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2)) =
+     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1))
+          CASE (3)
+            child%var%parray3(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2)) =
+     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1))
+          CASE (4)
+            child%var%parray4(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2)) =
+     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1))
+          CASE (5)
+            child%var%parray5(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2)) =
+     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1))
+          CASE (6)
+            child%var%parray6(childarray(1,1,2):childarray(1,2,2),
+     &                       childarray(2,1,2):childarray(2,2,2),
+     &                       childarray(3,1,2):childarray(3,2,2),
+     &                       childarray(4,1,2):childarray(4,2,2),
+     &                       childarray(5,1,2):childarray(5,2,2),
+     &                       childarray(6,1,2):childarray(6,2,2)) =
+     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
+     &                       childarray(2,1,1):childarray(2,2,1),
+     &                       childarray(3,1,1):childarray(3,2,1),
+     &                       childarray(4,1,1):childarray(4,2,1),
+     &                       childarray(5,1,1):childarray(5,2,1),
+     &                       childarray(6,1,1):childarray(6,2,1))
+          END SELECT
+          ENDIF
+C
+C       
+      endif
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+C        deallocate(tempPextend%var)
+
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+      
+C      Deallocate(tempC % var)
+      ELSE
+      
+C      deallocate(tempPextend%var)
+
+      ENDIF
+C
+C             
+C     Deallocations
+#ifdef key_mpp_mpi        
+      IF (member) THEN
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+C      Deallocate(tempP % var)
+      endif
+#endif
+C
+C
+      
+C
+C
+      End Subroutine Agrif_InterpnD 
+C
+C
+C
+C                  
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Parentbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
+     &                              s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,posvar,interptab)
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid for the interpolation
+CCC   of the child grid     
+C
+C
+C     Declarations:
+C
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER, DIMENSION(6) :: TypeInterp
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim) :: posvar
+      CHARACTER(6), DIMENSION(nbdim) :: interptab
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+C
+      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+      
+      DO i = 1,nbdim         
+C     
+        indmin(i) = pttab_Parent(i) + 
+     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) + 
+     &                agrif_ceiling((dim_newmax(i)-
+     &                s_Parent(i))/ds_Parent(i))
+     
+C
+C
+C       Necessary for the Quadratic interpolation
+C  
+
+        IF ((pttruetab(i) == cetruetab(i)) .AND. 
+     &                           (posvar(i) == 1)) THEN
+        ELSEIF (interptab(i) .EQ. 'N') THEN
+        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
+     &      TYPEinterp(i) .eq. Agrif_eno  .or.
+     &      TYPEinterp(i) .eq. Agrif_weno) THEN            
+           indmin(i) = indmin(i) - 2  
+           indmax(i) = indmax(i) + 2                  
+        ELSE IF (( TYPEinterp(i) .ne. Agrif_constant )
+     &        .AND.( TYPEinterp(i) .ne. Agrif_linear )) THEN
+           indmin(i) = indmin(i) - 1  
+           indmax(i) = indmax(i) + 1
+        ENDIF
+        
+
+C        
+       ENDDO 
+C
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+C     
+        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
+C
+C
+      Return
+C
+C
+      End Subroutine Agrif_Parentbounds
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_1D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax, 
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 1D grid variable. 
+CCC   It calls Agrif_InterpBase. 
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(1) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent
+      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL, INTENT(IN),DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL, INTENT(OUT),
+     &      DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
+      INTEGER :: coeffraf
+C
+C
+C     Commentaire perso : nbdim vaut toujours 1 ici. 
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      Call Agrif_InterpBase(TypeInterp(1),
+     &                  tabin(indmin(nbdim):indmax(nbdim)),
+     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),            
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),coeffraf)
+                
+C                
+      Return
+C
+C
+      End Subroutine Agrif_Interp_1D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
+     &           tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &            s_child, s_parent,
+     &           ds_child,ds_parent,
+     &           nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 2D grid variable. 
+CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER,DIMENSION(2)      :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
+      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
+      REAL   ,INTENT(IN), DIMENSION(
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)
+     &                ) :: tabin        
+      REAL   ,INTENT(OUT), DIMENSION(
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)
+     &                ) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j
+      INTEGER :: coeffraf
+      REAL   , DIMENSION(
+     &                pttab_child(nbdim):petab_child(nbdim),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1)
+     &                ) :: tabout_trsp
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim),
+     &        pttab_child(nbdim-1):petab_child(nbdim-1)) :: tabtemp_trsp
+
+C
+C
+C
+C
+C     Commentaire perso : nbdim vaut toujours 2 ici.
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(1) ) call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,   
+     &          indmax(1)-indmin(1)+1,   
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabin,tabtemp,
+     &          size(tabin), size(tabtemp),  
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+
+      do j = indmin(nbdim),indmax(nbdim)
+C        
+!---CDIR NEXPAND
+        Call Agrif_Interp_1D_recursive(TypeInterp(1),
+     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
+     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      ENDIF   
+
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      tabtemp_trsp = TRANSPOSE(tabtemp)
+
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+          IF(.NOT. precomputedone(2) ) call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call linear1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf /= 1 ) )THEN
+
+!---CDIR NEXPAND
+           IF(.NOT. precomputedone(1) )call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+           call ppm1daftercompute(tabtemp_trsp,tabout_trsp,
+     &          size(tabtemp_trsp), size(tabout_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+!---CDIR NEXPAND
+        Call Agrif_InterpBase(TypeInterp(2),
+     &           tabtemp_trsp(indmin(nbdim):indmax(nbdim),i),
+     &           tabout_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+
+C        
+      enddo
+      ENDIF
+      
+      tabout = TRANSPOSE(tabout_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Interp_2D_recursive
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 3D grid variable. 
+CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(3) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim)  :indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &        DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k
+      INTEGER :: coeffraf, locind_child_left, kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeInterp(1) == Agrif_Linear) .AND. (coeffraf/=1))THEN 
+        Call linear1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE. 
+      ELSEIF((TypeInterp(1) == Agrif_PPM) .AND. (coeffraf/=1))THEN
+        Call ppm1Dprecompute2D(
+     &          indmax(2)-indmin(2)+1,
+     &          indmax(1)-indmin(1)+1,
+     &          petab_child(1)-pttab_child(1)+1,
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeInterp(2) == Agrif_Linear) .AND. (coeffraf/=1)) THEN
+         Call linear1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE. 
+      ELSEIF((TypeInterp(2) == Agrif_PPM) .AND. (coeffraf/=1)) THEN
+         Call ppm1Dprecompute2D(
+     &          petab_child(1)-pttab_child(1)+1,
+     &          indmax(2)-indmin(2)+1,
+     &          petab_child(2)-pttab_child(2)+1,
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+      do k = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
+     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
+     &         indmin(nbdim-1):indmax(nbdim-1),k),
+     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_interp(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+           
+      IF (coeffraf == 1) THEN
+      
+      kdeb = indmin(3)+locind_child_left-2
+      do k=pttab_child(3),petab_child(3)
+      kdeb = kdeb + 1
+      do j = pttab_child(2),petab_child(2)
+        do i = pttab_child(1),petab_child(1)
+        tabout(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE      
+C
+      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
+C        
+        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          Call Agrif_InterpBase(TypeInterp(3),
+     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+        enddo 
+C       
+      enddo
+      ENDIF
+C
+      Return
+C        
+C
+      End Subroutine Agrif_Interp_3D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 4D grid variable. 
+CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(4) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &       DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),  
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l
+      INTEGER :: coeffraf
+C
+C
+      do l = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
+     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &         pttab_child(nbdim-2):petab_child(nbdim-2),
+     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+C
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+      
+      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
+C
+        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C        
+          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+            Call Agrif_InterpBase(TypeInterp(4),
+     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_4D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 5D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(5) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3),
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin  
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m
+      INTEGER :: coeffraf
+C
+C
+      do m = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
+     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
+C
+        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
+C
+          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
+C        
+            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
+C
+              Call Agrif_InterpBase(TypeInterp(5),
+     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,
+     &             pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+C
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_5D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Interp_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
+     &           indmin,indmax,   
+     &           pttab_child,petab_child,
+     &           s_child,s_parent,ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine for the interpolation of a 6D grid variable. 
+CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.    
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(6) :: TypeInterp
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
+      REAL,INTENT(IN), DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
+     &                indmin(nbdim-4):indmax(nbdim-4),
+     &                indmin(nbdim-3):indmax(nbdim-3), 
+     &                indmin(nbdim-2):indmax(nbdim-2),
+     &                indmin(nbdim-1):indmax(nbdim-1),
+     &                indmin(nbdim):indmax(nbdim)) :: tabin        
+      REAL,INTENT(OUT),
+     &    DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                pttab_child(nbdim-1):petab_child(nbdim-1),
+     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
+C
+C     Local variables      
+      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),    
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),    
+     &                 indmin(nbdim):indmax(nbdim)) :: tabtemp
+      INTEGER i,j,k,l,m,n
+      INTEGER :: coeffraf
+C
+C        
+C
+      do n = indmin(nbdim),indmax(nbdim)
+C        
+        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
+     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
+     &               indmin(nbdim-4):indmax(nbdim-4),
+     &               indmin(nbdim-3):indmax(nbdim-3),
+     &               indmin(nbdim-2):indmax(nbdim-2),
+     &               indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
+     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
+     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
+     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C        
+      enddo
+      
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+C
+      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
+      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
+C
+        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
+C
+          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
+C        
+            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
+C
+              Call Agrif_InterpBase(TypeInterp(6),
+     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &                    tabout(i,j,k,l,m,
+     &                    pttab_child(nbdim):petab_child(nbdim)),
+     &             indmin(nbdim),indmax(nbdim),
+     &             pttab_child(nbdim),petab_child(nbdim),
+     &             s_parent(nbdim),s_child(nbdim),
+     &             ds_parent(nbdim),ds_child(nbdim),coeffraf)
+C
+            enddo
+C
+          enddo
+C
+        enddo 
+C       
+      enddo
+      enddo
+C                
+C
+      Return
+C
+C        
+      End Subroutine Agrif_Interp_6D_recursive
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_InterpBase  
+C     **************************************************************************
+C  
+      Subroutine Agrif_InterpBase(TypeInterp,
+     &                           parenttab,childtab,
+     &                           indmin,indmax,pttab_child,petab_child,
+     &                           s_parent,s_child,ds_parent,ds_child,
+     &                           coeffraf)   
+C
+CCC   Description:
+CCC   Subroutine calling the interpolation method chosen by the user (linear, 
+CCC   lagrange or spline). 
+C
+C     Declarations:
+C
+      
+C
+      INTEGER                :: TypeInterp
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,INTENT(IN),DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,INTENT(OUT),DIMENSION(pttab_child:petab_child) :: childtab        
+      REAL    :: s_parent,s_child,ds_parent,ds_child 
+      INTEGER :: coeffraf
+C 
+C
+       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
+         childtab(pttab_child) = parenttab(indmin)
+       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then    
+C
+C         Linear interpolation 
+  
+          Call linear1D
+     &         (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)
+C          
+      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
+
+          Call ppm1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C
+
+        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
+C          
+C         Lagrange interpolation    
+          Call lagrange1D
+     &        (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        elseif (TYPEinterp .EQ. AGRIF_ENO) then
+C          
+C         Eno interpolation
+          Call eno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C        
+        elseif (TYPEinterp .EQ. AGRIF_WENO) then
+C          
+C         Eno interpolation
+          Call weno1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C            
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconserv
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)   
+C              
+        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
+C          
+C         Linear conservative interpolation
+          
+          Call linear1Dconservlim
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)         
+C              
+        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
+C          
+          Call constant1D
+     &         (parenttab,childtab,
+     &         indmax-indmin+1,petab_child-pttab_child+1,
+     &         s_parent,s_child,ds_parent,ds_child)
+C              
+      endif 
+C
+C      
+      End Subroutine Agrif_InterpBase 
+C
+
+      Subroutine Agrif_Compute_nbdim_interp(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_child-s_parent)/ds_parent)
+      End Subroutine Agrif_Compute_nbdim_interp
+C          
+
+      Subroutine Agrif_Find_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &                          indmin,indmax,indminglob,
+     &      indmaxglob,indminglob2,indmaxglob2,parentarray,
+     &       pttruetab,cetruetab,member,memberin,
+     &      find_list_interp
+#if defined key_mpp_mpi
+     &     ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_interp
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax  
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab      
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2  
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+      INTEGER :: i
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+#endif 
+                    
+      find_list_interp = .FALSE.
+      
+      parcours => list_interp
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+
+        indmin = parcours%interp_loc%indmin(1:nbdim)
+        indmax = parcours%interp_loc%indmax(1:nbdim)
+        
+        pttruetab = parcours%interp_loc%pttruetab(1:nbdim)
+        cetruetab = parcours%interp_loc%cetruetab(1:nbdim)
+                
+#if !defined key_mpp_mpi
+        indminglob = parcours%interp_loc%indminglob(1:nbdim)
+        indmaxglob = parcours%interp_loc%indmaxglob(1:nbdim)
+#else
+        indminglob2 = parcours%interp_loc%indminglob2(1:nbdim)
+        indmaxglob2 = parcours%interp_loc%indmaxglob2(1:nbdim)
+        parentarray = parcours%interp_loc%parentarray(1:nbdim,:,:)
+        member = parcours%interp_loc%member
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = 
+     &    parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+#endif        
+        memberin = parcours%interp_loc%memberin
+        find_list_interp = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_interp   
+      
+      Subroutine Agrif_AddTo_list_interp(list_interp,pttab,petab,
+     &                          pttab_Child,pttab_Parent,indmin,indmax,
+     &                          indminglob,indmaxglob,
+     &                          indminglob2,indmaxglob2,
+     &                          parentarray,pttruetab,cetruetab,
+     &                          member,memberin,nbdim
+#if defined key_mpp_mpi
+     &      ,tab4t,memberinall,sendtoproc1,recvfromproc1
+#endif
+     &    )
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim)   :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)   :: indminglob,indmaxglob
+      INTEGER,DIMENSION(nbdim)   :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(nbdim)   :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      LOGICAL :: member, memberin
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: recvfromproc1
+#endif                   
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+  
+  
+      parcours%interp_loc%indmin(1:nbdim) = indmin(1:nbdim)
+      parcours%interp_loc%indmax(1:nbdim) = indmax(1:nbdim)
+
+      parcours%interp_loc%memberin = memberin
+#if !defined key_mpp_mpi
+      parcours%interp_loc%indminglob(1:nbdim) = indminglob(1:nbdim)
+      parcours%interp_loc%indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+      parcours%interp_loc%indminglob2(1:nbdim) = indminglob2(1:nbdim)
+      parcours%interp_loc%indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+      parcours%interp_loc%parentarray(1:nbdim,:,:) 
+     &       = parentarray(1:nbdim,:,:)
+      parcours%interp_loc%member = member
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))                  
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall   
+      parcours%interp_loc%sendtoproc1=sendtoproc1
+      parcours%interp_loc%recvfromproc1=recvfromproc1            
+#endif      
+
+      parcours%interp_loc%pttruetab(1:nbdim) = pttruetab(1:nbdim)
+      parcours%interp_loc%cetruetab(1:nbdim) = cetruetab(1:nbdim)
+      
+      parcours%suiv => list_interp
+      
+      list_interp => parcours
+      End Subroutine Agrif_Addto_list_interp 
+                
+      End Module Agrif_Interpolation
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F	(revision 3437)
@@ -0,0 +1,1706 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Interpbasic
+C
+      Module Agrif_Interpbasic
+C
+CCC   Description:
+CCC   Module containing different procedures of interpolation (linear,lagrange,
+CCC   spline,...) used in the Agrif_Interpolation module.
+C
+C     Modules used:
+      USE Agrif_types
+C
+      IMPLICIT NONE
+C             
+      Real,Dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3
+      Real,Dimension(5,Agrif_MaxRaff,3) :: tabppm
+      Real,Dimension(:),Allocatable::tabtest4   
+      Integer, Dimension(:,:), Allocatable :: indparent
+      Integer, Dimension(:,:), Allocatable :: 
+     &           indparentppm,indchildppm
+      Integer, Dimension(:), Allocatable :: 
+     &           indparentppm_1d,indchildppm_1d
+      Real, Dimension(:,:),Allocatable :: coeffparent   
+       
+      CONTAINS
+C     Define procedures contained in this module
+C  
+C     **************************************************************************  
+CCC   Subroutine Linear1d  
+C     ************************************************************************** 
+C 
+      Subroutine Linear1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1.
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        y(i) = (diff*x(locind_parent_left)
+     &        + (1.-diff)*x(locind_parent_left+1))
+C
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+      if (locind_parent_left == np) then
+C
+          y(nc) = x(np)
+C
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+          y(nc) = ((globind_parent_left + ds_parent - ypos)
+     &            *x(locind_parent_left)
+     &          + (ypos - globind_parent_left)
+     &            *x(locind_parent_left+1))*invds
+C
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1d   
+      
+      Subroutine Linear1dprecompute2d(np2, np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc,np2,dir
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,j,coeffraf,locind_parent_left,inc,inc1,inc2,toto 
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Real, Dimension(:,:), Allocatable :: coeffparent_tmp
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      ypos = s_child
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)
+
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      else
+      if (size(indparent,1)<nc*np2) then
+      allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+      allocate(indparent_tmp(size(indparent,1),size(indparent,2)))
+      coeffparent_tmp=coeffparent 
+      indparent_tmp=indparent 
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+      coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2))
+     &  = coeffparent_tmp 
+      indparent(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      deallocate(indparent_tmp,coeffparent_tmp)
+      endif
+      endif
+
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2
+        endif
+
+        diff=(globind_parent_right - ypos2)
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+
+        coeffparent(i,dir) = diff
+        
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+      if (locind_parent_left == np) then
+      indparent(nc,dir) = locind_parent_left-1
+      coeffparent(nc,dir) = 0.
+        else
+C
+          globind_parent_left = s_parent
+     &                        + (locind_parent_left - 1)*ds_parent
+C      
+       indparent(nc,dir) = locind_parent_left
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,dir) = diff
+      endif                                           
+
+      do i=2, np2
+      inc  =  i*nc
+      inc1 = (i-1)*nc
+      inc2 = (i-2)*nc 
+!CDIR ALTCODE
+      indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+      coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+      enddo      
+
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute2d
+
+
+
+      Subroutine Linear1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute 1D coefficient and index for a linear 1D interpolation
+CCC   on a child grid (vector y) from its parent grid (vector x).
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2, invds3
+      REAL :: ypos2,diff
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child 
+
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent
+
+        globind_parent_right = globind_parent_left + ds_parent
+
+C
+      invds = 1./ds_parent
+      invds2 = ds_child/ds_parent
+      invds3 = 0.5/real(coeffraf)      
+      
+      ypos2 = ypos*invds
+      globind_parent_right=globind_parent_right*invds
+      
+      if (.not.allocated(indparent)) then
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      else
+      if (size(indparent)<nc) then
+      deallocate(indparent,coeffparent)
+      allocate(indparent(nc,1),coeffparent(nc,1))
+      endif
+      endif
+      
+      do i = 1,nc-1
+C
+        if (ypos2 > globind_parent_right) then
+           locind_parent_left = locind_parent_left + 1
+           globind_parent_right = globind_parent_right + 1.
+           ypos2 = ypos*invds+(i-1)*invds2           
+        endif
+        
+        diff=(globind_parent_right - ypos2)
+        
+        diff = invds3*nint(2*coeffraf*diff)
+                
+        indparent(i,1) = locind_parent_left
+
+        coeffparent(i,1) = diff
+        ypos2 = ypos2 + invds2
+C
+      enddo
+C
+      ypos = s_child + (nc-1)*ds_child
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      
+      if (locind_parent_left == np) then
+      indparent(nc,1) = locind_parent_left-1
+      coeffparent(nc,1) = 0.
+        else
+C
+          globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent  
+C      
+       indparent(nc,1) = locind_parent_left
+       
+       diff = (globind_parent_left + ds_parent - ypos)
+     &       * invds
+        diff = invds3*nint(2*coeffraf*diff)
+         coeffparent(nc,1) = diff
+      endif                                          
+C           
+      Return
+C
+C       
+      End Subroutine Linear1dprecompute 
+      
+      Subroutine Linear1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x) using precomputed coefficient and index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left,globind_parent_right
+      REAL    :: invds, invds2
+      REAL :: ypos2,diff
+C
+C
+
+!CDIR ALTCODE
+!CDIR NODEP
+      do i = 1,nc
+C
+       y(i)=coeffparent(i,dir)*x(MAX(indparent(i,dir),1))+
+     &      (1.-coeffparent(i,dir))*x(indparent(i,dir)+1)
+C
+      enddo                                     
+C           
+      Return
+C
+C       
+      End Subroutine Linear1daftercompute            
+       
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Lagrange1d  
+C     **************************************************************************
+C
+      Subroutine Lagrange1d(x,y,np,nc,
+     &                      s_parent,s_child,ds_parent,ds_child)
+C
+CCC   Description:
+CCC   Subroutine to do a lagrange 1D interpolation on a child grid (vector y) 
+CCC   from its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C             
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child 
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent_left
+      REAL    :: ypos,globind_parent_left
+      REAL    :: X1,X2,X3 
+      real :: deltax,invdsparent
+      real t1,t2,t3,t4,t5,t6,t7,t8
+C
+C 
+      if (np <= 2) then
+C      
+          Call Linear1D(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child)
+C         
+         Return
+C 
+      endif
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      endif
+      
+      invdsparent=1./ds_parent
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+C
+
+        globind_parent_left = s_parent 
+     &                        + (locind_parent_left - 1)*ds_parent 
+     
+C        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+        
+        ypos = ypos + ds_child
+         if (abs(deltax).LE.0.0001) then
+           y(i)=x(locind_parent_left)
+           
+           cycle
+         endif
+C           
+C
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+        
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+        
+        y(i)=t5*x(locind_parent_left-1)+t6*x(locind_parent_left)
+     &  +t7*x(locind_parent_left+1)+t8*x(locind_parent_left+2)
+C
+C
+      enddo
+C
+      return
+C
+C       
+      End Subroutine Lagrange1d 
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Constant1d  
+C     ************************************************************************** 
+C 
+      Subroutine constant1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL,INTENT(IN), DIMENSION(np) :: x      
+      REAL,INTENT(OUT), DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      INTEGER :: i,coeffraf,locind_parent
+      REAL    :: ypos
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent:locind_parent+nc-1)
+C
+          return
+C
+      endif                          
+C
+      ypos = s_child      
+C
+      do i = 1,nc
+C
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+C
+        y(i) = x(locind_parent)
+C
+        ypos = ypos + ds_child
+C
+      enddo
+C           
+      Return
+C
+C       
+      End Subroutine constant1d   
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconserv
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconserv(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      REAL :: xdiffmod
+
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C              
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf
+        slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=
+     &   (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+      else
+         slope=
+     &   (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconserv
+      
+C
+C     **************************************************************************  
+CCC   Subroutine Linear1dconservlim
+C     ************************************************************************** 
+C 
+      Subroutine Linear1dconservlim(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a linear 1D interpolation on a child grid (vector y) from
+CCC   its parent grid (vector x).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Real    :: ypos
+      integer :: i1,i2,ii
+      real :: xpmin,xpmax,slope
+      INTEGER :: diffmod
+      real :: xdiffmod
+C
+C
+
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+C
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+C        
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+C
+          return
+C
+      End If
+C
+      IF (coeffraf .NE.3) THEN
+      print *,'LINEARCONSERVLIM not ready for refinement ratio = ',
+     &   coeffraf
+      stop
+      ENDIF   
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1        
+
+      xdiffmod = real(diffmod)/2.
+                         
+      allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+C
+      ypos = s_child  
+C      
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+
+      locind_parent_last = 1 +
+     &  agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+     
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent 
+      xpmax = s_parent + (locind_parent_last-1)*ds_parent          
+      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+      i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+      i = i1
+      
+      if (locind_parent_left == 1) then
+        slope=0.       
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf    
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo 
+
+        locind_parent_left = locind_parent_left + 1
+                      
+      do i=i1 +  coeffraf, i2 - coeffraf,coeffraf     
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+      enddo
+      
+      i = i2
+      
+      if (locind_parent_left == np) then
+        slope=0.     
+      else
+        slope = vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf      
+      endif
+      
+        do ii=i-coeffraf/2+diffmod,nc
+          ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo      
+C
+      y(1:nc)=ytemp(1:nc)                                   
+C           
+      deallocate(ytemp)
+      Return
+C       
+      End Subroutine Linear1dconservlim      
+C         
+
+C     **************************************************************************  
+CCC   Subroutine ppm1d
+C     ************************************************************************** 
+C 
+      Subroutine ppm1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C      
+
+      IF( .NOT. allocated(tabtest4) ) THEN    
+      Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+      ELSE
+         IF (size(tabtest4) .LT. nc+4*coeffraf+1)THEN
+         deallocate( tabtest4 )
+         Allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+         ENDIF
+      ENDIF
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+!CDIR NOVECTOR
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR NOVECTOR
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+      Enddo
+
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+      Do i = nmin+1,nmax-1
+         xl(i)= 0.5*(x(i-1)+x(i))
+     &      -0.08333333333333*(slope(i+1)-slope(i-1)) 
+      Enddo
+C
+C apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+       Do i = locind_parent_left,locind_parent_last
+          delta(i) = xl(i+1) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+C
+       End do   
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               tabtest4(jj) = xl(iparent)   
+     &             + tabdiff2(pos) *  (delta(iparent)+a6(iparent))
+     &             - tabdiff3(pos) *  a6(iparent)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+C
+C
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc)=tabtest4(1:nc)
+        
+      Return
+      End Subroutine ppm1d
+      
+
+      Subroutine ppm1dprecompute2d(np2,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to compute 2D coefficients and index for a 1D interpolation
+CCC   using piecewise parabolic method  
+CC    Method: 
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np2,np,nc,dir
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer, Dimension(:,:), Allocatable :: indparent_tmp
+      Integer, Dimension(:,:), Allocatable :: indchild_tmp
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      invcoeffraf = ds_child/ds_parent
+C 
+
+      if (.not.allocated(indparentppm)) then
+      allocate(
+     & indparentppm(np2*nc,3),
+     & indchildppm(np2*nc,3)
+     &        )
+      else
+      if (size(indparentppm,1)<np2*nc) then
+      allocate(
+     &  indparent_tmp(size(indparentppm,1),size(indparentppm,2)),
+     &  indchild_tmp(size(indparentppm,1),size(indparentppm,2)))
+      indparent_tmp = indparentppm 
+      indchild_tmp  = indchildppm 
+      deallocate(indparentppm,indchildppm)
+      allocate(
+     &indparentppm(np2*nc,3),
+     &indchildppm(np2*nc,3)
+     &        )
+      indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indparent_tmp
+      indchildppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2))
+     & = indchild_tmp
+      deallocate(indparent_tmp,indchild_tmp)
+      endif
+      endif
+
+      if (.not.allocated(indparentppm_1d)) then
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      else
+      if (size(indparentppm_1d)<nc+4*coeffraf+1) then
+      deallocate(indparentppm_1d,indchildppm_1d)
+      allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),
+     &         indchildppm_1d(-2*coeffraf:nc+2*coeffraf))
+      endif
+      endif
+
+
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+C
+
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+
+!CDIR ALTCODE
+      Do i=1,coeffraf
+      tabppm(1,i,dir) = 0.08333333333333*
+     &              (-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,dir) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,dir) = 0.08333333333333*
+     &              (7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,dir) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(5,i,dir) = 0.08333333333333*
+     &              (2*tabdiff2(i)-3*tabdiff3(i))                   
+      End Do
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last
+             pos=1
+!CDIR ALTCODE
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm_1d(jj) = iparent-2
+         indchildppm_1d(jj) = pos
+               pos = pos+1
+             End do
+             ipos = ipos + coeffraf
+C
+        End do
+     
+       Do i=1,np2
+
+       indparentppm(1+(i-1)*nc:i*nc,dir) = 
+     &             indparentppm_1d(1:nc) + (i-1)*np
+       indchildppm (1+(i-1)*nc:i*nc,dir) = 
+     &             indchildppm_1d (1:nc) 
+
+       End do
+
+      Return
+      End Subroutine ppm1dprecompute2d
+
+
+      Subroutine ppm1dprecompute(np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to compute coefficient and index for  a 1D interpolation 
+CCC   using piecewise parabolic method  
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+C      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+C 
+      
+      if (.not.allocated(indparentppm)) then
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      else
+      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+      deallocate(indparentppm,indchildppm)
+      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),
+     &         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+      endif
+      endif
+            
+      ypos = s_child  
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) 
+     &      *ds_child - s_parent)/ds_parent)  
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+C     
+C
+      
+      Do i=1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+      EndDo
+
+      a = invcoeffraf**2 
+      tabdiff3(1) = (1./3.)*a
+      a=2.*a
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+      EndDo
+      
+!CDIR ALTCODE
+!!!CDIR SHORTLOOP
+      Do i=1,coeffraf
+      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+      tabppm(2,i,1) = 0.08333333333333*
+     &              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+      tabppm(4,i,1) = 0.08333333333333*
+     &              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))     
+      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) 
+      End Do   
+C 
+C
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+         indparentppm(jj,1) = iparent-2
+         indchildppm(jj,1) = pos
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do
+        
+      Return
+      End Subroutine ppm1dprecompute
+      
+      Subroutine ppm1daftercompute(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method: Use precomputed coefficient and index
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc,dir
+      Real, INTENT(IN),Dimension(np) :: x      
+      Real, INTENT(OUT),Dimension(nc) :: y
+C      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,a
+C      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: xl,delta,a6,slope
+      INTEGER :: diffmod
+C      
+C
+      do i=1,nc
+      y(i)=tabppm(1,indchildppm(i,dir),dir)*x(indparentppm(i,dir))+
+     &        tabppm(2,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+1)+
+     &        tabppm(3,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+2)+
+     &        tabppm(4,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+3)+
+     &        tabppm(5,indchildppm(i,dir),dir)*x(indparentppm(i,dir)+4)
+      enddo
+        
+      Return
+      End Subroutine ppm1daftercompute            
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1dnew(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1, delta2
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+      real, dimension(:,:), allocatable :: ak, ck
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+      Allocate(ak(0:1,coeffraf))
+      Allocate(ck(0:1,coeffraf))
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+      
+      ak = 0.
+      ck = 0.
+      
+      do i=1,coeffraf
+         do k=0,1
+         do s=0,2
+         do l=0,2
+           if (l /= s) then
+            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+           endif
+         enddo
+         enddo
+         enddo
+               
+         etap = 0
+         etan = 0
+         do k=0,1
+          if (ak(k,i) > 0) then
+            etap = etap+1
+          else if (ak(k,i) < 0) then
+            etan = etan + 1
+          endif
+         enddo
+               
+         do k=0,1
+           if (ak(k,i) == 0) then
+            Ck(k,i) = 1.
+           else if (ak(k,i) > 0) then
+            Ck(k,i) = 1./(etap * ak(k,i))
+           else
+            Ck(k,i) = -1./(etan * ak(k,i))
+           endif
+         enddo
+      enddo
+                     
+C      
+      a = 0.
+      b = invcoeffraf
+      Do i=1,coeffraf
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+         a = a + invcoeffraf
+         b = b + invcoeffraf
+      End do
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      elseif( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-2 >= 1) then
+          nmin = locind_parent_left-2
+      elseif(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+      DO i=nmin+2,nmax
+        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)
+     &       +(slope(i)-slope(i-1))**2
+      enddo
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             
+            delta0=1./(epsilon+smooth(iparent  ))**3
+            delta1=1./(epsilon+smooth(iparent+1))**3
+            delta2=1./(epsilon+smooth(iparent+2))**3   
+                      
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+        
+        deallocate(ak,ck)
+        
+      Return
+      End Subroutine weno1dnew
+      
+C     **************************************************************************  
+CCC   Subroutine weno1d
+C     ************************************************************************** 
+C 
+      Subroutine weno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+CCC   using piecewise parabolic method  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc
+      Real, Dimension(np) :: x
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+C      
+      Real :: xrmin,xrmax,am3,s2,s1
+      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+      INTEGER :: diffmod
+      REAL :: invcoeffraf
+      integer :: s,l,k
+      integer :: etan, etap
+      real :: delta0, delta1,sumdelta
+      real :: epsilon
+      parameter (epsilon = 1.D-8)
+C      
+      coeffraf = nint(ds_parent/ds_child)
+C
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+      invcoeffraf = ds_child/ds_parent
+            
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child
+C
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1)
+     &      *ds_child - s_parent)/ds_parent)
+C
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+C     
+      Allocate( diff(coeffraf))
+C      
+      diff(1)=0.5*invcoeffraf
+      do i=2,coeffraf
+         diff(i) = diff(i-1)+invcoeffraf
+      enddo
+C
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2   
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+C      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+C 
+      Do i = nmin+1,nmax
+         slope(i) = (x(i) - x(i-1))
+      Enddo 
+C
+        diffmod = 0
+        IF (mod(coeffraf,2) == 0) diffmod = 1           
+C
+        ipos = i1
+C               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+            delta0=1./(epsilon+slope(iparent  )**2)**2
+            delta1=1./(epsilon+slope(iparent+1)**2)**2
+            sumdelta = 1./(delta0+delta1)             
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+C                              
+          ytemp(jj) = x(iparent)+(diff(pos)-0.5)*(
+     &                delta0*slope(iparent)+
+     &                delta1*slope(iparent+1))*sumdelta
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+C
+        End do     
+C
+C
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff)
+        
+      Return
+      End Subroutine weno1d
+                 
+C                              
+C     **************************************************************************  
+CCC   Subroutine eno1d
+C     ************************************************************************** 
+C 
+      Subroutine eno1d(x,y,np,nc,
+     &                    s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   ---- p 163-164 Computational gasdynamics ----
+CCC   Subroutine to do a 1D interpolation 
+CCC   using piecewise polynomial ENO reconstruction technique  
+CCC   on a child grid (vector y) from its parent grid (vector x).
+CC    Method:
+C
+C     Declarations:
+C
+      Implicit none
+C        
+C     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+C
+C     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: ipos,pos
+      Real    :: ypos,xi
+      integer :: i1,jj
+      Real :: xpmin,cavg
+C 
+      Real, Dimension(3,np) :: dd,c
+      Integer :: left
+C           
+      Real, DImension(1:np+1) :: xhalf
+      Real, Dimension(:,:),Allocatable  :: Xbar 
+      INTEGER :: diffmod     
+C
+      coeffraf = nint(ds_parent/ds_child)
+C      
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If     
+      
+      diffmod = 0
+      IF (mod(coeffraf,2) == 0) diffmod = 1  
+C      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 +
+     &      agrif_ceiling((ypos +(nc - 1) *ds_child - 
+     &      s_parent)/ds_parent)       
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent      
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)           
+C      
+      xhalf(np+1) = np + 0.5
+      Do i = 1,np
+          xhalf(i) = i - 0.5
+      Enddo
+C
+C compute divided differences
+C
+      dd(1,1:np) = x(1:np)
+      dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+      dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+C
+      Allocate( Xbar( coeffraf,2 ) )
+      xi = 0.5
+      Do i = 1,coeffraf
+        Xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        Xbar(i,2) = i*ds_child/ds_parent - xi
+      Enddo
+C
+      ipos = i1
+C           
+      DO i = locind_parent_left,locind_parent_last           
+         left = i           
+         do jj = 2,3
+             If(abs(dd(jj,left)) .gt. abs(dd(jj,left-1)))
+     &               left = left-1            
+         enddo
+C           
+C  convert to Taylor series form
+C
+         Call Taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+      ENDDO     
+C
+C evaluate the reconstruction on each cell
+C
+       DO i = locind_parent_left,locind_parent_last  
+C
+         cavg = 0.
+         pos = 1.            
+C         
+         Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+           ytemp(jj) =(c(1,i)*(Xbar(pos,2)-Xbar(pos,1))
+     &                +c(2,i)*(Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1))
+     &                +c(3,i)*(Xbar(pos,2)*Xbar(pos,2)*Xbar(pos,2)-
+     &                         Xbar(pos,1)*Xbar(pos,1)*Xbar(pos,1)))
+     &                         *coeffraf
+           cavg = cavg + ytemp(jj)
+           pos = pos+1
+         Enddo                
+         ipos = ipos + coeffraf                 
+      ENDDO
+C
+      y(1:nc)=ytemp(1:nc)                                            
+      deallocate(ytemp,Xbar)                 
+C      
+      Return       
+      End Subroutine eno1d
+C 
+C      
+C     **************************************************************************  
+CCC   Subroutine taylor
+C     ************************************************************************** 
+C       
+      subroutine taylor(ind,xhalf,dd,c)      
+C      
+      Integer :: ind
+      real,dimension(3) :: dd,c     
+      real,dimension(0:3,0:3) :: d 
+      real,dimension(3) :: xhalf    
+      integer ::i,j
+C      
+C
+      d(0,0:3)=1.
+      do i = 1,3
+         d(i,0)=(ind-xhalf(i))*d(i-1,0)
+      enddo  
+C      
+      do i = 1,3
+         do j = 1,3-i
+           d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+         enddo
+      enddo
+C         
+      do j = 1,3        
+         c(j) = 0.
+         do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)         
+         enddo
+      enddo
+C      
+      end subroutine taylor    
+      
+      
+      REAL FUNCTION vanleer(tab)
+      REAL, DIMENSION(3) :: tab
+       real res1
+       real p1,p2,p3
+       
+       p1=(tab(3)-tab(1))/2.
+       p2=2.*(tab(2)-tab(1))
+       p3=2.*(tab(3)-tab(2))
+       
+       if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+          res1=minval((/p1,p2,p3/))
+       elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+          res1=maxval((/p1,p2,p3/))
+       else
+          res1=0.
+       endif
+          
+          vanleer = res1   
+      
+      
+      END FUNCTION vanleer 
+
+C      
+      End Module Agrif_Interpbasic
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F	(revision 3437)
@@ -0,0 +1,186 @@
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+      Module Agrif_link
+C
+CCC   Description:
+CCC   This module is used to link AGRIF files to the model
+C
+C     Modules used: 
+C
+c        external Agrif_InitValues
+c        external Agrif_detect
+C
+        external Agrif_InitWorkspace
+        external Agrif_probdim_modtype_def
+        external Agrif_clustering_def
+        external Agrif_comm_def
+C     Interface                       
+      INTERFACE
+      SUBROUTINE  Sub_Loop_Agrif_InvLoc(indloc,nprocloc,i,
+     &            indglob,njmppt,nimppt)
+      INTEGER :: indglob
+      INTEGER :: indloc
+      INTEGER :: nprocloc
+      INTEGER :: i
+
+      INTEGER, ALLOCATABLE, Dimension(:) :: njmppt
+      INTEGER, ALLOCATABLE, Dimension(:) :: nimppt
+      END SUBROUTINE
+      END INTERFACE
+      Interface
+         Subroutine Agrif_Set_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Set_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Get_numberofcells(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Get_numberofcells
+      End interface
+      Interface
+         Subroutine Agrif_Allocationcalls(Agrif_Gr)
+         Use Agrif_Types, Only : Agrif_grid
+         TYPE(Agrif_Grid), Pointer :: Agrif_Gr   ! Pointer on the current grid  
+         End Subroutine Agrif_Allocationcalls
+      End interface
+C   
+      End Module Agrif_link
+C     **************************************************************************
+CCC   Function Agrif_parent
+C        modify by conv. To use : un_parent = Agrif_Parent(un)
+C     **************************************************************************
+CCC   Function Agrif_Get_Coarse_Grid
+C        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+C     **************************************************************************
+CCC   Function Agrif_Rhox
+C        modify by conv. To use : var = Agrif_Rhox()
+C                    REAL(Agrif_Curgrid % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhox
+C        modify by conv. To use : var = Agrif_Parent_Rhox()
+C                    REAL(Agrif_Curgrid % parent % spaceref(1))
+C     **************************************************************************
+CCC   Function Agrif_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhox
+C        modify by conv. To use : var = Agrif_Parent_IRhox()
+C                    Agrif_Curgrid % parent % spaceref(1)
+C     **************************************************************************
+CCC   Function Agrif_Rhoy
+C        modify by conv. To use : var = Agrif_Rhoy()
+C                    REAL(Agrif_Curgrid % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoy
+C        modify by conv. To use : var = Agrif_Parent_Rhoy()
+C                    REAL(Agrif_Curgrid % parent % spaceref(2))
+C     **************************************************************************
+CCC   Function Agrif_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoy
+C        modify by conv. To use : var = Agrif_Parent_IRhoy()
+C                    Agrif_Curgrid % parent % spaceref(2)
+C     **************************************************************************
+CCC   Function Agrif_Rhoz
+C        modify by conv. To use : var = Agrif_Rhoz()
+C                    REAL(Agrif_Curgrid % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Parent_Rhoz
+C        modify by conv. To use : var = Agrif_Parent_Rhoz()
+C                    REAL(Agrif_Curgrid % parent % spaceref(3))
+C     **************************************************************************
+CCC   Function Agrif_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_Parent_Irhoz
+C        modify by conv. To use : var = Agrif_Parent_IRhoz()
+C                    Agrif_Curgrid % parent % spaceref(3)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderX
+C        modify by conv. To use : var = Agrif_NearCommonBorderX()
+C                       AGRIF_CURGRID % NearRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderY
+C        modify by conv. To use : var = Agrif_NearCommonBorderY()
+C                       AGRIF_CURGRID % NearRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_NearCommonBorderZ
+C        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+C                       AGRIF_CURGRID % NearRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderX
+C        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+C                       AGRIF_CURGRID % DistantRootBorder(1)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderY
+C        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+C                       AGRIF_CURGRID % DistantRootBorder(2)
+C     **************************************************************************
+CCC   Function Agrif_DistantCommonBorderZ
+C        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+C                       AGRIF_CURGRID % DistantRootBorder(3)
+C     **************************************************************************
+CCC   Function Agrif_Nb_Step
+C        modify by conv. To use : var = Agrif_Nb_Step()
+C                          AGRIF_CURGRID % ngridstep
+C     **************************************************************************
+CCC   Function Agrif_Nb_Fine_Grids
+C        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+C                         Agrif_nbfixedgrids 
+C     **************************************************************************
+CCC   Function Agrif_Ix
+C        modify by conv. To use : var = Agrif_Ix()
+C                         Agrif_CURGRID % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Ix
+C        modify by conv. To use : var = Agrif_Parent_Ix()
+C                        Agrif_CURGRID % parent % ix(1) 
+C     **************************************************************************
+CCC   Function Agrif_Iy
+C        modify by conv. To use : var = Agrif_Iy()
+C                        AGRIF_CURGRID % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iy
+C        modify by conv. To use : var = Agrif_Parent_Iy()
+C                       Agrif_CURGRID % parent % ix(2) 
+C     **************************************************************************
+CCC   Function Agrif_Iz
+C        modify by conv. To use : var = Agrif_Iz()
+C                      AGRIF_CURGRID % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Parent_Iz
+C        modify by conv. To use : var = Agrif_Parent_Iz()
+C                     Agrif_CURGRID % parent % ix(3) 
+C     **************************************************************************
+CCC   Function Agrif_Get_grid_id
+C        modify by conv. To use : var = Agrif_Get_grid_id()
+C                    Agrif_CURGRID % grid_id
+C     **************************************************************************
+CCC   Function Agrif_Get_parent_id
+C        modify by conv. To use : var = Agrif_Get_parent_id()
+C                    Agrif_CURGRID % parent % grid_id
+C     **************************************************************************
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmask.F	(revision 3437)
@@ -0,0 +1,688 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Mask
+C
+      Module Agrif_Mask
+C
+CCC   Description:
+CCC   Module for masks
+C
+C     Modules used: 
+C
+      Use Agrif_Types       
+C
+      IMPLICIT NONE
+C
+      CONTAINS
+C     Define procedures contained in this module
+C
+C     **************************************************************************
+C     Subroutine Agrif_CheckMasknD
+C     **************************************************************************
+C       
+      Subroutine Agrif_CheckMasknD(tempP,parent,pbtab,petab,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: pbtab  ! Limits of the parent grid used  
+      INTEGER,DIMENSION(nbdim) :: petab  ! interpolation of the child grid
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                   :: i0,j0,k0,l0,m0,n0
+C      
+C     Local arrays
+C
+C      
+      SELECT CASE (nbdim)
+      CASE (1)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array1(i0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+      CASE (2)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array2(i0,j0)
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo  
+         enddo
+      CASE (3)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array3(i0,j0,k0)
+     &                        == Agrif_SpecialValue) Then
+!------CDIR NEXPAND
+            Call CalculNewValTempP3D((/i0,j0,k0/),
+     &      tempP%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &      parent%var%array3(ppbtab(1),ppbtab(2),ppbtab(3)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+     
+c            Call CalculNewValTempP((/i0,j0,k0/),
+c     &                             tempP,parent,
+c     &                             ppbtab,ppetab,
+c     &                             noraftab,nbdim)
+          
+         ENDIF
+         enddo
+         enddo  
+         enddo
+      CASE (4)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array4(i0,j0,k0,l0) 
+     &                        == Agrif_SpecialValue) Then
+            Call CalculNewValTempP4D((/i0,j0,k0,l0/),
+     &      tempP%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &      parent%var%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),
+     &                           ppbtab,ppetab,
+     &                           noraftab,MaxSearch,Agrif_SpecialValue)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+      CASE (5)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array5(i0,j0,k0,l0,m0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      CASE (6)
+         do n0 = pbtab(6),petab(6)
+         do m0 = pbtab(5),petab(5)
+         do l0 = pbtab(4),petab(4)
+         do k0 = pbtab(3),petab(3)
+         do j0 = pbtab(2),petab(2)
+         do i0 = pbtab(1),petab(1)
+         IF (tempP%var%array6(i0,j0,k0,l0,m0,n0) 
+     &                       == Agrif_SpecialValue) Then
+            Call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/),
+     &                             tempP,parent,
+     &                             ppbtab,ppetab,
+     &                             noraftab,nbdim)
+         ENDIF
+         enddo
+         enddo
+         enddo
+         enddo  
+         enddo
+         enddo
+      END SELECT
+C
+C      
+C     
+      End Subroutine Agrif_CheckMasknD
+C
+C
+C     **************************************************************************
+C     Subroutine CalculNewValTempP
+C     **************************************************************************
+C       
+      Subroutine CalculNewValTempP(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,nbdim)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+C
+C     Pointer argument
+      TYPE(AGRIF_PVARIABLE) :: tempP  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C     Data TYPE argument                                   
+      TYPE(AGRIF_PVARIABLE) :: parent      ! The parent grid
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+!CDIR NOVECTOR
+                     idecal = indic
+                     idecal(iii) = idecal(iii)-1
+                     SELECT CASE(nbdim)
+                     CASE (1)
+                        if (tempP%var%array1(idecal(1)
+     &                            ) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                     
+                     CASE (2)
+                        if (tempP%var%array2(idecal(1),
+     &            idecal(2)) == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+                     CASE (3)
+                        if (tempP%var%array3(idecal(1),
+     &            idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (4)
+                        if (tempP%var%array4(idecal(1),
+     &            idecal(2),idecal(3),idecal(4)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif     
+                     CASE (5)
+                        if (tempP%var%array5(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif  
+                     CASE (6)
+                        if (tempP%var%array6(idecal(1),
+     &            idecal(2),idecal(3),idecal(4),idecal(5),idecal(6)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif                                                                                           
+                     END SELECT
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+            SELECT CASE(nbdim)
+            CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array1(ii)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo
+C
+            CASE (2)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array2(ii,jj)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+               enddo  
+               enddo
+               
+            CASE (3)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array3(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (4)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array4(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (5)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array5(ii,jj,kk,ll,mm)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            CASE (6)
+               do nn = imin(6),imax(6)
+               do mm = imin(5),imax(5)
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+               do ii = imin(1),imax(1)
+                    ValParent = parent%var%array6(ii,jj,kk,ll,mm,nn)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                                          enddo
+                                    enddo
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+
+            END SELECT
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+            SELECT CASE(nbdim)
+            CASE (1)              
+              tempP%var%array1(indic(1)) 
+     &           = Res/Nbvals
+            CASE (2)
+              tempP%var%array2(indic(1),
+     &                            indic(2)) = Res/Nbvals
+            CASE (3)
+              tempP%var%array3(indic(1),
+     &                            indic(2),indic(3)) = Res/Nbvals
+            CASE (4)
+              tempP%var%array4(indic(1),
+     &                            indic(2),indic(3),indic(4))
+     &                = Res/Nbvals
+            CASE (5)
+              tempP%var%array5(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                   indic(5)) = Res/Nbvals
+            CASE (6)
+              tempP%var%array6(indic(1),
+     &                            indic(2),indic(3),indic(4),
+     &                           indic(5),indic(6)) = Res/Nbvals
+            END SELECT
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP
+C
+C
+      End Module Agrif_Mask     
+      
+      Subroutine CalculNewValTempP3D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 3
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      REAL :: Agrif_SpecialValue
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      INTEGER :: MaxSearch
+      LOGICAL :: Existunmasked
+C      
+C     Local arrays      
+C
+      ValMax = 1
+!CDIR NOVECTOR
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+!CDIR NOVECTOR
+      imin = indic
+!CDIR NOVECTOR
+      imax = indic
+      
+!CDIR NOVECTOR
+         idecal = indic	 
+C
+         i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+         
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+                     idecal(iii) = idecal(iii)-1
+
+                        if (tempP(idecal(1),idecal(2),idecal(3)) 
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                        endif
+
+                     idecal(iii) = idecal(iii)+1
+                  endif
+
+               endif            
+            enddo
+C
+            Existunmasked = .FALSE.
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    if ( parent(ii,jj,kk) .NE. Agrif_SpecialValue) then
+                        Existunmasked = .TRUE.
+                       exit
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+          if (.Not.Existunmasked) return
+C
+         i = 1
+C
+         do While(i <= ValMax)
+C
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+              exit
+            else
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP3D        
+
+      Subroutine CalculNewValTempP4D(indic,
+     &               tempP,parent,ppbtab,
+     &               ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+C
+CCC   Description:
+CCC   Subroutine called in the procedure Agrif_InterpnD to recalculate the value 
+CCC   of the parent grid variable when this one is equal to Agrif_SpecialValue. 
+C
+C     Declarations:
+C
+       
+C
+C     Arrays arguments      
+      INTEGER, PARAMETER :: nbdim = 4
+      INTEGER,DIMENSION(nbdim) :: indic
+      LOGICAL,DIMENSION(nbdim) :: noraftab
+      INTEGER,DIMENSION(nbdim) :: ppbtab,ppetab
+      INTEGER :: MaxSearch      
+      REAL :: Agrif_SpecialValue      
+C
+C     Pointer argument
+      REAL,DIMENSION(ppbtab(1):ppetab(1),ppbtab(2):ppetab(2),
+     &    ppbtab(3):ppetab(3),
+     &    ppbtab(4):ppetab(4)) :: tempP, parent  ! Part of the parent grid used for 
+                                      ! the interpolation of the child grid                     
+C
+C     Local scalar
+      INTEGER                  :: i,ii,iii,jj,kk,ll,mm,nn 
+      INTEGER,DIMENSION(nbdim) :: imin,imax,idecal
+      INTEGER                  :: Nbvals
+      REAL                     :: Res
+      REAL                     :: ValParent
+      INTEGER                  :: ValMax
+      LOGICAL                  :: firsttest
+C      
+C     Local arrays      
+C
+      ValMax = 1
+      do iii = 1 , nbdim
+         IF (.NOT.noraftab(iii)) THEN
+         ValMax = max(ValMax,ppetab(iii)-indic(iii))
+         ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+         ENDIF
+      enddo
+C
+      Valmax = min(Valmax,MaxSearch)
+C
+      imin = indic
+      imax = indic
+C
+         i = 1
+         firsttest = .TRUE.
+         idecal = indic	 
+	 
+C
+         do While(i <= ValMax)
+C
+         IF ((i == 1).AND.(firsttest)) i = Valmax
+
+            do iii = 1 , nbdim
+               if (.NOT.noraftab(iii)) then
+                  imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                  imax(iii) = min(indic(iii) + i,ppetab(iii))
+                  if (firsttest) then               
+                  if (indic(iii).GT.ppbtab(iii)) then
+
+
+                     idecal(iii) = idecal(iii)-1
+		     
+                     if (tempP(idecal(1),idecal(2),idecal(3),idecal(4))
+     &                               == Agrif_SpecialValue) then
+                           imin(iii) = imax(iii)
+                     endif
+		     
+		     idecal(iii) = idecal(iii)+1
+                  endif
+                  endif
+               endif            
+            enddo
+C
+            Res = 0.
+            Nbvals = 0
+C
+               do ll = imin(4),imax(4)
+               do kk = imin(3),imax(3)
+               do jj = imin(2),imax(2)
+               do ii = imin(1),imax(1)
+                    ValParent = parent(ii,jj,kk,ll)
+                    if ( ValParent .NE. Agrif_SpecialValue) then
+                        Res = Res + ValParent
+                        Nbvals = Nbvals + 1
+                    endif 
+                              enddo
+                        enddo
+                  enddo  
+               enddo
+C
+C
+            
+            if (Nbvals.GT.0) then
+              if (firsttest) then
+                   firsttest = .FALSE.
+                   i=1
+                   cycle
+              endif
+	      
+              tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+	    
+              exit
+            else
+               if (firsttest) exit
+               i = i + 1                      
+            endif
+          enddo            
+C     
+      End Subroutine CalculNewValTempP4D        
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F	(revision 3437)
@@ -0,0 +1,1119 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_mpp
+C
+      Module Agrif_mpp
+      Use Agrif_Types
+      Use Agrif_Arrays
+
+      Contains
+#ifdef key_mpp_mpi
+      Subroutine Get_External_Data_first(pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1,sendtoproc,recvfromproc,imin,imax,
+     &   imin_recv,imax_recv)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc, recvfromproc
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1):: imin,imax,
+     &   imin_recv,imax_recv
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+      
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+      
+      Call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,
+     &     recvfromproc,imin_recv,imax_recv)
+      
+      End Subroutine Get_External_Data_first
+C
+      Subroutine Get_External_Data(tempC,tempCextend,pttruetab,
+     &   cetruetab,pttruetabwhole,cetruetabwhole,nbdim,memberin,
+     &   memberout,memberoutall1)
+
+      IMPLICIT NONE
+      INCLUDE 'mpif.h'
+      INTEGER :: nbdim
+      TYPE(Agrif_PVariable) :: tempC, tempCextend
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab,
+     &                                                 cetruetab
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetabwhole,
+     &                                                 cetruetabwhole
+      INTEGER :: k,i,k2
+      LOGICAL :: sendtoproc(0:Agrif_Nbprocs-1)
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: imin,imax
+      LOGICAL :: memberin, memberout
+      INTEGER :: imintmp, imaxtmp,j,i1
+      INTEGER :: imin1,imax1
+      LOGICAL :: tochange,tochangebis
+      INTEGER,DIMENSION(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,
+     &                                                 cetruetab2
+      LOGICAL :: memberout1(1),memberoutall(0:Agrif_Nbprocs-1)
+      LOGICAL, OPTIONAL :: memberoutall1(0:Agrif_Nbprocs-1)
+      INTEGER :: code
+
+C pttruetab2 and cetruetab2 are modified arraysin order to always
+C send the most inner points
+
+        
+        IF (present(memberoutall1)) THEN
+        memberoutall = memberoutall1
+        ELSE
+         memberout1(1) = memberout
+
+         CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+        ENDIF
+         pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+         cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+         do k2=0,Agrif_Nbprocs-1
+            do i=1,nbdim
+
+           tochangebis=.TRUE.
+           DO i1=1,nbdim
+            IF (i .NE. i1) THEN
+              IF ((pttruetab(i1,Agrif_Procrank).NE.pttruetab(i1,k2)).OR.
+     &          (cetruetab(i1,Agrif_Procrank).NE.cetruetab(i1,k2))) THEN
+                   tochangebis = .FALSE.
+               EXIT
+              ENDIF
+             ENDIF
+           ENDDO
+
+           IF (tochangebis) THEN
+
+
+          imin1 = max(pttruetab(i,Agrif_Procrank),
+     &                    pttruetab(i,k2))
+          imax1 = min(cetruetab(i,Agrif_Procrank),
+     &                    cetruetab(i,k2))
+
+C Always send the most interior points
+
+           tochange = .false.
+           IF (cetruetab(i,Agrif_Procrank)> cetruetab(i,k2)) THEN
+
+           DO j=imin1,imax1
+             IF ((cetruetab(i,k2)-j) >
+     &             (j-pttruetab(i,Agrif_Procrank))) THEN
+             imintmp = j+1
+             tochange = .TRUE.
+             ELSE
+              EXIT
+             ENDIF
+          ENDDO
+          ENDIF
+
+           if (tochange) then
+C
+              pttruetab2(i,Agrif_Procrank) = imintmp
+C
+          endif
+
+           tochange = .FALSE.
+           imaxtmp=0
+           IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k2)) THEN
+          DO j=imax1,imin1,-1
+            IF ((j-pttruetab(i,k2)) >
+     &             (cetruetab(i,Agrif_Procrank)-j)) THEN
+             imaxtmp = j-1
+             tochange = .TRUE.
+            ELSE
+             EXIT
+            ENDIF
+          ENDDO
+
+          ENDIF
+
+                    if (tochange) then
+C
+              cetruetab2(i,Agrif_Procrank) = imaxtmp
+C
+          endif
+C
+
+          ENDIF
+           enddo
+         enddo
+
+
+       do k = 0,Agrif_NbProcs-1
+C
+        sendtoproc(k) = .true.
+C
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+C
+          imin(i,k) = max(pttruetab2(i,Agrif_Procrank),
+     &                    pttruetabwhole(i,k))
+          imax(i,k) = min(cetruetab2(i,Agrif_Procrank),
+     &                    cetruetabwhole(i,k))
+C
+          if (imin(i,k) > imax(i,k)) then
+C
+              sendtoproc(k) = .false.
+C
+          endif
+C
+        enddo
+        IF (.NOT.memberoutall(k)) THEN
+           sendtoproc(k) = .FALSE.
+        ENDIF
+C
+      enddo
+
+
+c       IF (.NOT.memberin) sendtoproc = .FALSE.
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      Call Exchangesamelevel(sendtoproc,nbdim,imin,imax,tempC,
+     &     tempCextend)
+
+      End Subroutine Get_External_Data
+
+       Subroutine ExchangeSameLevel(sendtoproc,nbdim,imin,imax,
+     &          tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+C                imin_recv(:,k) = iminmax_temp(:,1,k)
+C                imax_recv(:,k) = iminmax_temp(:,2,k)
+
+C                datasize = 1
+C
+C                do i = 1,nbdim
+C
+C                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+C                enddo
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   iminmax_temp(:,1,k),iminmax_temp(:,2,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,iminmax_temp(:,1,k),iminmax_temp(:,2,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel
+          
+       Subroutine ExchangeSameLevel_first(sendtoproc,nbdim,imin,imax,
+     &          recvfromproc,imin_recv,imax_recv)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+     
+      do k = 0,Agrif_ProcRank-1
+C
+C
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            
+            Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,code)
+C
+            if (sendtoproc(k)) then
+C
+                iminmax_temp(:,1,k) = imin(:,k)
+                iminmax_temp(:,2,k) = imax(:,k)
+
+                Call MPI_SEND(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+C
+            Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,
+     &                    MPI_COMM_AGRIF,statut,code)
+C
+            recvfromproc(k) = res
+
+C
+            if (recvfromproc(k)) then
+C
+                Call MPI_RECV(iminmax_temp(:,:,k),
+     &                        2*nbdim,MPI_INTEGER,k,etiquette,
+     &                        MPI_COMM_AGRIF,statut,code)
+
+                imin_recv(:,k) = iminmax_temp(:,1,k)
+                imax_recv(:,k) = iminmax_temp(:,2,k)
+            endif
+
+C
+      enddo
+
+          End Subroutine ExchangeSamelevel_first          
+
+       Subroutine ExchangeSameLevel2(sendtoproc,recvfromproc,
+     &   nbdim,
+     &          pttruetabwhole,cetruetabwhole,imin,imax,
+     &          imin_recv,imax_recv,memberout,tempC,tempCextend)
+      Implicit None
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin,imax
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: pttruetabwhole,
+     &     cetruetabwhole
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1) :: imin_recv,imax_recv
+      TYPE(Agrif_PVARIABLE) :: tempC,tempCextend
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: sendtoproc
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1)       :: recvfromproc
+      LOGICAL                                    :: res
+      LOGICAL :: memberout
+      TYPE(AGRIF_PVARIABLE), SAVE                      :: temprecv
+
+      INCLUDE 'mpif.h'
+          INTEGER :: i,k
+          INTEGER :: etiquette = 100
+          INTEGER :: code, datasize
+          INTEGER,DIMENSION(MPI_STATUS_SIZE)   :: statut
+
+      IF (memberout) THEN
+      Call Agrif_nbdim_allocation(tempCextend%var,
+     &                 pttruetabwhole(:,Agrif_ProcRank),
+     &                 cetruetabwhole(:,Agrif_ProcRank),nbdim)
+      call Agrif_nbdim_Full_VarEQreal(tempCextend%var,0.,nbdim)
+      ENDIF
+
+      IF (sendtoproc(Agrif_ProcRank)) THEN
+           Call Agrif_nbdim_VarEQvar(tempCextend%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               tempC%var,
+     &                               imin(:,Agrif_Procrank),
+     &                               imax(:,Agrif_Procrank),
+     &                               nbdim)
+      ENDIF
+
+      do k = 0,Agrif_ProcRank-1
+C
+C
+C
+            if (sendtoproc(k)) then
+C
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                  datasize = datasize * (imax(i,k)-imin(i,k)+1)
+C
+                enddo
+C
+
+                SELECT CASE(nbdim)
+                CASE(1)
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)               
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+     
+                  Call Agrif_Send_3Darray(tempC%var%array3,
+     &             lbound(tempC%var%array3),imin(:,k),imax(:,k),k)
+                CASE(4)
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+
+C
+            if (recvfromproc(k)) then
+
+                datasize = 1
+C
+!CDIR SHORTLOOP
+                do i = 1,nbdim
+C
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+C
+                enddo
+
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,imin_recv(:,k),
+     &   imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)       
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+       END SELECT
+                        
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+
+            endif
+
+C
+      enddo
+
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+C
+C
+            if (sendtoproc(k)) then
+C
+                SELECT CASE(nbdim)
+                CASE(1)
+                datasize=SIZE(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)))
+                   Call MPI_SEND(tempC%var%array1(
+     &                        imin(1,k):imax(1,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(2)                
+                datasize=SIZE(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)))
+                   Call MPI_SEND(tempC%var%array2(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(3)
+                datasize=SIZE(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)))
+                   Call MPI_SEND(tempC%var%array3(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(4)
+                datasize=SIZE(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)))
+                   Call MPI_SEND(tempC%var%array4(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(5)
+                datasize=SIZE(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)))
+                   Call MPI_SEND(tempC%var%array5(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                CASE(6)
+                datasize=SIZE(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)))
+                   Call MPI_SEND(tempC%var%array6(
+     &                        imin(1,k):imax(1,k),
+     &                        imin(2,k):imax(2,k),
+     &                        imin(3,k):imax(3,k),
+     &                        imin(4,k):imax(4,k),
+     &                        imin(5,k):imax(5,k),
+     &                        imin(6,k):imax(6,k)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+                END SELECT
+C
+            endif
+
+C
+      enddo
+C
+C
+C     Reception from others processors of the necessary part of the parent grid
+      do k = Agrif_ProcRank-1,0,-1
+C
+
+C
+            if (recvfromproc(k)) then
+C
+             IF (.Not.Associated(temprecv%var)) allocate(temprecv%var)
+             call Agrif_nbdim_allocation(temprecv%var,
+     &   imin_recv(:,k),imax_recv(:,k),nbdim)
+            SELECT CASE(nbdim)
+            CASE(1)
+              datasize=SIZE(temprecv%var%array1)
+              Call MPI_RECV(temprecv%var%array1,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(2)           
+              datasize=SIZE(temprecv%var%array2)
+              Call MPI_RECV(temprecv%var%array2,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(3)           
+              datasize=SIZE(temprecv%var%array3)
+              Call MPI_RECV(temprecv%var%array3,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+
+            CASE(4)
+              datasize=SIZE(temprecv%var%array4)
+              Call MPI_RECV(temprecv%var%array4,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(5)
+              datasize=SIZE(temprecv%var%array5)
+              Call MPI_RECV(temprecv%var%array5,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+            CASE(6)
+              datasize=SIZE(temprecv%var%array6)
+              Call MPI_RECV(temprecv%var%array6,
+     &               datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &               MPI_COMM_AGRIF,statut,code)
+          END SELECT
+            
+            Call where_valtabtotab_mpi(tempCextend%var,
+     &             temprecv%var,imin_recv(:,k),imax_recv(:,k)
+     &            ,0.,nbdim)
+     
+                Call Agrif_nbdim_deallocation(temprecv%var,nbdim)
+C                deallocate(temprecv%var)
+            endif
+
+C
+      enddo
+                  
+          End Subroutine ExchangeSamelevel2
+          
+          Subroutine Agrif_Send_3Darray(tab3D,bounds,imin,imax,k)
+          integer, dimension(3) :: bounds, imin, imax
+          real,dimension(bounds(1):,bounds(2):,bounds(3):),target
+     &                             :: tab3D
+          integer :: k
+          integer :: etiquette = 100
+          integer :: datasize, code
+        INCLUDE 'mpif.h'
+
+          datasize = SIZE(tab3D(
+     &                       imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)))
+       
+                   Call MPI_SEND(tab3D(
+     &                        imin(1):imax(1),
+     &                        imin(2):imax(2),
+     &                        imin(3):imax(3)),
+     &                        datasize,MPI_DOUBLE_PRECISION,k,etiquette,
+     &                        MPI_COMM_AGRIF,code)
+     
+         End Subroutine Agrif_Send_3Darray
+
+#else
+      Subroutine Agrif_mpp_empty()
+      End Subroutine Agrif_mpp_empty
+#endif
+
+      End Module Agrif_mpp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F	(revision 3437)
@@ -0,0 +1,937 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Save  
+C
+      Module Agrif_Save 
+C
+CCC   Description:   
+CCC   Module for the initialization by copy of the grids created by clustering.
+C
+C     Modules used:
+C      
+      Use Agrif_Types
+      Use Agrif_Link
+      Use Agrif_Arrays
+      Use Agrif_Variables
+C
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C
+      Subroutine Agrif_Deallocate_Arrays(Var)
+      type(Agrif_Variable), pointer :: Var
+      
+            if (ALLOCATED(var%array1)) then
+               Deallocate(var%array1)
+            endif
+            if (ALLOCATED(var%array2)) then
+               Deallocate(var%array2)
+            endif
+            if (ALLOCATED(var%array3)) then
+               Deallocate(var%array3)
+            endif
+            if (ALLOCATED(var%array4)) then
+               Deallocate(var%array4)
+            endif
+            if (ALLOCATED(var%array5)) then
+               Deallocate(var%array5)
+            endif
+            if (ALLOCATED(var%array6)) then
+               Deallocate(var%array6)
+            endif
+C
+            if (ALLOCATED(var%darray1)) then
+               Deallocate(var%darray1)
+            endif
+            if (ALLOCATED(var%darray2)) then
+               Deallocate(var%darray2)
+            endif
+            if (ALLOCATED(var%darray3)) then
+               Deallocate(var%darray3)
+            endif
+            if (ALLOCATED(var%darray4)) then
+               Deallocate(var%darray4)
+            endif
+            if (ALLOCATED(var%darray5)) then
+               Deallocate(var%darray5)
+            endif
+            if (ALLOCATED(var%darray6)) then
+               Deallocate(var%darray6)
+            endif
+C
+            if (ALLOCATED(var%larray1)) then
+               Deallocate(var%larray1)
+            endif
+            if (ALLOCATED(var%larray2)) then
+               Deallocate(var%larray2)
+            endif
+            if (ALLOCATED(var%larray3)) then
+               Deallocate(var%larray3)
+            endif
+            if (ALLOCATED(var%larray4)) then
+               Deallocate(var%larray4)
+            endif
+            if (ALLOCATED(var%larray5)) then
+               Deallocate(var%larray5)
+            endif
+            if (ALLOCATED(var%larray6)) then
+               Deallocate(var%larray6)
+            endif
+C
+            if (ALLOCATED(var%iarray1)) then
+               Deallocate(var%iarray1)
+            endif
+            if (ALLOCATED(var%iarray2)) then
+               Deallocate(var%iarray2)
+            endif
+            if (ALLOCATED(var%iarray3)) then
+               Deallocate(var%iarray3)
+            endif
+            if (ALLOCATED(var%iarray4)) then
+               Deallocate(var%iarray4)
+            endif
+            if (ALLOCATED(var%iarray5)) then
+               Deallocate(var%iarray5)
+            endif
+            if (ALLOCATED(var%iarray6)) then
+               Deallocate(var%iarray6)
+            endif
+C
+            if (ALLOCATED(var%carray1)) then
+               Deallocate(var%carray1)
+            endif
+            if (ALLOCATED(var%carray2)) then
+               Deallocate(var%carray2)
+            endif
+C
+            if (associated(var%oldvalues2D)) then
+               Deallocate(var%oldvalues2D)
+            endif
+            if (associated(var%interpIndex)) then
+               Deallocate(var%interpIndex)
+            endif
+            
+            if (associated(var%posvar)) then
+               Deallocate(var%posvar)
+            endif     
+            
+            if (associated(var%interptab)) then
+               Deallocate(var%interptab)
+            endif
+            
+      Return
+      End Subroutine Agrif_Deallocate_Arrays    
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_before
+C     **************************************************************************
+C
+      Subroutine Agrif_Free_data_before(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid
+      INTEGER i 
+      Type(Agrif_List_Variables), pointer :: parcours      
+C
+C   
+      do i = 1 , AGRIF_NbVariables
+         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+C 
+            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+            
+       endif
+           
+C
+       if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then
+         Call Agrif_Free_list_interp
+     &                          (Agrif_Gr%tabvars(i)%var%list_interp)
+       endif                             
+C
+       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+C 
+        endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (.NOT. parcours%pvar%var%root_var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+       endif
+        if (associated(parcours%pvar%var%list_interp)) then
+           Call Agrif_Free_list_interp
+     &                          (parcours%pvar%var%list_interp)
+         endif                             
+C
+       if ( .NOT. parcours%pvar%var%root_var % restaure) then
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+      enddo
+C
+C 
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+         if ( Agrif_Probdim .EQ. 1 ) Deallocate(Agrif_Gr%tabpoint1D)
+         if ( Agrif_Probdim .EQ. 2 ) Deallocate(Agrif_Gr%tabpoint2D)
+         if ( Agrif_Probdim .EQ. 3 ) Deallocate(Agrif_Gr%tabpoint3D)
+      endif
+C          
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_before
+C
+C
+      Recursive Subroutine Agrif_Free_list_interp(list_interp)
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_interp
+      
+      if (associated(list_interp%suiv))
+     &      Call Agrif_Free_list_interp(list_interp%suiv)
+     
+#ifdef key_mpp_mpi
+       Deallocate(list_interp%interp_loc%tab4t)
+       Deallocate(list_interp%interp_loc%memberinall)
+       Deallocate(list_interp%interp_loc%sendtoproc1)
+       Deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       Deallocate(list_interp%interp_loc)
+       Deallocate(list_interp)
+       Nullify(list_interp)
+
+      End Subroutine Agrif_Free_list_interp      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_data_after
+C     **************************************************************************
+C      
+      Subroutine Agrif_Free_data_after(Agrif_Gr)
+C
+CCC   Description:
+CCC   
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid
+      INTEGER i
+      Type(Agrif_List_Variables), pointer :: parcours, rootparcours
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then
+            
+         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var)
+         !
+            Deallocate(Agrif_Gr%tabvars(i)%var)
+! 
+         endif
+      enddo
+      
+      parcours => Agrif_Gr%variables
+      rootparcours=>Agrif_Mygrid%variables
+    
+      do i=1,Agrif_Gr%NbVariables
+       if (rootparcours%pvar%var%restaure) then
+        call Agrif_Deallocate_Arrays(parcours%pvar%var)
+      
+            Deallocate(parcours%pvar%var)
+C 
+        endif
+        parcours => parcours%nextvariable
+        rootparcours => rootparcours%nextvariable        
+      enddo
+            
+C
+C      
+      Return
+C
+C
+      End Subroutine Agrif_Free_data_after      
+C
+C
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_All
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_All(g,oldchildgrids)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOld(g,parcours%gr)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_All
+     &             (g, parcours % gr % child_grids)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_All
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromold
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromold(Agrif_New_Gr,Agrif_Old_Gr)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: i
+C
+C      
+      do i = 1 , AGRIF_NbVariables
+         if ( Agrif_Mygrid % tabvars(i) % var % restaure ) then
+C
+            Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           Agrif_New_Gr % tabvars(i),
+     &           Agrif_Old_Gr % tabvars(i))
+C
+        endif
+      enddo
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromold
+      
+CC    **************************************************************************
+CCC   Subroutine AGRIF_CopyFromold_AllOneVar
+C     **************************************************************************
+C
+      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids,
+     &   indic)
+C
+CCC   Description:
+CCC   Routine called in the Agrif_Init_Hierarchy procedure 
+C       (Agrif_Clustering module). 
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid
+      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids
+      integer :: indic
+C
+C     Local pointer
+      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure 
+      REAL g_eps,eps,oldgrid_eps
+      INTEGER :: out
+      INTEGER :: iii
+C
+      out = 0
+C                                                                           
+      parcours => oldchildgrids  
+C
+      do while (associated(parcours))
+C 
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+C        
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1 , Agrif_Probdim
+               g_eps = min(g_eps,g % Agrif_d(iii))
+               oldgrid_eps = min(oldgrid_eps,
+     &                       parcours % gr % Agrif_d(iii))
+            enddo
+C
+            eps = min(g_eps,oldgrid_eps)/100.                  
+C
+            do iii = 1 , Agrif_Probdim
+
+               if (g % Agrif_d(iii) .LT. 
+     &             (parcours % gr % Agrif_d(iii) - eps)) then
+C            
+                   parcours => parcours % next
+C            
+                   out = 1
+C   
+                   Exit
+C             
+               endif
+C      
+            enddo
+        if ( out .EQ. 1 ) Cycle
+C
+            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic)
+C
+        endif
+C                     
+        Call Agrif_CopyFromold_AllOneVar
+     &             (g, parcours % gr % child_grids,indic)
+C        
+        parcours => parcours % next
+C        
+      enddo
+C
+C     
+      Return      
+C
+C
+      End Subroutine AGRIF_CopyFromold_AllOneVar
+C
+C
+C      
+C     **************************************************************************
+CCC   Subroutine Agrif_CopyFromoldOneVar
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr,
+     &    indic)
+C
+CCC   Description:
+CCC   Call to the Agrif_Copy procedure.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid
+      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      INTEGER :: indic
+      INTEGER :: i
+      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars      
+C
+C      
+      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic)
+      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic)
+
+      Call Agrif_Nbdim_Allocation(tabvars%var,
+     &  tabvars%var%lb,tabvars%var%ub,
+     &  tabvars%var%nbdim)
+     
+      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,
+     &           tabvars,oldtabvars)
+
+
+C      
+C            
+      Return
+C
+C      
+      End Subroutine Agrif_CopyFromoldOneVar      
+      
+C
+C
+CC
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Copy
+C     **************************************************************************
+C      
+      Subroutine Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr,New_Var,Old_Var)
+C     
+CCC   Description:
+CCC   Sets arguments of the Agrif_UpdatenD procedures, n being the number of 
+CCC   DIMENSION of the grid variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+C     Pointer argument    
+      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr   ! Pointer on the current grid
+      TYPE(Agrif_Grid), Pointer :: Agrif_Old_Gr    ! Pointer on an old grid
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var
+      INTEGER :: nbdim                  ! Number of dimensions of the current 
+                                        ! grid      
+      INTEGER,DIMENSION(6) :: pttabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabnew  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: pttabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: petabold  ! Indexes of the first point in the 
+                                        ! domain
+      INTEGER,DIMENSION(6) :: nbtabold  ! Number of cells in each direction
+      
+      INTEGER,DIMENSION(6) :: nbtabnew  ! Number of cells in each direction   
+      TYPE(AGRIF_Variable), Pointer :: root ! Pointer on the variable of the 
+                                            ! root grid
+      REAL, DIMENSION(6) :: snew,sold
+      REAL, DIMENSION(6) :: dsnew,dsold                              
+      REAL :: eps
+      INTEGER :: n
+C
+C  
+      root => New_Var % var % root_var 
+C      
+      nbdim = root % nbdim
+C         
+      do n=1,nbdim
+C  
+        select case(root % interptab(n))
+C        
+        case('x')                
+C
+          pttabnew(n) = root % point(1)
+C        
+          pttabold(n) = root % point(1)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(1)
+C
+          sold(n) = Agrif_Old_Gr % Agrif_x(1) 
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(1)
+C
+          dsold(n) = Agrif_Old_Gr % Agrif_d(1)
+C                      
+          if (root % posvar(n) .EQ. 1) then
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(1) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(1) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.
+C        
+          endif           
+C        
+        case('y')
+C        
+          pttabnew(n) = root % point(2)
+C        
+          pttabold(n) = root % point(2)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(2)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(2)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(2)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(2)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2)         
+C        
+            else
+C          
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(2) - 1
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(2) - 1
+C
+              snew(n) = snew(n) + dsnew(n)/2.
+C
+              sold(n) = sold(n) + dsold(n)/2.                    
+C        
+          endif 
+C        
+        case('z')
+C        
+          pttabnew(n) = root % point(3)
+C        
+          pttabold(n) = root % point(3)
+C        
+          snew(n) = Agrif_New_Gr % Agrif_x(3)
+C        
+          sold(n) = Agrif_Old_Gr % Agrif_x(3)
+C        
+          dsnew(n) = Agrif_New_Gr % Agrif_d(3)
+C        
+          dsold(n) = Agrif_Old_Gr % Agrif_d(3)
+C                
+          if (root % posvar(n) .EQ. 1) then
+C        
+              petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3)
+C          
+              petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3)         
+C        
+            else
+C          
+             petabnew(n) = pttabnew(n) + Agrif_New_Gr % nb(3) - 1
+C          
+             petabold(n) = pttabold(n) + Agrif_Old_Gr % nb(3) - 1
+C
+             snew(n) = snew(n) + dsnew(n)/2.
+C
+             sold(n) = sold(n) + dsold(n)/2.                   
+C        
+          endif
+C          
+        case('N')
+C        
+          Call Agrif_nbdim_Get_bound(New_Var%var,
+     &                           pttabnew(n),petabnew(n),
+     &                           n,nbdim)
+C        
+          pttabold(n) = pttabnew(n)
+C      
+          petabold(n) = petabnew(n)
+C              
+          snew(n) = 0.
+C      
+          sold(n) = 0. 
+C      
+          dsnew(n) = 1.
+C      
+          dsold(n) = 1.
+C        
+        end select
+C      
+      enddo
+C      
+      do n = 1,nbdim
+C      
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+C      
+        nbtabold(n) = petabold(n) - pttabold(n)      
+C 
+      enddo      
+C
+      eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim)))
+C     
+      eps = eps/100.      
+C      
+      do n = 1,nbdim
+C      
+        if (snew(n) .GT. (sold(n)+dsold(n)*nbtabold(n)+eps)) Return
+C      
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) .LT. sold(n)) Return
+C      
+      enddo
+C            
+C
+      Call AGRIF_CopynD
+     &        (New_Var,Old_Var,pttabold,petabold,pttabnew,petabnew,
+     &         sold,snew,dsold,dsnew,nbdim) 
+C      
+C 
+      Return
+C      
+C
+      End Subroutine Agrif_Copy
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_CopynD
+C     **************************************************************************
+C      
+      Subroutine Agrif_CopynD(New_Var,Old_Var,pttabold,petabold,
+     &                        pttabnew,petabnew,sold,snew,dsold,
+     &                        dsnew,nbdim)
+C     
+CCC   Description:
+CCC   Copy of the nD New_Var variable from the nD Old_Var variable.
+C
+CC    Method:
+CC            
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: nbdim
+      TYPE(Agrif_Pvariable) :: New_Var, Old_Var     
+      INTEGER,DIMENSION(nbdim) :: pttabnew 
+      INTEGER,DIMENSION(nbdim) :: petabnew
+      INTEGER,DIMENSION(nbdim) :: pttabold
+      INTEGER,DIMENSION(nbdim) :: petabold      
+      REAL, DIMENSION(nbdim) :: snew,sold
+      REAL, DIMENSION(nbdim) :: dsnew,dsold 
+C
+      INTEGER :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+C
+      REAL, DIMENSION(nbdim) :: dim_gmin,dim_gmax
+      REAL, DIMENSION(nbdim) :: dim_newmin,dim_newmax
+      REAL, DIMENSION(nbdim) :: dim_min
+      INTEGER, DIMENSION(nbdim) :: ind_gmin,ind_newmin
+      INTEGER, DIMENSION(nbdim) ::  ind_newmax
+C               
+C
+      do i = 1,nbdim
+C      
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+C 
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+C
+      enddo         
+C
+      do i = 1,nbdim
+C  
+        if (dim_gmax(i) .LT. dim_newmin(i)) Return
+C      
+        if (dim_gmin(i) .GT. dim_newmax(i)) Return
+C
+      enddo
+C
+C
+      do i = 1,nbdim
+C 
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),
+     &                      dim_newmin(i))-dim_newmin(i))/dsnew(i)) 
+C      
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+C      
+        ind_gmin(i) = pttabold(i) + nint((dim_min(i)-
+     &                dim_gmin(i))/dsold(i))      
+C
+        ind_newmax(i) = pttabnew(i) 
+     &                  + int((min(dim_gmax(i),dim_newmax(i))
+     &                         -dim_newmin(i))/dsnew(i))
+C
+      enddo 
+C
+C
+C
+      SELECT CASE (nbdim)
+      CASE (1)
+         i0 = ind_gmin(1)
+         do i = ind_newmin(1),ind_newmax(1)
+            New_Var % var % array1(i) =
+     &      Old_Var % var % array1(i0)
+            New_Var % var % restore1D(i) = 1   
+         i0 = i0 + int(dsnew(1)/dsold(1))
+         enddo
+      CASE (2)
+
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+           New_Var % var % array2(i,j) =
+     &            Old_Var % var % array2(i0,j0)
+           New_Var % var % restore2D(i,j) = 1
+               j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (3)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+           New_Var % var % array3(i,j,k) =
+     &                  Old_Var % var % array3(i0,j0,k0)
+           New_Var % var % restore3D(i,j,k) = 1   
+                     k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (4)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+           New_Var % var % array4(i,j,k,l) =
+     &                        Old_Var % var % array4(i0,j0,k0,l0)
+           New_Var % var % restore4D(i,j,k,l) = 1   
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (5)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+           New_Var % var % array5(i,j,k,l,m) =
+     &                        Old_Var % var % array5(i0,j0,k0,l0,m0)
+           New_Var % var % restore5D(i,j,k,l,m) = 1
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      CASE (6)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2)
+        do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3)
+        do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4)
+        do l = ind_newmin(4),ind_newmax(4) 
+        m0 = ind_gmin(5)
+        do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6)
+        do n = ind_newmin(6),ind_newmax(6)
+           New_Var % var % array6(i,j,k,l,m,n) =
+     &                        Old_Var % var % array6(i0,j0,k0,l0,m0,n0)
+           New_Var % var % restore6D(i,j,k,l,m,n) = 1
+        n0 = n0 + int(dsnew(6)/dsold(6)) 
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5)) 
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+      END SELECT
+C           
+      Return
+C
+C
+      End Subroutine Agrif_CopynD                    
+C
+C
+C
+      End module Agrif_Save
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F	(revision 3437)
@@ -0,0 +1,460 @@
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_types  
+C
+      Module Agrif_types 
+C
+CCC   Description:
+CCC   Definition of data types used in Agrif, of several variables and
+C        PARAMETERs.     
+C
+      IMPLICIT NONE
+      
+C     Maximum refinement ratio
+
+      INTEGER, PARAMETER :: Agrif_MaxRaff = 7
+      
+C     Maximum number of grids of the hierarchy
+      INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10
+C     MPI Communicator
+      INTEGER :: MPI_COMM_AGRIF
+C
+C     **************************************************************************
+CCC   TYPE Agrif_LRECTANGLE
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE allowing a grid to reach a grid on the same level or its child
+CCC   grids.
+C
+      TYPE Agrif_lrectangle  
+           TYPE(Agrif_rectangle) , Pointer :: r    ! to reach a child grid
+           TYPE(Agrif_lrectangle), Pointer :: next ! to reach a grid on the 
+                                                   !    same level
+      End TYPE Agrif_lrectangle  
+C
+C     **************************************************************************
+CCC   TYPE Agrif_RECTANGLE: 
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define several CHARACTERistics of a grid (number,position,
+CCC   time and space refinement factors,...). 
+C
+      TYPE Agrif_rectangle
+           INTEGER                         :: number      ! Number of the grid
+           ! Number of child grids 
+           INTEGER                         :: nbgridchild 
+           ! Minimal position in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: imin        
+           ! Maximal position in the x,y and z direction 
+           INTEGER, DIMENSION(3)           :: imax 
+           ! Space refinement factor in the x,y and z direction  
+           INTEGER, DIMENSION(3)           :: spaceref    
+           ! Time refinement factor in the x,y and z direction
+           INTEGER, DIMENSION(3)           :: timeref     
+           ! Pointer to reach a grid on  the same level or a child grid
+           TYPE(Agrif_lrectangle), Pointer :: childgrids  
+      End TYPE Agrif_rectangle  
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PGrid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to go over the grid hierarchy (used for the creation of this 
+CCC   grid hierarchy and during the time integration).
+C 
+      TYPE Agrif_pgrid  
+           ! allows to reach a child grid  
+           TYPE(Agrif_grid) , Pointer :: gr
+           ! allows to reach the grids of the same level 
+           TYPE(Agrif_pgrid), Pointer :: next 
+      End TYPE Agrif_pgrid 
+C
+C
+C
+C     **************************************************************************
+CCC   TYPE Agrif_PVariable
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid variable.
+C
+      TYPE Agrif_PVariable 
+           ! This field allows to get the various CHARACTERistics 
+           !   of the variable (defined by the Agrif_Variable data TYPE)
+           TYPE(Agrif_Variable) , Pointer :: var  
+           ! Pointer on the parent grid
+           TYPE(Agrif_PVariable), Pointer :: parent_var 
+      End TYPE Agrif_PVariable 
+C
+C     **************************************************************************
+CCC   TYPE Agrif_Grid
+C     **************************************************************************
+C
+CCC   Description:
+CCC   Data TYPE to define a grid (position, space and time refinement factors).
+C
+      TYPE Agrif_grid  
+           ! pointer on the parent grid 
+           TYPE(Agrif_grid)                    ,Pointer :: parent      
+           ! pointer on the child grids 
+           TYPE(Agrif_pgrid)                   ,Pointer :: child_grids 
+           ! List of the grid variables   
+           TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars     
+           ! pointer on the save grid 
+           TYPE(Agrif_grid)                    ,Pointer :: save_grid                
+C
+           ! Global x,y and z position
+           REAL    ,DIMENSION(3)                   :: Agrif_x   
+           ! Global space step in the x,y and z direction
+           REAL    ,DIMENSION(3)                   :: Agrif_d
+           ! number of cells in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: nb        
+           ! minimal position in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: ix        
+           ! Space refinement factor in the x,y and z direction
+           INTEGER ,DIMENSION(3)                   :: spaceref  
+           ! Time refinement factor in the x,y and z direction 
+           INTEGER ,DIMENSION(3)                   :: timeref   
+           INTEGER ,DIMENSION(:)          ,Pointer :: restore1D   
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: restore2D   
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: restore3D 
+           INTEGER ,DIMENSION(:,:,:,:)    ,Pointer :: restore4D
+           INTEGER ,DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D
+           INTEGER ,DIMENSION(:,:,:,:,:,:),Pointer :: restore6D
+           ! number of time step  
+           INTEGER                                 :: ngridstep 
+           INTEGER                                 :: rank  
+           !moving grid id
+           INTEGER                                 :: grid_id
+           ! number of the grid 
+           INTEGER                                 :: fixedrank 
+           ! fixed or moving grid ?  
+           LOGICAL                                 :: fixed     
+           LOGICAL                                 :: oldgrid   
+C          LOGICALs indicating if the current grid has a common border 
+C             with the root coarse grid
+           LOGICAL ,DIMENSION(3)                   :: NearRootBorder
+           LOGICAL ,DIMENSION(3)                   :: DistantRootBorder
+C          Arrays for adaptive grid refinement
+           REAL    ,DIMENSION(:)          ,Pointer :: valtabpoint1D
+           REAL    ,DIMENSION(:,:)        ,Pointer :: valtabpoint2D
+           REAL    ,DIMENSION(:,:,:)      ,Pointer :: valtabpoint3D
+           INTEGER ,DIMENSION(:)          ,Pointer :: tabpoint1D
+           INTEGER ,DIMENSION(:,:)        ,Pointer :: tabpoint2D
+           INTEGER ,DIMENSION(:,:,:)      ,Pointer :: tabpoint3D
+           Type(Agrif_List_Variables), Pointer     :: variables=>NULL()
+           INTEGER                                 :: NbVariables = 0
+           Type(Agrif_Flux), Pointer               :: fluxes => NULL()
+           INTEGER                                 :: level
+           ! level of the grid in the hierarchy
+      End TYPE Agrif_grid
+C
+C     **************************************************************************
+CCC   TYPE Agrif_VARIABLE
+C     **************************************************************************
+C     
+CCC   Description:
+CCC   Data TYPE to CHARACTERize a grid variable.   
+C
+      TYPE Agrif_Variable 
+         CHARACTER*80 :: variablename
+C       
+         ! Pointer on the variable of the root grid 
+         TYPE(Agrif_Variable), Pointer :: root_var 
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+C        Arrays containing the values of the grid variables (REAL)
+         REAL                                    :: array0 
+         REAL   , DIMENSION(:)          ,ALLOCATABLE :: array1    
+         REAL   , DIMENSION(:,:)        ,ALLOCATABLE :: array2    
+         REAL   , DIMENSION(:,:,:)      ,ALLOCATABLE :: array3    
+         REAL   , DIMENSION(:,:,:,:)    ,ALLOCATABLE :: array4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: array5    
+         REAL   , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6  
+         
+         REAL   , DIMENSION(:)          ,POINTER :: parray1    
+         REAL   , DIMENSION(:,:)        ,POINTER :: parray2    
+         REAL   , DIMENSION(:,:,:)      ,POINTER :: parray3    
+         REAL   , DIMENSION(:,:,:,:)    ,POINTER :: parray4    
+         REAL   , DIMENSION(:,:,:,:,:)  ,POINTER :: parray5    
+         REAL   , DIMENSION(:,:,:,:,:,:),POINTER :: parray6
+         
+C        Arrays containing the values of the grid variables (REAL*8)
+         REAL*8                                 :: darray0
+         REAL*8, DIMENSION(:)          ,ALLOCATABLE :: darray1   
+         REAL*8, DIMENSION(:,:)        ,ALLOCATABLE :: darray2   
+         REAL*8, DIMENSION(:,:,:)      ,ALLOCATABLE :: darray3   
+         REAL*8, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: darray4   
+         REAL*8, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: darray5   
+         REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6   
+C        Arrays containing the values of the grid variables (REAL*4)
+         REAL*4                                 :: sarray0
+         REAL*4, DIMENSION(:)          ,ALLOCATABLE :: sarray1   
+         REAL*4, DIMENSION(:,:)        ,ALLOCATABLE :: sarray2   
+         REAL*4, DIMENSION(:,:,:)      ,ALLOCATABLE :: sarray3   
+         REAL*4, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: sarray4   
+         REAL*4, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: sarray5   
+         REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6   
+C        Arrays containing the values of the grid variables (LOGICAL)
+         LOGICAL                                 :: larray0
+         LOGICAL, DIMENSION(:)          ,ALLOCATABLE :: larray1   
+         LOGICAL, DIMENSION(:,:)        ,ALLOCATABLE :: larray2   
+         LOGICAL, DIMENSION(:,:,:)      ,ALLOCATABLE :: larray3   
+         LOGICAL, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: larray4   
+         LOGICAL, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: larray5   
+         LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6   
+C         Arrays containing the values of the grid variables (INTEGER)   
+         INTEGER                                 :: iarray0
+         INTEGER, DIMENSION(:)          ,ALLOCATABLE :: iarray1   
+         INTEGER, DIMENSION(:,:)        ,ALLOCATABLE :: iarray2   
+         INTEGER, DIMENSION(:,:,:)      ,ALLOCATABLE :: iarray3   
+         INTEGER, DIMENSION(:,:,:,:)    ,ALLOCATABLE :: iarray4   
+         INTEGER, DIMENSION(:,:,:,:,:)  ,ALLOCATABLE :: iarray5   
+         INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6   
+C
+         INTEGER, DIMENSION(:)          ,Pointer :: restore1D => NULL()
+         INTEGER, DIMENSION(:,:)        ,Pointer :: restore2D => NULL()
+         INTEGER, DIMENSION(:,:,:)      ,Pointer :: restore3D => NULL()
+         INTEGER, DIMENSION(:,:,:,:)    ,Pointer :: restore4D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:)  ,Pointer :: restore5D => NULL()
+         INTEGER, DIMENSION(:,:,:,:,:,:),Pointer :: restore6D => NULL()
+C   
+         CHARACTER(2050)                          :: carray0
+         CHARACTER(200), DIMENSION(:)    ,ALLOCATABLE :: carray1
+         CHARACTER(200), DIMENSION(:,:)  ,ALLOCATABLE :: carray2
+C
+         ! Array used for the time interpolation
+         REAL   , DIMENSION(:,:)      ,Pointer :: oldvalues2D => NULL()
+
+         ! if the variable should be restore -> =1
+         LOGICAL :: restaure = .FALSE.
+         ! the interpolation should be made in any case
+         LOGICAL :: Interpolationshouldbemade = .FALSE. 
+         INTEGER :: bcinf ! option bc
+         INTEGER :: bcsup ! option bc
+         INTEGER, DIMENSION(6) :: updateinf ! option update
+         INTEGER, DIMENSION(6) :: updatesup ! option update         
+         INTEGER, DIMENSION(6,6) :: bcTYPEinterp ! option bcinterp
+         INTEGER, DIMENSION(6) :: TYPEinterp ! option interp
+         INTEGER, DIMENSION(6) :: TYPEupdate ! option update
+         
+         INTEGER, DIMENSION(6) :: lb, ub
+         
+         Type(Agrif_List_Interp_Loc), Pointer :: list_interp => NULL()
+         Type(Agrif_List_Interp_Loc), Pointer :: list_update => NULL()
+C
+      End TYPE Agrif_Variable 
+      
+      Type Agrif_Interp_Loc
+      integer,dimension(6) :: pttab,petab,
+     &                          pttab_Child,pttab_Parent = -99
+      integer,dimension(6) :: indmin, indmax
+      INTEGER,DIMENSION(6)    :: pttruetab,cetruetab
+      logical :: member, memberin      
+#if !defined key_mpp_mpi      
+      integer,dimension(6) :: indminglob,indmaxglob
+#else
+      integer,dimension(6) :: indminglob2,indmaxglob2
+      INTEGER,DIMENSION(6,2,2) :: parentarray
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab4t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall
+      INTEGER,DIMENSION(:,:,:), POINTER :: tab5t
+      LOGICAL, DIMENSION(:), POINTER :: memberinall2
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc1    
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc1      
+      LOGICAL, DIMENSION(:), POINTER :: sendtoproc2      
+      LOGICAL, DIMENSION(:), POINTER :: recvfromproc2      
+#endif      
+      End Type Agrif_Interp_Loc
+      
+      Type Agrif_List_Interp_Loc
+      Type(Agrif_Interp_Loc), Pointer :: interp_loc
+      Type(Agrif_List_Interp_Loc), Pointer :: suiv
+      End Type Agrif_List_Interp_Loc
+
+       TYPE Agrif_List_Variables
+         Type(Agrif_PVariable), Pointer :: pvar
+         Type(Agrif_List_Variables), Pointer :: nextvariable  => NULL()
+       END TYPE Agrif_List_Variables
+               
+       TYPE Agrif_Profile
+          character*80 :: profilename
+C
+         ! index of the first point in the REAL domain (x,y and z direction)
+         INTEGER     ,DIMENSION(6)          :: point
+         ! position of the variable on the cell (1 for the boarder of 
+         !    the edge, 2 for the center)
+         INTEGER     ,DIMENSION(:) ,Pointer :: posvar      => NULL() 
+         ! Indication for the space interpolation (module Agrif_Boundary)
+         INTEGER                   ,Pointer :: interpIndex => NULL() 
+         ! number of DIMENSIONs of the grid variable
+         INTEGER                            :: nbdim = 0             
+         ! Array indicating the TYPE of DIMENSION (space or not) for 
+         !    each of them 
+         CHARACTER(6),DIMENSION(:) ,Pointer :: interptab   => NULL() 
+         Type(Agrif_Variable), Pointer :: var
+         Type(Agrif_Profile), Pointer :: nextprofile  => NULL()
+       END TYPE Agrif_Profile
+       
+       Type(Agrif_Profile), Pointer :: Agrif_MyProfiles => NULL()
+           
+C  Boundaries Fluxes
+
+      Type Agrif_Flux
+        Character*80 fluxname
+        Type(Agrif_Variable), Pointer :: fluxtabx
+        Type(Agrif_Variable), Pointer :: fluxtaby
+        Type(Agrif_Variable), Pointer :: fluxtabz        
+        Type(Agrif_Profile), Pointer  :: profile
+        Logical :: Fluxallocated = .FALSE.
+        Type(Agrif_Flux), Pointer     :: nextflux => NULL()
+      End Type Agrif_Flux      
+C
+C     **************************************************************************
+CCC   Different PARAMETERs
+C     **************************************************************************
+      TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: Agrif_tabvars
+C
+      ! this pointer always points on the root grid of the grid hierarchy
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Mygrid      
+      ! Pointer used in the Agrif_regrid subroutine (Agrif_Util module). 
+      !    It contains  the safeguard of the grid hierarchy.
+      TYPE(Agrif_pgrid) ,Pointer :: Agrif_oldmygrid   
+      ! pointer to the current grid (the link is done by using the
+      !    Agrif_Instance   procedure (module Agrif_Init)) 
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_Curgrid
+      ! Pointer used in the Agrif_ChildGrid_to_ParentGrid and 
+      !    Agrif_ParentGrid_to_ChildGrid subroutines 
+      !    (Agrif_CurgridFunctions module). It contains the 
+      !    safeguard of the current grid hierarchy.
+      TYPE(Agrif_grid)  ,Pointer :: Agrif_saveCURGRID
+C
+      ! Problem DIMENSION
+      INTEGER               :: Agrif_Probdim
+      ! number of variables
+      INTEGER               :: Agrif_NbVariables
+      ! number of fixed grids in the grid hierarchy
+      INTEGER               :: Agrif_nbfixedgrids            
+      ! space refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffref
+      ! time refinement factor
+      INTEGER ,DIMENSION(3) :: Agrif_coeffreft
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValue
+      ! LOGICAL to use special values on the parent grid
+      LOGICAL               :: Agrif_UseSpecialValueInUpdate
+      ! LOGICAL to use special values on the current grid
+      LOGICAL               :: Agrif_UseSpecialValueFineGrid
+      ! Special values on the parent grid
+      REAL                  :: Agrif_SpecialValue
+      ! Special values on the current grid
+      REAL                  :: Agrif_SpecialValueFineGrid
+C   clustering PARAMETERs
+      INTEGER               :: Agrif_Regridding = 10
+      INTEGER               :: Agrif_Minwidth
+      REAL                  :: Agrif_Efficiency = 0.7
+      INTEGER               :: MaxSearch = 5
+      REAL    ,DIMENSION(3) :: Agrif_mind
+C     PARAMETERs for the interpolation of the child grids
+      ! linear interpolation
+      INTEGER ,PARAMETER    :: Agrif_linear=1
+      ! lagrange interpolation
+      INTEGER ,PARAMETER    :: Agrif_lagrange=2
+      ! spline interpolation
+      INTEGER ,PARAMETER    :: Agrif_eno=3
+      ! user s interpolation
+      INTEGER ,PARAMETER    :: Agrif_user_interp=4
+      ! constant interpolation
+      INTEGER ,PARAMETER    :: Agrif_constant=5
+      ! linear conservative interpolation 
+      INTEGER ,PARAMETER    :: Agrif_linearconserv=6
+      ! linear conservative interpolation       
+      INTEGER ,PARAMETER    :: Agrif_linearconservlim=7
+      INTEGER ,PARAMETER    :: Agrif_ppm=8 
+      INTEGER ,PARAMETER    :: Agrif_weno=9         
+C     PARAMETERs for the update of the parent grids      
+      INTEGER ,PARAMETER    :: Agrif_Update_Copy=1           ! copy
+      INTEGER ,PARAMETER    :: Agrif_Update_Average=2        ! average
+      INTEGER ,PARAMETER    :: Agrif_Update_Full_Weighting=3 ! full-weighting 
+C     Raffinement grid switch definition
+      ! Agrif_USE_ONLY_FIXED_GRIDS =1 if fixed grid mode
+      INTEGER               :: Agrif_USE_ONLY_FIXED_GRIDS    
+      ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid 
+      !    else only AMR mode
+      INTEGER               :: Agrif_USE_FIXED_GRIDS
+      INTEGER               :: Agrif_Maxlevelloc
+C
+#ifdef key_mpp_mpi
+      INTEGER :: Agrif_Nbprocs  ! Number of processors
+      INTEGER :: Agrif_ProcRank ! Rank of the current processor 
+      INTEGER :: Agrif_Group    ! Group associated to MPI_COMM_AGRIF
+      INTEGER :: Agrif_MPIPREC
+#endif
+C
+      contains
+C   
+      Integer Function agrif_ceiling(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x)
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_ceiling = i
+          else
+             agrif_ceiling = i+1
+          endif      
+C
+      End Function
+C
+      Integer Function agrif_int(x)
+C             
+          Real :: x
+          Integer ::i 
+C
+          i = floor(x) + 1
+C      
+          if( abs(x - i).le.0.0001 )then
+             agrif_int = i
+          else
+             agrif_int = i-1
+          endif      
+C
+      End Function
+      End Module Agrif_TYPEs  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F	(revision 3437)
@@ -0,0 +1,2677 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Update
+C
+      Module Agrif_Update
+C
+CCC   Description:
+CCC   Module to update a parent grid from its child grids
+C
+C     Modules used:
+C   
+      Use Agrif_Updatebasic
+c      Use Agrif_Boundary
+      Use Agrif_Arrays
+      Use Agrif_CurgridFunctions
+      Use Agrif_Mask
+#ifdef key_mpp_mpi
+      Use Agrif_mpp
+#endif
+C
+      IMPLICIT NONE
+      logical, private :: precomputedone(7) = .FALSE.      
+C      
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      External :: procname
+      Optional ::  procname      
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1)
+     &         ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 1  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array1 => tab
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update
+             
+C
+     
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF     
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_1D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_2d
+C     **************************************************************************
+C 
+
+      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations  
+                                              ! are done on the fine grid 
+                                              
+      External :: procname
+      Optional ::  procname
+                                                          
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2)
+     &    ), Target :: tab    ! Result
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 2  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array2 => tab 
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub             
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_2D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_3d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid    
+      External :: procname
+      Optional ::  procname
+                                                       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3)
+     &      ), Target :: tab  ! Results  
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 3  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array3 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+C      
+C      child % var % list_update => childtemp%var%list_update
+      
+      DEALLOCATE(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_3D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_4d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname        
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4)
+     &      ), Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 4  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array4 => tab     
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+      
+C      childtemp % var % list_update => child%var%list_update
+            
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+
+C      child % var % list_update => childtemp%var%list_update      
+C
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_4D
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_5d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
+     &                           procname)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid     
+      External :: procname
+      Optional ::  procname
+              
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 5  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array5 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub        
+      
+C      childtemp % var % list_update => child%var%list_update      
+C
+      IF (present(procname)) THEN
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin,procname)
+      ELSE
+      CALL Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+      ENDIF
+      
+C      child % var % list_update => childtemp%var%list_update
+            
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_5D
+C
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_6d
+C     **************************************************************************
+C 
+      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid.
+C
+C     Declarations:
+C
+      
+C
+C     Arguments      
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
+      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                              ! are done on the fine grid       
+      REAL, DIMENSION(
+     &         child%var%lb(1):child%var%ub(1),
+     &         child%var%lb(2):child%var%ub(2),
+     &         child%var%lb(3):child%var%ub(3),
+     &         child%var%lb(4):child%var%ub(4),
+     &         child%var%lb(5):child%var%ub(5),
+     &         child%var%lb(6):child%var%ub(6)
+     &      ),  Target :: tab  ! Results
+C
+C
+C     Definition of a temporary AGRIF_PVariable data TYPE  
+      allocate(childtemp % var)
+C
+C     Pointer on the root variable
+      childtemp % var % root_var => child % var %root_var
+C      
+C     Number of dimensions of the grid variable
+      childtemp % var % nbdim = 6  
+C      
+C     Values on the current grid used for the update
+C      childtemp % var % array6 => tab      
+      
+      childtemp % var % lb = child % var % lb
+      childtemp % var % ub = child % var % ub  
+            
+C      childtemp % var % list_update => child%var%list_update
+C
+      Call Agrif_UpdateVariable
+     &     (TypeUpdate,parent,child,deb,fin)
+     
+C      child % var % list_update => childtemp%var%list_update
+           
+C      
+      deallocate(childtemp % var)
+C
+C       
+      End Subroutine Agrif_Update_6D
+C
+C
+C
+C     **************************************************************************  
+C     Subroutine Agrif_UpdateVariable    
+C     **************************************************************************  
+C   
+      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
+     &                   procname)   
+C
+CCC   Description:
+CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
+C         dimensions of the grid variable.
+C
+CC    Declarations:
+C      
+c      
+C      
+C     Scalar argument
+      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
+C     Data TYPE arguments
+      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
+      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid 
+      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
+                                        !    are calculated     
+      External :: procname
+      Optional ::  procname
+      
+C
+C     Local scalars      
+      INTEGER :: nbdim                  ! Number of dimensions of the current
+                                        !    grid
+      INTEGER ,DIMENSION(6) :: pttab_child  
+      INTEGER ,DIMENSION(6) :: petab_child      
+      INTEGER ,DIMENSION(6) :: pttab_parent  
+      REAL    ,DIMENSION(6) :: s_child,s_parent
+      REAL    ,DIMENSION(6) :: ds_child,ds_parent
+      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
+                                        !    grid has a common border with 
+                                        !    the root grid            
+      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
+      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
+                                        !    variable on the cell
+      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells    
+      INTEGER :: n              
+      LOGICAL :: wholeupdate
+C
+C 
+
+      loctab_child(:) = 0
+C
+      root => child % var % root_var 
+      nbdim = root % nbdim
+C
+      do n = 1,nbdim
+        posvartab_child(n) = root % posvar(n)
+      enddo
+C      
+      
+      Call PreProcessToInterpOrUpdate(parent,child,
+     &             petab_Child(1:nbdim),
+     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &             s_Child(1:nbdim),s_Parent(1:nbdim),
+     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &             nbdim)
+C
+C
+      do n = 1,nbdim
+C
+        Select case(root % interptab(n))
+C
+          case('x') ! x DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(1)
+C
+          case('y') ! y DIMENSION      
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(2)
+C
+          case('z') ! z DIMENSION
+C
+            nbtab_Child(n) = Agrif_Curgrid % nb(3)
+C
+          case('N') ! No space DIMENSION      
+C
+            
+            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
+C
+C           No interpolation but only a copy of the values of the grid variable      
+C      
+            posvartab_child(n) = 1
+            
+            loctab_child(n) = -3
+C
+        End select
+C
+      enddo
+      
+C     Call to a procedure of update according to the number of dimensions of
+C     the grid variable
+
+      wholeupdate = .FALSE.
+      
+      do n=1,nbdim
+      if (loctab_child(n) /= -3) then
+        if (deb(n)>fin(n)) wholeupdate = .TRUE.
+        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
+      endif
+      enddo
+
+       IF (present(procname)) THEN
+
+          IF (wholeupdate) THEN
+
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname)  
+         ENDIF
+       ELSE
+         IF (wholeupdate) THEN
+          Call AGRIF_UpdateWhole
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ELSE
+          Call AGRIF_UpdateBcnD
+     &         (TypeUpdate,parent,child,deb,fin,
+     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
+     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
+     &          loctab_Child(1:nbdim),
+     &          s_Child(1:nbdim),s_Parent(1:nbdim),
+     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
+         ENDIF
+       ENDIF
+C
+      Return
+C
+C
+      End subroutine Agrif_UpdateVariable
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateWhole
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+      INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
+                                                     !    average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !    grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !    grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !    the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the parent grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !    inside the domain for
+                                                     !    the child grid
+                                                     !    variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !    child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !    variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !    grid has a common
+                                                     !    border with the root
+                                                     !    grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !    and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !    and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables     
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !    limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !   boundary conditions are
+      integer :: coeffraf
+      INTEGER :: debloc, finloc
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+C indtab contains the limits for the fine grid points that will be used
+C in the update scheme
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        debloc = 0
+        finloc = nbtab_Child(i)/coeffraf - 1
+
+        IF (posvartab_child(i) == 1) THEN
+           finloc = finloc - 1
+        ENDIF
+
+        IF (deb(i) > fin(i)) THEN
+          debloc = deb(i)
+          finloc = finloc - deb(i)
+        ENDIF
+
+        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+C at this point, indices are OK for an average          
+          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+          ENDIF
+        ENDIF
+        IF (loctab_child(i) == -3) THEN
+           indtab(i,1,1) = pttab_child(i)
+C
+               if (posvartab_child(i) == 1) then
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
+C
+               else
+C
+               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
+               ENDIF
+        ENDIF
+      ENDDO
+
+C lubglob contains the global lbound and ubound of the child array
+C lubglob(:,1) : global lbound for each dimension
+C lubglob(:,2) : global lbound for each dimension
+
+#if !defined key_mpp_mpi
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)
+
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,2))
+
+C
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim,procname)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_child,loctab_Child,
+     &              nbdim)           
+           ENDIF        
+C
+C      
+C  
+      End Subroutine Agrif_UpdateWhole
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_UpdateBcnd
+C     **************************************************************************               
+C
+      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
+     &                           pttab_child,pttab_Parent,
+     &                           nbtab_Child,posvartab_Child,
+     &                           loctab_Child,
+     &                           s_Child,s_Parent,
+     &                           ds_Child,ds_Parent,nbdim,procname)
+C
+CCC   Description:
+CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
+CCC   a fine grid by using a space and time interpolations; it is called by the 
+CCC   Agrif_CorrectVariable procedure.
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update 
+                                                     !   (copy or average) 
+      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
+                                                     !   grid
+      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
+                                                     !   grid 
+      INTEGER, DIMENSION(6) :: deb, fin
+      INTEGER                  :: nbdim              ! Number of dimensions of
+                                                     !   the grid variable
+      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the parent grid
+                                                     !   variable
+      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
+                                                     !   inside the domain for
+                                                     !   the child grid variable
+      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
+                                                     !   child grid
+      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
+                                                     !   variable (1 or 2)
+      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
+                                                     !   grid has a common
+                                                     !   border with the root
+                                                     !   grid
+      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
+                                                     !   and child grids 
+      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
+                                                     !   and child grids
+      External :: procname
+      Optional ::  procname      
+C
+C     Local variables
+      INTEGER,DIMENSION(nbdim,2)   :: lubglob
+      INTEGER                      :: i                 
+      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
+                                                     !   limits of the child
+      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
+                                                     !  boundary conditions are 
+      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
+      INTEGER                      :: nb,ndir,n
+      integer :: coeffraf
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)   :: lb,ub
+      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
+      INTEGER                    :: code
+C
+#endif
+C      
+C
+
+      DO i = 1, nbdim
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
+        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
+
+        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
+     &    - (fin(i) + 1) *  coeffraf
+        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
+     &    - (deb(i) + 1) *  coeffraf
+
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)        
+          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
+            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+          ENDIF
+        ELSE
+          indtab(i,1,1) = indtab(i,1,1) - coeffraf
+          indtab(i,1,2) = indtab(i,1,2) - 1
+          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+          ENDIF          
+        ENDIF
+      ENDDO
+
+#if !defined key_mpp_mpi      
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
+     &               lubglob(:,2),nbdim)
+
+C
+#else
+C     
+        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
+      DO i = 1,nbdim
+C
+        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
+        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
+C
+      ENDDO
+C
+      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+      
+      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
+     &                     MPI_COMM_AGRIF,code)  
+     
+      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)      
+C
+#endif 
+C     
+      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
+     &     lubglob(1:nbdim,1))
+      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
+     &     lubglob(1:nbdim,2))
+      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
+     &     lubglob(1:nbdim,2))
+                        
+C 
+C
+      do nb = 1,nbdim
+C
+        do ndir = 1,2
+C
+          if (loctab_child(nb) /= -3) then
+C           
+              do n = 1,2
+C
+                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+C
+              enddo              
+C
+              do i = 1,nbdim
+C     
+                if (i .NE. nb) then      
+C
+                    if (loctab_child(i) == -3) then
+C
+                        ptres(i,1,ndir,nb) = pttab_child(i)
+C
+                      else
+C
+                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+C
+                    endif
+C
+                    if (loctab_child(i) == -3) then
+C
+                        if (posvartab_child(i) == 1) then
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                                + nbtab_child(i)
+C
+                          else
+C
+                            ptres(i,2,ndir,nb) = pttab_child(i) 
+     &                             + nbtab_child(i) - 1
+C
+                        endif                             
+C
+                      else
+C
+                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+C
+                    endif                        
+C      
+                endif
+C      
+              enddo
+      
+C
+            
+        endif
+      
+        enddo
+       enddo
+C
+
+C
+
+      do nb = 1,nbdim
+C
+        do ndir = 1,2                
+C
+          if (loctab_child(nb) /= -3) then
+C
+           IF (present(procname)) THEN
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim,procname,nb,ndir)
+           ELSE
+              Call Agrif_UpdatenD              
+     &             (TypeUpdate,parent,child,
+     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
+     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
+     &              s_Child(1:nbdim),s_Parent(1:nbdim),
+     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
+     &              posvartab_Child,loctab_Child,
+     &              nbdim)           
+           ENDIF
+C
+          endif
+          
+C
+        enddo       
+C
+      enddo
+C
+C      
+C  
+      End Subroutine Agrif_UpdateBcnd
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdatenD  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
+     &                          pttab,petab,
+     &                          pttab_Child,pttab_Parent,
+     &                          s_Child,s_Parent,
+     &                          ds_Child,ds_Parent,
+     &                          posvartab_Child,loctab_Child,
+     &                          nbdim,procname,nb,ndir)  
+C
+C     Description:
+C     Subroutine to update a 2D grid variable on the parent grid of 
+C        the current grid. 
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+C
+       INCLUDE 'mpif.h'
+C
+#endif
+C
+C     Arguments
+      INTEGER                    :: nbdim
+      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update 
+                                                       !  (copy or average)
+      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
+                                                       !   grid   
+      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
+                                                       !   grid
+      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
+                                                       !   point inside the
+                                                       !   domain
+      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the child
+                                                       !   grid variable
+      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
+                                                       !   point inside the
+                                                       !   domain for the parent
+                                                       !   grid variable
+      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
+                                                       !   and child grids
+      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
+                                                       !   parent and child
+                                                       !   grids 
+      External :: procname
+      Optional ::  procname
+      Integer :: nb,ndir
+      Optional :: nb,ndir
+      
+C
+C     Local pointers
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
+C
+C     Local scalars
+      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
+      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
+      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
+      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
+cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
+      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
+      LOGICAL :: memberin, member
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      INTEGER,DIMENSION(nbdim,2,2) :: childarray
+      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
+      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
+      INTEGER :: nbin, ndirin
+C
+#ifdef key_mpp_mpi
+C
+      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+      INTEGER                              :: code
+      INTEGER                              :: i,j,k
+      INTEGER,DIMENSION(nbdim,4)           :: tab3
+      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL :: find_list_update
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL, DIMENSION(1) :: memberin1      
+C
+#endif
+C
+  
+C
+C     local lbound and ubound of the child array
+
+      Call Agrif_nbdim_Get_bound_dimension(child%var,
+     &                              lowerbound,upperbound,nbdim)
+
+C here pttab and petab corresponds to the (global) indices of the points needed
+C in the update
+C pttruetab and cetruetab contains only indices that are present
+C on the local processor
+
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       pttab,petab,
+     &                       pttruetab,cetruetab,memberin)
+
+       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttab,petab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &     )
+
+#ifdef key_mpp_mpi
+      IF (memberin) THEN
+       Call Agrif_GlobtoLocInd2(childarray,
+     &                     lowerbound,upperbound,
+     &                     pttruetab,cetruetab,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+
+      ENDIF
+
+
+         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                     s_Child_temp,s_Child,ds_Child,
+     &                     s_Parent,ds_Parent,
+     &                     pttruetab,cetruetab,pttab_Child,
+     &                     pttab_Parent,
+     &                     posvartab_Child,TypeUpdate,loctab_Child
+     &                 ,pttruetabwhole,cetruetabwhole
+     &     )
+
+#else
+       indmin = indminglob
+       indmax = indmaxglob
+       pttruetabwhole = pttruetab
+       cetruetabwhole = cetruetab
+       childarray(:,1,2) = pttruetab
+       childarray(:,2,2) = cetruetab
+#endif
+
+       IF (present(procname)) THEN
+       IF (.Not.present(nb)) THEN
+       nbin=0
+       ndirin=0
+       ELSE
+       nbin = nb
+       ndirin = ndir
+       ENDIF
+       ENDIF
+       
+      IF (memberin) THEN
+      IF (.not.associated(tempC%var)) allocate(tempC%var)
+
+C
+      Call Agrif_nbdim_allocation(tempC%var,
+     &                 pttruetab,cetruetab,nbdim)
+
+      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
+
+      IF (present(procname)) THEN
+        SELECT CASE (nbdim)
+        CASE(1)
+          CALL procname(tempC%var%array1,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(2)
+          CALL procname(tempC%var%array2,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(3)
+          CALL procname(tempC%var%array3,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(4)
+          CALL procname(tempC%var%array4,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(5)
+          CALL procname(tempC%var%array5,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        CASE(6)
+          CALL procname(tempC%var%array6,
+     &                          childarray(1,1,2),childarray(1,2,2),
+     &                          childarray(2,1,2),childarray(2,2,2),
+     &                          childarray(3,1,2),childarray(3,2,2),
+     &                          childarray(4,1,2),childarray(4,2,2),
+     &                          childarray(5,1,2),childarray(5,2,2),
+     &                          childarray(6,1,2),childarray(6,2,2),
+     &                                   .TRUE.,nbin,ndirin)
+        END SELECT
+      ELSE
+      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
+     &          child%var,childarray(:,1,2),childarray(:,2,2),
+     &                          nbdim)
+      ENDIF
+
+      ENDIF
+
+
+
+C
+C
+#ifdef key_mpp_mpi
+C
+C     tab2 contains the necessary limits of the parent grid for each processor
+
+      IF (Associated(child%var%list_update)) THEN
+      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+      ELSE
+      find_list_update = .FALSE.
+      ENDIF
+      
+      if (.not.find_list_update) then      
+      tab3(:,1) = pttruetab(:)
+      tab3(:,2) = cetruetab(:)
+      tab3(:,3) = pttruetabwhole(:)
+      tab3(:,4) = cetruetabwhole(:)
+C
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab4t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+      
+      memberin1(1) = memberin
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+       Call Get_External_Data_first(tab4t(:,:,1),
+     &            tab4t(:,:,2),
+     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
+     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+               
+      endif
+
+      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
+     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
+     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
+     &            tempCextend) 
+           
+!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
+!     &            tab4t(:,:,2),
+!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
+!     &            memberinall)
+
+#else
+      tempCextend%var => tempC%var
+#endif
+
+C
+C
+C     Update of the parent grid (tempP) from the child grid (tempC)
+
+
+      IF (memberin) THEN
+
+      IF (.not.associated(tempP%var)) allocate(tempP%var)
+      Call Agrif_nbdim_allocation(tempP%var,
+     &                 indmin,indmax,nbdim)
+
+      if ( nbdim .EQ. 1 ) then
+         tempP%var%array1 = 0.
+         Call Agrif_Update_1D_recursive(TypeUpdate,
+     &           tempP%var%array1,tempCextend%var%array1,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 2 ) then
+         Call Agrif_Update_2D_recursive(TypeUpdate,
+     &           tempP%var%array2,tempCextend%var%array2,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      if ( nbdim .EQ. 3 ) then
+         Call Agrif_Update_3D_recursive(TypeUpdate,
+     &           tempP%var%array3,tempCextend%var%array3,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 4 ) then
+         Call Agrif_Update_4D_recursive(TypeUpdate,
+     &           tempP%var%array4,tempCextend%var%array4,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 5 ) then
+         Call Agrif_Update_5D_recursive(TypeUpdate,
+     &           tempP%var%array5,tempCextend%var%array5,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+      if ( nbdim .EQ. 6 ) then
+         Call Agrif_Update_6D_recursive(TypeUpdate,
+     &           tempP%var%array6,tempCextend%var%array6,
+     &           indmin,indmax,
+     &           pttruetabwhole,cetruetabwhole,
+     &           s_Child_temp,s_Parent_temp,
+     &           ds_Child,ds_Parent,nbdim)
+      endif
+
+      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
+C      Deallocate(tempCextend%var)
+
+      ENDIF
+
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_Get_bound_dimension(parent%var,
+     &                              lowerbound,upperbound,nbdim)
+
+      Call Agrif_ChildGrid_to_ParentGrid()
+C
+      Call Agrif_Childbounds(nbdim,
+     &                       lowerbound,upperbound,
+     &                       indminglob,indmaxglob,
+     &                       indminglob2,indmaxglob2,member)
+C
+      IF (member) THEN
+      Call Agrif_GlobtoLocInd2(parentarray,
+     &                     lowerbound,upperbound,
+     &                     indminglob2,indmaxglob2,
+     &                     nbdim,Agrif_Procrank,
+     &                     member)
+      ENDIF
+
+      Call Agrif_ParentGrid_to_ChildGrid()
+
+      if (.not.find_list_update) then
+      tab3(:,1) = indmin(:)
+      tab3(:,2) = indmax(:)
+      tab3(:,3) = indminglob2(:)
+      tab3(:,4) = indmaxglob2(:)
+C
+      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
+     &                   MPI_INTEGER,MPI_COMM_AGRIF,code)
+
+      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
+      DO k=0,Agrif_Nbprocs-1
+       do j=1,4
+         do i=1,nbdim
+         tab5t(i,k,j) = tab4(i,j,k)
+         enddo
+       enddo
+      enddo
+ 
+      memberin1(1) = member
+      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
+     &                  1,MPI_LOGICAL,MPI_COMM_AGRIF,code)
+ 
+      Call Get_External_Data_first(tab5t(:,:,1),
+     &            tab5t(:,:,2),
+     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
+     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+          
+      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &   ,tab4t,tab5t,memberinall,memberinall2,
+     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
+          
+      endif
+      
+c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
+c     &            tab5t(:,:,2),
+c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
+c     &            memberinall2)
+     
+      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
+     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
+     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
+     &            tempPextend)     
+
+#else
+      tempPextend%var => tempP%var
+      parentarray(:,1,1) = indmin
+      parentarray(:,2,1) = indmax
+      parentarray(:,1,2) = indmin
+      parentarray(:,2,2) = indmax
+      member = .TRUE.
+#endif
+
+C
+C
+C
+C     Special values on the child grid
+      if (Agrif_UseSpecialValueFineGrid) then
+C
+ccc         noraftab(1:nbdim) =
+ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
+C
+#ifdef key_mpp_mpi
+C
+c          Allocate(childvalues% var)
+C
+c          Call Agrif_nbdim_allocation(childvalues%var,
+c     &                      pttruetab,cetruetab,nbdim)
+c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
+c     &                                tempC% var,
+c     &                                nbdim)
+c          Call Agrif_CheckMasknD(tempC,childvalues,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           noraftab(1:nbdim),nbdim)
+c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
+c         Deallocate(childvalues % var)
+C
+#else
+C
+c          Call Agrif_nbdim_Get_bound_dimension(child%var,
+c     &                              lowerbound,upperbound,nbdim)
+c          Call Agrif_CheckMasknD(tempC,child,
+c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+c     &                           lowerbound,
+c     &                           upperbound,
+c     &                           noraftab(1:nbdim),nbdim)
+C
+#endif
+C
+      endif
+
+
+C
+C
+C
+C
+C     Special values on the parent grid
+      if (Agrif_UseSpecialValue) then
+C
+#ifdef key_mpp_mpi
+C
+c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
+c     &                 parentarray,
+c     &                 indmin,indmax,
+c     &                 Agrif_SpecialValue,nbdim)
+C
+C
+#else
+C
+c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
+c     &                  indmin,indmax,
+c     &                  Agrif_SpecialValue,nbdim)
+C
+#endif
+C
+C
+      endif   
+C
+C
+        IF (member) THEN
+
+          IF (present(procname)) THEN
+            CALL Agrif_ChildGrid_to_ParentGrid()
+            SELECT CASE(nbdim)
+            CASE(1)
+            CALL procname(
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(2)
+            CALL procname(
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(3)
+            CALL procname(
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(4)
+            CALL procname(
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(5)
+            CALL procname(
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            CASE(6)
+            CALL procname(
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1)),
+     &                      parentarray(1,1,2),parentarray(1,2,2),
+     &                      parentarray(2,1,2),parentarray(2,2,2),
+     &                      parentarray(3,1,2),parentarray(3,2,2),
+     &                      parentarray(4,1,2),parentarray(4,2,2),
+     &                      parentarray(5,1,2),parentarray(5,2,2),
+     &                      parentarray(6,1,2),parentarray(6,2,2),
+     &                                   .FALSE.,nbin,ndirin
+     &                      )
+            END SELECT
+            CALL Agrif_ParentGrid_to_ChildGrid()
+          ELSE
+            SELECT CASE(nbdim)
+            CASE(1)
+            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
+     &      tempPextend%var%array1(
+     &                      parentarray(1,1,1):parentarray(1,2,1))
+            CASE(2)
+            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2)) =
+     &      tempPextend%var%array2(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1))
+            CASE(3)
+            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2)) =
+     &      tempPextend%var%array3(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1))
+            CASE(4)
+            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2)) =
+     &      tempPextend%var%array4(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1))
+            CASE(5)
+            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2)) =
+     &      tempPextend%var%array5(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1))
+            CASE(6)
+            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
+     &                      parentarray(2,1,2):parentarray(2,2,2),
+     &                      parentarray(3,1,2):parentarray(3,2,2),
+     &                      parentarray(4,1,2):parentarray(4,2,2),
+     &                      parentarray(5,1,2):parentarray(5,2,2),
+     &                      parentarray(6,1,2):parentarray(6,2,2)) =
+     &      tempPextend%var%array6(
+     &                      parentarray(1,1,1):parentarray(1,2,1),
+     &                      parentarray(2,1,1):parentarray(2,2,1),
+     &                      parentarray(3,1,1):parentarray(3,2,1),
+     &                      parentarray(4,1,1):parentarray(4,2,1),
+     &                      parentarray(5,1,1):parentarray(5,2,1),
+     &                      parentarray(6,1,1):parentarray(6,2,1))
+            END SELECT
+          ENDIF
+
+        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
+       ENDIF
+C
+C
+C     Deallocations
+
+      IF (memberin) THEN
+#ifdef key_mpp_mpi
+      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
+      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
+!      Deallocate(tempC % var)
+#endif
+!      Deallocate(tempP % var)
+      ENDIF
+#ifdef key_mpp_mpi
+!      Deallocate(tempPextend%var)
+!      IF (.Not.memberin) Deallocate(tempCextend%var)
+#endif
+
+C
+C
+      End Subroutine Agrif_UpdatenD
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Prtbounds
+C     **************************************************************************
+C
+      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
+     &                              s_Child_temp,s_Child,ds_Child,
+     &                              s_Parent,ds_Parent,
+     &                              pttruetab,cetruetab,pttab_Child,
+     &                              pttab_Parent,
+     &                              posvartab_child,TypeUpdate,
+     &                              loctab_Child
+#ifdef key_mpp_mpi
+     &                 ,pttruetabwhole,cetruetabwhole
+#endif
+     &                 )
+C
+CCC   Description:
+CCC   Subroutine calculating the bounds of the parent grid to be updated
+CCC   by the child grid     
+C
+C
+C     Declarations:
+C
+      
+C
+#ifdef key_mpp_mpi
+cccccccccccccccccccccccccc#include "mpif.h"
+#endif
+C
+C     Arguments
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim) :: indmin,indmax
+      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
+      REAL,DIMENSION(nbdim) :: s_Child,ds_child
+      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
+      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
+      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
+      INTEGER,DIMENSION(nbdim) :: loctab_Child
+      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
+C
+C     Local variables
+      INTEGER :: i
+      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax      
+#ifdef key_mpp_mpi
+      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
+      REAL :: positionmin,positionmax
+      INTEGER :: imin,imax
+      INTEGER :: coeffraf
+#endif
+C
+C
+      do i = 1,nbdim
+C
+        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
+     &                                pttab_Child(i)) * ds_Child(i)
+C
+        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
+     &                                pttab_Child(i)) * ds_Child(i)
+C     
+        indmin(i) = pttab_Parent(i) +
+     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+C
+        indmax(i) = pttab_Parent(i) +
+     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+C
+#ifdef key_mpp_mpi
+        positionmin = s_Parent(i) + (indmin(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+          positionmin = positionmin - ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
+        positionmin = positionmin - ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+          else
+            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
+     &                                -ds_Child(i)/2.
+          endif
+        ENDIF
+        ENDIF
+        ENDIF
+        imin = pttab_Child(i) +
+     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
+
+       positionmin = s_Child(i) + (imin -
+     &                             pttab_Child(i)) * ds_Child(i)
+
+        pttruetabwhole(i) = imin
+
+        positionmax = s_Parent(i) + (indmax(i)-
+     &                          pttab_Parent(i))*ds_Parent(i)
+        IF (loctab_Child(i) .NE. -3) THEN
+        IF (posvartab_child(i) == 1) THEN
+          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
+          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
+          ENDIF
+        ELSE
+          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN        
+        positionmax = positionmax  + ds_Parent(i)/2.
+          ELSE
+          coeffraf = nint(ds_Parent(i)/ds_Child(i))
+          if (mod(coeffraf,2) == 1) then
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
+          else
+            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 
+     &                                + ds_Child(i)/2.
+          endif
+
+        ENDIF        
+        ENDIF
+        ENDIF
+        imax = pttab_Child(i) +
+     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
+
+        positionmax = s_Child(i) + (imax -
+     &                                pttab_Child(i)) * ds_Child(i)
+
+        cetruetabwhole(i) = imax
+
+#endif
+C
+        s_Parent_temp(i) = s_Parent(i) + 
+     &                     (indmin(i) - pttab_Parent(i)) * 
+     &                      ds_Parent(i) 
+C     
+        s_Child_temp(i) = dim_newmin(i)
+
+#ifdef key_mpp_mpi
+        s_Child_temp(i) = positionmin
+#endif
+C
+      enddo
+C
+      Return
+C
+C
+      End Subroutine Agrif_Prtbounds
+C
+C
+C
+C
+
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_2D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 2D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2))           :: tempP
+C      REAL, DIMENSION(pttab_child(1):petab_child(1),
+C     &                pttab_child(2):petab_child(2)) :: tempC
+     
+      REAL, DIMENSION(:,:) :: tempC     
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 pttab_child(2):petab_child(2)) :: tabtemp
+      REAL, DIMENSION(indmin(2):indmax(2),
+     &                indmin(1):indmax(1))           :: tempP_trsp
+      REAL, DIMENSION(pttab_child(2):petab_child(2),
+     &                 indmin(1):indmax(1)) :: tabtemp_trsp
+      INTEGER :: i,j
+      INTEGER :: coeffraf,locind_child_left
+C
+      tabtemp = 0.
+
+
+      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
+      IF((TypeUpdate(1) == AGRIF_Update_average) 
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+ 
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tabtemp, tempC,
+     &          size(tabtemp), size(tempC),
+     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+
+      ELSE
+      do j = pttab_child(nbdim),petab_child(nbdim)
+C
+!---CDIR NEXPAND
+        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,j),
+     &         tempC(:,j-pttab_child(nbdim)+1),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      ENDIF
+      tabtemp_trsp = TRANSPOSE(tabtemp) 
+      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
+    
+!---CDIR NEXPAND
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      
+      tempP_trsp = 0. 
+
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call average1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+          Call copy1Daftercompute
+     &       (  tempP_trsp, tabtemp_trsp,
+     &          size(tempP_trsp), size(tabtemp_trsp),
+     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+
+      ELSE
+
+      do i = indmin(1),indmax(1)
+C
+!---CDIR NEXPAND
+        Call Agrif_UpdateBase(TypeUpdate(2),
+     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
+     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C        
+      enddo
+      
+      ENDIF
+
+      tempP = TRANSPOSE(tempP_trsp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_2D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_3D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 3D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2), 
+     &                 pttab_child(3):petab_child(3)) :: tabtemp
+      INTEGER :: i,j,k
+      INTEGER :: coeffraf,locind_child_left
+      INTEGER :: kdeb
+C
+C
+      coeffraf = nint ( ds_parent(1) / ds_child(1) )
+      IF((TypeUpdate(1) == AGRIF_Update_average)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
+     &                 .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &       (petab_child(2)-pttab_child(2)+1,
+     &        indmax(1)-indmin(1)+1,
+     &        petab_child(1)-pttab_child(1)+1,
+     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+      precomputedone(1) = .TRUE.
+      ENDIF
+
+      coeffraf = nint ( ds_parent(2) / ds_child(2) )
+      IF((TypeUpdate(2) == AGRIF_Update_average)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call average1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
+     &                .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         Call copy1Dprecompute2D
+     &      ( indmax(1)-indmin(1)+1,
+     &        indmax(2)-indmin(2)+1,
+     &        petab_child(2)-pttab_child(2)+1,
+     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+      precomputedone(2) = .TRUE.
+      ENDIF
+
+
+      do k = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(:,:,k),
+     &         tempC(:,:,k),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+C
+      precomputedone(1) = .FALSE.
+      precomputedone(2) = .FALSE.
+      coeffraf = nint ( ds_parent(3) / ds_child(3) )
+
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      IF (coeffraf == 1) THEN
+      
+      kdeb = pttab_child(3)+locind_child_left-2
+      do k=indmin(3),indmax(3)
+      kdeb = kdeb + 1
+      do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+        tempP(i,j,k) = tabtemp(i,j,kdeb)
+      enddo
+      enddo
+      enddo
+              
+      ELSE
+      tempP = 0.
+C
+      do j = indmin(2),indmax(2)
+C
+        do i = indmin(1),indmax(1)
+C
+          Call Agrif_UpdateBase(TypeUpdate(3),
+     &           tempP(i,j,:),
+     &          tabtemp(i,j,:),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+        enddo 
+C        
+      enddo
+      ENDIF
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_3D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_4D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 4D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3), 
+     &                 pttab_child(4):petab_child(4)))
+C
+      do l = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),l),
+     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do k = indmin(3),indmax(3)
+C
+        do j = indmin(2),indmax(2)
+C
+          do i = indmin(1),indmax(1)
+C
+            Call Agrif_UpdateBase(TypeUpdate(4),
+     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_4D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_5D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 5D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 pttab_child(5):petab_child(5)))
+C
+      do m = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),m),
+     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      tempP = 0.
+C
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(5),
+     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_5D_recursive
+C
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_Update_6D_Recursive 
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,   
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 6D grid variable on the parent grid. 
+CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C     
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(1):indmax(1),
+     &                indmin(2):indmax(2),
+     &                indmin(3):indmax(3),
+     &                indmin(4):indmax(4),
+     &                indmin(5):indmax(5),
+     &                indmin(6):indmax(6))           :: tempP
+      REAL, DIMENSION(pttab_child(1):petab_child(1),
+     &                pttab_child(2):petab_child(2),
+     &                pttab_child(3):petab_child(3),
+     &                pttab_child(4):petab_child(4),
+     &                pttab_child(5):petab_child(5),
+     &                pttab_child(6):petab_child(6)) :: tempC
+C
+C     Local variables      
+      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
+      INTEGER :: i,j,k,l,m,n
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Allocate(tabtemp(indmin(1):indmax(1),
+     &                 indmin(2):indmax(2),
+     &                 indmin(3):indmax(3),
+     &                 indmin(4):indmax(4),   
+     &                 indmin(5):indmax(5),   
+     &                 pttab_child(6):petab_child(6)))
+C
+      do n = pttab_child(nbdim),petab_child(nbdim)
+C
+        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),    
+     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
+     &                 indmin(nbdim-4):indmax(nbdim-4),
+     &                 indmin(nbdim-3):indmax(nbdim-3),
+     &                 indmin(nbdim-2):indmax(nbdim-2),
+     &                 indmin(nbdim-1):indmax(nbdim-1),n),
+     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
+     &               pttab_child(nbdim-4):petab_child(nbdim-4),
+     &               pttab_child(nbdim-3):petab_child(nbdim-3),
+     &               pttab_child(nbdim-2):petab_child(nbdim-2),
+     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
+     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
+     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
+     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
+     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
+C
+      enddo
+      
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+C
+      tempP = 0.
+
+      do m = indmin(5),indmax(5)
+      do l = indmin(4),indmax(4)
+C
+        do k = indmin(3),indmax(3)
+C
+          do j = indmin(2),indmax(2)
+C
+            do i = indmin(1),indmax(1)
+C
+              Call Agrif_UpdateBase(TypeUpdate(6),
+     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
+     &          tabtemp(i,j,k,l,m,
+     &                   pttab_child(nbdim):petab_child(nbdim)),
+     &           indmin(nbdim),indmax(nbdim),
+     &           pttab_child(nbdim),petab_child(nbdim),
+     &           s_parent(nbdim),s_child(nbdim),
+     &           ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+C
+            enddo
+C
+          enddo 
+C
+        enddo 
+C        
+      enddo
+      enddo
+C
+      Deallocate(tabtemp)
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_6D_recursive
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Agrif_UpdateBase  
+C     **************************************************************************  
+C  
+      Subroutine Agrif_UpdateBase(TypeUpdate,
+     &                            parenttab,childtab,
+     &                            indmin,indmax,pttab_child,petab_child,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left)
+C
+CCC   Description:
+CCC   Subroutine calling the updating method chosen by the user (copy, average
+CCC   or full-weighting).    
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+      INTEGER :: TypeUpdate
+      INTEGER :: indmin,indmax
+      INTEGER :: pttab_child,petab_child
+      REAL,DIMENSION(indmin:indmax)           :: parenttab       
+      REAL,DIMENSION(pttab_child:petab_child) :: childtab      
+      REAL    :: s_parent,s_child
+      REAL    :: ds_parent,ds_child      
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      if (TypeUpdate == AGRIF_Update_copy) then
+C             
+          Call agrif_copy1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child)     
+C
+        elseif (TypeUpdate == AGRIF_Update_average) then
+C           
+          Call average1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child) 
+C
+        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
+C             
+          Call full_weighting1D
+     &       (parenttab,childtab,
+     &          indmax-indmin+1,petab_child-pttab_child+1,
+     &          s_parent,s_child,ds_parent,ds_child,
+     &          coeffraf,locind_child_left)
+C
+      endif 
+C
+      Return                
+C
+C      
+      End Subroutine Agrif_UpdateBase
+C
+C
+
+      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
+     &  ds_parent,ds_child,coeffraf,locind_child_left)
+      real :: s_parent,s_child,ds_parent,ds_child
+      integer :: coeffraf,locind_child_left
+     
+      coeffraf = nint(ds_parent/ds_child)
+      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+      
+      End Subroutine Agrif_Compute_nbdim_update
+ 
+#if defined key_mpp_mpi      
+      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim,
+     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
+     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      LOGICAL :: find_list_update
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+      INTEGER :: i
+C
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1      
+      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2      
+                    
+      find_list_update = .FALSE.
+      
+      parcours => list_update
+      
+      Find_loop :   Do While (associated(parcours))
+        Do i=1,nbdim
+          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
+     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
+     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
+     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
+     &               THEN
+            parcours=>parcours%suiv
+            Cycle Find_loop
+          ENDIF
+        EndDo
+        
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall2 = 
+     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 = 
+     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
+        recvfromproc1 = 
+     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
+        sendtoproc2 = 
+     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
+        recvfromproc2 = 
+     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)          
+        
+        find_list_update = .TRUE.   
+        Exit Find_loop
+      End Do Find_loop  
+                              
+      End Subroutine Agrif_Find_list_update  
+      
+      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
+     &                          pttab_Child,pttab_Parent,nbdim
+     &      ,tab4t,tab5t,memberinall,memberinall2,
+     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+          
+      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
+      INTEGER :: nbdim
+      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1      
+      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
+
+      Type(Agrif_List_Interp_loc), Pointer :: parcours
+            
+       Allocate(parcours)
+      Allocate(parcours%interp_loc)
+      
+      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
+      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
+      
+      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))      
+      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))            
+            
+      parcours%interp_loc%tab4t=tab4t   
+      parcours%interp_loc%memberinall=memberinall
+ 
+      parcours%interp_loc%tab5t=tab5t   
+      parcours%interp_loc%memberinall2=memberinall2
+      parcours%interp_loc%sendtoproc1=sendtoproc1   
+      parcours%interp_loc%recvfromproc1=recvfromproc1      
+      parcours%interp_loc%sendtoproc2=sendtoproc2       
+      parcours%interp_loc%recvfromproc2=recvfromproc2      
+            
+      parcours%suiv => list_update
+      
+      list_update => parcours
+      
+      End Subroutine Agrif_Addto_list_update
+#endif
+           
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Update_1D_Recursive
+C     **************************************************************************
+C
+      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
+     &                                     indmin,indmax,
+     &                                     pttab_child,petab_child,
+     &                                     s_child,s_parent,
+     &                                     ds_child,ds_parent,nbdim)
+C
+CCC   Description:
+CCC   Subroutine to update a 1D grid variable on the parent grid.
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C
+C     Arguments
+      INTEGER                   :: nbdim
+      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
+      INTEGER, DIMENSION(nbdim) :: indmin,indmax
+      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
+      REAL, DIMENSION(nbdim)    :: s_child,s_parent
+      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
+      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
+      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
+      INTEGER :: coeffraf,locind_child_left
+C
+C
+      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
+     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
+      
+      Call Agrif_UpdateBase(TypeUpdate(1),
+     &                  tempP(indmin(nbdim):indmax(nbdim)),
+     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
+     &                  indmin(nbdim),indmax(nbdim),           
+     &                  pttab_child(nbdim),petab_child(nbdim),
+     &                  s_parent(nbdim),s_child(nbdim),
+     &                  ds_parent(nbdim),ds_child(nbdim),
+     &                  coeffraf,locind_child_left)
+
+C
+      Return
+C
+C
+      End Subroutine Agrif_Update_1D_recursive      
+
+      End Module Agrif_Update
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F	(revision 3437)
@@ -0,0 +1,659 @@
+!
+! $Id$
+!
+C     AGRIF (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Updatebasic
+C      
+C
+      Module Agrif_Updatebasic
+C
+CCC   Description:
+CCC   Module containing different procedures of update (copy,average,
+CCC   full_weighting) used in the Agrif_Update module.
+C
+C     Modules used:
+C
+      USE Agrif_types
+      
+      IMPLICIT NONE
+      
+      integer,dimension(:,:),allocatable :: indchildcopy
+      integer,dimension(:,:),allocatable :: indchildaverage
+C             
+
+      CONTAINS
+C     Define procedures contained in this module
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1d  
+C     ************************************************************************** 
+C
+      Subroutine agrif_copy1d(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y).  
+C
+CC    Method:
+C
+C     Declarations:
+C
+      
+C        
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+!CDIR ALTCODE
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(locind_child_left)
+C
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo    
+       
+C
+      Return 
+C
+C
+      End Subroutine agrif_copy1d
+
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute2d(nc2,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: nc2,np,nc
+      INTEGER             :: dir   
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildcopy_tmp
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np*nc2,3))
+      else
+      if (size(indchildcopy,1)<np*nc2) then
+      allocate( indchildcopy_tmp(
+     &         size(indchildcopy,1),size(indchildcopy,2)))
+      indchildcopy_tmp = indchildcopy
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np*nc2,3))
+      indchildcopy(1:size(indchildcopy_tmp,1),
+     &              1:size(indchildcopy_tmp,2)) = indchildcopy_tmp
+      deallocate(indchildcopy_tmp)
+      endif
+      endif
+
+
+      do i = 1,np
+C      
+         indchildcopy(i,dir) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+      do i =2, nc2
+        indchildcopy(1+(i-1)*np:i*np,dir)=
+     &       indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute2d
+
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1dprecompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1dprecompute(np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to precompute index for a copy on a parent grid (vector x) from
+CCC   its child grid (vector y).
+C
+CC    Method:
+C
+C     Declarations:
+C
+
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+      if (.not.allocated(indchildcopy)) then
+      allocate(indchildcopy(np,1))
+      else
+      if (size(indchildcopy)<np) then
+      deallocate(indchildcopy)
+      allocate(indchildcopy(np,1))
+      endif
+      endif
+
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         indchildcopy(i,1) = locind_child_left
+         locind_child_left = locind_child_left + coeffraf
+C         
+      enddo
+
+C
+      Return
+C
+C
+      End Subroutine copy1dprecompute
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Copy1daftercompute  
+C     ************************************************************************** 
+C
+      Subroutine copy1daftercompute(x,y,np,nc,
+     &                  s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do a copy on a parent grid (vector x) from its child grid 
+CCC   (vector y) using precomputed index.  
+C
+CC    Method:
+C
+C     Declarations:
+C
+  
+C        
+C     Arguments
+      INTEGER             :: np,nc
+      INTEGER             :: dir
+      REAL, DIMENSION(np) :: x
+      REAL, DIMENSION(nc) :: y
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i
+C 
+C
+      
+!CDIR ALTCODE
+      do i = 1,np
+C      
+         x(i) = y(indchildcopy(i,dir))
+C
+      enddo
+  
+C
+      Return
+C
+C
+      End Subroutine copy1daftercompute
+
+
+C
+C     **************************************************************************  
+CCC   Subroutine Average1d  
+C     ************************************************************************** 
+C   
+      Subroutine average1d(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf
+C
+      if (coeffraf == 1) then
+C
+          locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+      x = 0.
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      do i = 1,np
+          nbnonnuls = 0
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls = nbnonnuls + 1
+               x(i) = x(i) + y(ii)
+               ENDIF
+          End Do
+               IF (nbnonnuls .NE. 0) THEN
+                  x(i) = x(i)/nbnonnuls
+               ELSE
+                  x(i) = Agrif_SpecialValueFineGrid
+               ENDIF
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ELSE 
+
+!CDIR ALTCODE
+      do i = 1,np
+!CDIR NOVECTOR
+          Do ii = -coeffraf/2+locind_child_left+diffmod,
+     &                coeffraf/2+locind_child_left
+C 
+               x(i) = x(i) + y(ii)
+          End Do
+                 x(i) = x(i)*invcoeffraf
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1d
+      
+      Subroutine average1dprecompute2d(nc2,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir)
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: nc2,np,nc,dir
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      INTEGER,DIMENSION(:,:),ALLOCATABLE :: indchildaverage_tmp
+      REAL    :: xpos, invcoeffraf
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+C
+      xpos = s_parent
+C
+      diffmod = 0
+
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+      locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np*nc2,3))
+      else
+      if (size(indchildaverage,1)<np*nc2) then
+      allocate( indchildaverage_tmp(
+     &         size(indchildaverage,1),size(indchildaverage,2)))
+      indchildaverage_tmp = indchildaverage
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np*nc2,3))
+      indchildaverage(1:size(indchildaverage_tmp,1),
+     &              1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+      deallocate(indchildaverage_tmp)
+      endif
+      endif
+
+      do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left
+     &                                    +diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+      do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir)= 
+     &                 indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc 
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute2d
+      
+
+      Subroutine average1dprecompute(np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc 
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii
+      REAL    :: xpos, invcoeffraf 
+      INTEGER :: nbnonnuls
+      INTEGER :: diffmod
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+
+C
+      if (coeffraf == 1) then
+C
+          return
+C
+      endif
+            
+C
+      xpos = s_parent
+C
+      diffmod = 0
+      
+      IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+
+        locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+
+      if (.not.allocated(indchildaverage)) then
+      allocate(indchildaverage(np,1))
+      else
+      if (size(indchildaverage,1)<np) then
+      deallocate(indchildaverage)
+      allocate(indchildaverage(np,1))
+      endif
+      endif
+      
+!CDIR ALTCODE
+      do i = 1,np
+C 
+        indchildaverage(i,1)=-coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+      enddo
+
+      Return 
+C            
+C     
+      End Subroutine average1dprecompute
+      
+      Subroutine average1daftercompute(x,y,np,nc,
+     &                     s_parent,s_child,ds_parent,ds_child,dir) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by average on a parent grid (vector x)from its 
+CCC   child grid (vector y).
+C
+C     Arguments
+      INTEGER             :: np,nc,dir      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf,ii,j
+      REAL    :: xpos, invcoeffraf 
+      REAL, PARAMETER :: one_third=1./3.
+      INTEGER, DIMENSION(np) :: nbnonnuls
+      INTEGER :: diffmod
+      REAL, DIMENSION(0:5) :: invcoeff=(/1.,1.,0.5,one_third,0.25,0.2/)
+C 
+C
+      coeffraf = nint(ds_parent/ds_child)
+      invcoeffraf = 1./coeffraf      
+C      
+C
+      IF (Agrif_UseSpecialValueInUpdate) THEN
+
+      nbnonnuls = 0
+      do  j =1, coeffraf
+          do i=1, np
+               IF (y(indchildaverage(i,dir) + j -1) .NE. 
+     &               Agrif_SpecialValueFineGrid) THEN
+               nbnonnuls(i) = nbnonnuls(i) + 1
+               x(i) = x(i) +  y(indchildaverage(i,dir) + j -1 )
+               ENDIF
+          End Do
+      enddo
+      do i=1,np
+      x(i)= x(i)*invcoeff(nbnonnuls(i)) 
+      enddo
+
+      ELSE
+!CDIR NOLOOPCHG
+      do  j =1, coeffraf
+!CDIR VECTOR
+          do i=1, np
+             x(i) = x(i) + y(indchildaverage(i,dir) + j -1 )
+          enddo
+      enddo
+       x = x * invcoeffraf
+      ENDIF
+
+      Return 
+C            
+C     
+      End Subroutine average1daftercompute            
+C
+C
+C
+C     **************************************************************************  
+CCC   Subroutine Full_weighting1d  
+C     **************************************************************************  
+C
+      Subroutine full_weighting1D(x,y,np,nc,
+     &                            s_parent,s_child,ds_parent,ds_child,
+     &                            coeffraf,locind_child_left) 
+C
+CCC   Description:
+CCC   Subroutine to do an update by full_weighting on a parent grid (vector x) 
+CCC   from its child grid (vector y).
+C 
+C     Arguments
+      INTEGER             :: np,nc      
+      REAL, DIMENSION(np) :: x      
+      REAL, DIMENSION(nc) :: y  
+      REAL                :: s_parent,s_child
+      REAL                :: ds_parent,ds_child
+C
+C     Local variables
+      INTEGER :: i,locind_child_left,coeffraf
+      REAL    :: xpos,sumweight,weight
+      INTEGER :: ii,diffmod
+      REAL :: xposfin
+      INTEGER :: it1,it2
+      INTEGER :: i1,i2
+      REAL :: invsumweight
+      REAL :: weights(-(coeffraf):coeffraf)
+      
+C
+C
+      if (coeffraf == 1) then
+C        
+          x(1:np) = y(locind_child_left:locind_child_left+np-1)
+C
+          return
+C
+      endif
+C
+      xpos = s_parent      
+      
+       x = 0.
+
+       xposfin = s_child + ds_child * (locind_child_left - 1)
+       IF (abs(xposfin - xpos).LT.0.001) THEN
+          diffmod = 0
+       ELSE
+          diffmod = 1
+       ENDIF
+C
+             
+      if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i=-coeffraf,-1
+          weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i=0,coeffraf-1
+          weights(i)=weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+      else
+      invsumweight=1./coeffraf**2
+      do i=-(coeffraf-1),0
+        weights(i) = invsumweight*(coeffraf + i)
+      enddo
+      do i=1,coeffraf-1
+        weights(i) = invsumweight*(coeffraf - i)
+      enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+      endif
+
+      sumweight = 0                    
+      do i = 1,np
+C
+          it2 = it1
+          Do ii = i1,i1+i2
+C
+           IF (Agrif_UseSpecialValueInUpdate) THEN
+            IF (y(ii) .NE. Agrif_SpecialValueFineGrid) THEN
+               x(i) = x(i) + weights(it2)*y(ii)
+               sumweight = sumweight+weights(it2)
+            ENDIF
+           ELSE           
+               x(i) = x(i) + weights(it2)*y(ii)
+           ENDIF           
+           
+          it2 = it2+1
+          End Do
+
+           IF (Agrif_UseSpecialValueInUpdate) THEN          
+                 IF (sumweight .NE. 0.) THEN
+                    x(i) = x(i)/sumweight
+                    sumweight = 0
+                 ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                 ENDIF
+           ENDIF
+        
+        i1 = i1 + coeffraf
+C
+      enddo    
+C
+
+      Return 
+C            
+C
+      End Subroutine full_weighting1D 
+
+C
+      End module AGRIF_updatebasic
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F	(revision 3437)
@@ -0,0 +1,864 @@
+!
+! $Id$
+!
+C     Agrif (Adaptive Grid Refinement In Fortran)
+C
+C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+C                        Christophe Vouland (Christophe.Vouland@imag.fr)    
+C
+C     This program is free software; you can redistribute it and/or modify
+C     it under the terms of the GNU General Public License as published by
+C     the Free Software Foundation; either version 2 of the License, or
+C     (at your option) any later version.
+C
+C     This program is distributed in the hope that it will be useful,
+C     but WITHOUT ANY WARRANTY; without even the implied warranty of
+C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+C     GNU General Public License for more details.
+C
+C     You should have received a copy of the GNU General Public License
+C     along with this program; if not, write to the Free Software
+C     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+C
+C
+C
+CCC   Module Agrif_Util 
+C 
+      Module Agrif_Util 
+C
+C
+CCC   Description:   
+CCC   This module contains the two procedures called in the main program : 
+CCC   Agrif_Init_Grids allowing the initialization of the root coarse grid, and
+CCC   Agrif_Step allowing the creation of the grid hierarchy and the management
+CCC   of the time integration. 
+C
+C     Modules used:
+C
+      Use Agrif_Clustering    
+      Use Agrif_bcfunction
+C      
+      IMPLICIT NONE
+C
+      Contains
+C     Definition of procedures contained in this module.
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Step
+C     **************************************************************************
+C 
+      Subroutine Agrif_Step(procname) 
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration 
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Integer      :: code, ierr
+      Logical      :: mpi_was_called
+C
+C
+      Call Agrif_comm_def(MPI_COMM_AGRIF)
+
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         WRITE(*, *) ': Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_comm_dup( mpi_comm_world, MPI_COMM_AGRIF, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code)
+          Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code)
+          Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code)
+      endif
+#endif
+C
+C     Creation and initialization of the grid hierarchy 
+C
+C  
+C    Set the clustering variables
+C
+      Call Agrif_clustering_def()
+C      
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C     
+         If (Agrif_Mygrid % ngridstep == 0) then
+C
+            Call Agrif_Regrid
+C 
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)           
+         endif
+C
+      else
+C    
+         If (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+C
+            Call Agrif_Regrid
+C  
+            Call Agrif_Instance           
+     &          (Agrif_Mygrid)  
+C            
+         endif
+C
+      endif
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate (Agrif_Mygrid)      
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids)) 
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C             
+      End Subroutine Agrif_Step      
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Step_Child
+C     **************************************************************************
+C
+      Subroutine Agrif_Step_Child(procname)
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy and to manage the time integration
+CCC   procedure. It is called in the main program.
+C
+CC    Method:
+CC    Call on subroutines Agrif_Regrid and Agrif_Integrate.
+C
+C     Declarations:
+C
+      Optional :: procname
+      External :: procname
+C
+C     Time integration of the grid hierarchy
+C
+      If (present(procname)) Then
+         Call Agrif_Integrate_Child (Agrif_Mygrid,procname)
+      Else
+         Call Agrif_Integrate_Child (Agrif_Mygrid)
+      endif
+C    
+      If (associated(Agrif_Mygrid%child_grids))
+     &   Call Agrif_Instance (Agrif_Mygrid)
+C
+      Return
+C
+      End Subroutine Agrif_Step_Child
+
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Regrid
+C     **************************************************************************
+C
+      Subroutine Agrif_Regrid
+C
+CCC   Description:
+CCC   Subroutine to create the grid hierarchy from fixed grids and 
+CC       adaptive mesh refinement.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Local variables      
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_fixed
+      Type(Agrif_Rectangle), Pointer     :: coarsegrid_moving  
+      INTEGER                            :: j
+      INTEGER :: nunit
+      INTEGER                            :: iii
+      Logical :: BEXIST
+C 
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 )
+     &   Call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined
+C
+      Allocate(coarsegrid_fixed)
+      Allocate(coarsegrid_moving)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &    Call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+C
+      if ( Agrif_USE_FIXED_GRIDS .EQ. 1 .OR. 
+     &     Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+C
+      If (Agrif_Mygrid % ngridstep == 0) Then
+          nunit = Agrif_Get_Unit()
+          open(nunit,file='AGRIF_FixedGrids.in',form='formatted',
+     &           status="old",ERR=99) ! Opening of the Agrif_FixedGrids.in file
+          j = 1
+C         Creation of the grid hierarchy from the Agrif_FixedGrids.in file 
+            do iii = 1 , Agrif_Probdim
+               coarsegrid_fixed % imin(iii) = 1
+               coarsegrid_fixed % imax(iii) = Agrif_Mygrid % nb(iii) + 1
+            enddo
+C      
+            Call Agrif_Read_Fix_Grd (coarsegrid_fixed,j,nunit)     
+            close(nunit) ! Closing of the Agrif_FixedGrids.in file 
+C
+          Nullify(Agrif_oldmygrid)
+          Nullify(Agrif_Mygrid  % child_grids)
+C        
+C         Creation of the grid hierarchy from coarsegrid_fixed
+            Call Agrif_Create_Grids (Agrif_Mygrid,coarsegrid_fixed)
+        Else        
+          Agrif_oldmygrid => Agrif_Mygrid % child_grids
+         endif
+      else
+      Agrif_oldmygrid => Agrif_Mygrid % child_grids
+      Nullify(Agrif_Mygrid  % child_grids)
+      endif
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then
+C
+      Call Agrif_Save_All(Agrif_oldmygrid)      
+C      
+      Call Agrif_Free_before_All(Agrif_oldmygrid)
+C 
+C     Creation of the grid hierarchy from coarsegrid_moving    
+      Call Agrif_Create_Grids
+     &     (Agrif_Mygrid,coarsegrid_moving)
+C
+      endif
+C
+C     Initialization of the grid hierarchy by copy or interpolation
+C
+      Call Agrif_Init_Hierarchy(Agrif_Mygrid)
+C
+      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) 
+     &        Call Agrif_Free_after_All(Agrif_oldmygrid)
+C
+      Deallocate(coarsegrid_fixed)
+      Deallocate(coarsegrid_moving)
+C      
+      Return
+C
+C     Opening error
+C
+   99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+      If (.not. BEXIST) Then
+          print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+          STOP 
+        Else
+          print*,'Error opening file AGRIF_FixedGrids.in'
+          STOP         
+      endif     
+C      
+      End Subroutine Agrif_Regrid
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_detect_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_detect_all(g)
+C
+CCC   Description:
+CCC   Subroutine to detect areas to be refined.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      TYPE(Agrif_Grid) ,pointer  :: g        ! Pointer on the current grid
+C      
+C     Local variables
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+      INTEGER, DIMENSION(3)      :: size
+      INTEGER                    :: iii
+      Real :: g_eps     
+C
+      parcours => g % child_grids
+C  
+C     To be positioned on the finer grids of the grid hierarchy          
+C  
+      do while (associated(parcours))       
+         Call Agrif_detect_all (parcours % gr)  
+        parcours => parcours % next             
+      enddo
+C
+      g_eps = huge(1.)
+      do iii = 1 , Agrif_Probdim
+         g_eps=min(g_eps,g%Agrif_d(iii))
+      enddo
+C
+      g_eps = g_eps/100.
+C          
+      if ( Agrif_Probdim .EQ. 1 ) g%tabpoint1D=0
+      if ( Agrif_Probdim .EQ. 2 ) g%tabpoint2D=0
+      if ( Agrif_Probdim .EQ. 3 ) g%tabpoint3D=0
+C      
+      do iii = 1 , Agrif_Probdim
+         if (g%Agrif_d(iii)/Agrif_coeffref(iii).LT.
+     &                     (Agrif_mind(iii)-g_eps)) Return
+      enddo
+C                                       
+      Call Agrif_instance(g)
+C  
+C     Detection (Agrif_detect is a user s routine)
+C      
+     
+      do iii = 1 , Agrif_Probdim
+         size(iii) = g%nb(iii) + 1
+      enddo
+C
+      SELECT CASE (Agrif_Probdim)
+      CASE (1) 
+         Call Agrif_detect(g%tabpoint1D,size)
+      CASE (2) 
+         Call Agrif_detect(g%tabpoint2D,size)
+      CASE (3) 
+         Call Agrif_detect(g%tabpoint3D,size)
+      END SELECT
+C
+C     Addition of the areas detected on the child grids
+C      
+      parcours => g % child_grids 
+C           
+      Do while (associated(parcours))
+        Call Agrif_Add_detected_areas (g,parcours % gr)
+        parcours => parcours % next 
+      enddo
+C     
+      Return      
+C
+      End Subroutine Agrif_detect_all
+C      
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Add_detected_areas
+C     **************************************************************************
+C      
+      Subroutine Agrif_Add_detected_areas(parentgrid,childgrid)
+C
+CCC   Description:
+CCC   Subroutine to add on the parent grid the areas detected 
+CC       on its child grids.
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C 
+      Type(Agrif_Grid),pointer   :: parentgrid,childgrid
+C      
+      Integer :: i,j,k
+C
+      do i = 1,childgrid%nb(1)+1
+         if ( Agrif_Probdim .EQ. 1 ) then
+            If (childgrid%tabpoint1D(i).EQ.1) Then
+                parentgrid%tabpoint1D(childgrid%ix(1)+
+     &                 (i-1)/Agrif_Coeffref(1)) = 1
+            endif
+         else
+            do j=1,childgrid%nb(2)+1
+               if (Agrif_Probdim.EQ.2) then
+              If (childgrid%tabpoint2D(i,j).EQ.1) Then
+                  parentgrid%tabpoint2D(
+     &                  childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                  childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                  endif
+               else
+                  do k=1,childgrid%nb(3)+1
+                If (childgrid%tabpoint3D(i,j,k).EQ.1) Then
+                    parentgrid%tabpoint3D(
+     &                     childgrid%ix(1)+(i-1)/Agrif_Coeffref(1),
+     &                     childgrid%ix(2)+(j-1)/Agrif_Coeffref(2),
+     &                     childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                     endif
+                  enddo
+               endif
+            enddo
+         endif
+      enddo
+C      
+      Return
+C
+      End Subroutine Agrif_Add_detected_areas   
+C      
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_before_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_before_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Free_before_all (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Free_before_All
+C     **************************************************************************
+CCC   Subroutine Agrif_Save_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Save_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure      
+C
+C
+      parcours => g        
+C      
+      Do while (associated(parcours))     
+        If (.not. parcours%gr%fixed) Then
+            Call Agrif_Instance(parcours%gr)
+            Call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.        
+        endif
+C
+        Call Agrif_Save_All (parcours % gr % child_grids)
+C  
+        parcours => parcours % next             
+      enddo
+C     
+      Return      
+C
+C
+      End Subroutine Agrif_Save_All      
+C
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Free_after_All
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Free_after_All(g)
+C
+CCC   Description:
+C
+CC    Method:        
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_pgrid),pointer   :: g       ! Pointer on the current grid
+C
+C     Local pointers
+      TYPE(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive proced
+      Type(Agrif_pgrid),pointer  :: preparcours   
+      Type(Agrif_pgrid),pointer  :: preparcoursini 
+C
+C
+      Allocate(preparcours)
+C 
+      preparcoursini => preparcours
+C 
+      Nullify(preparcours % gr)
+C 
+      preparcours % next => g
+C
+      parcours => g
+C      
+      Do while (associated(parcours))
+C
+         if ( (.NOT. parcours% gr% fixed) .AND.
+     &        (parcours% gr% oldgrid    ) ) then
+          Call Agrif_Free_data_after(parcours%gr)
+         endif
+C
+         Call Agrif_Free_after_all (parcours % gr % child_grids)
+C
+      If (parcours % gr % oldgrid) Then
+          Deallocate(parcours % gr)
+          preparcours % next => parcours % next
+          Deallocate(parcours)
+          parcours => preparcours % next
+        Else
+          preparcours => preparcours % next
+          parcours => parcours % next 
+         endif       
+      enddo
+C
+      Deallocate(preparcoursini)
+C     
+      Return      
+C
+      End Subroutine Agrif_Free_after_All
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate(g, procname)         
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step
+C
+C     Declarations:
+C
+      
+C      
+C     Pointer argument    
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname      
+C      
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive 
+                                             ! procedure
+C
+C     Local scalars
+      INTEGER                    :: nbt      ! Number of time steps 
+                                             ! of the current grid
+      INTEGER                    :: k        
+      INTEGER                    :: iii
+C  
+C     Instanciation of the variables of the current grid
+      If (g%fixedrank .NE.0) Then      
+      Call Agrif_Instance
+     &     (g)
+      End If
+C       
+C     One step on the current grid      
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid      
+C
+      g%ngridstep = g % ngridstep + 1
+C      
+      parcours => g % child_grids
+C    
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid            
+        Call Agrif_Instance
+     &           (parcours % gr)
+C       
+C       Number of time steps
+        nbt = 1
+        do iii = 1 , Agrif_Probdim
+           nbt = max(nbt, parcours % gr % timeref(iii))
+        enddo
+C       
+        Do k = 1,nbt
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate (parcours % gr)      
+           endif
+C       
+        enddo     
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C      
+      End Subroutine Agrif_Integrate 
+
+C     **************************************************************************
+CCC   Subroutine Agrif_Integrate_Child
+C     **************************************************************************
+C
+      Recursive Subroutine Agrif_Integrate_Child(g,procname)
+C
+CCC   Description:
+CCC   Subroutine to manage the time integration of the grid hierarchy.
+C
+CC    Method:
+CC    Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+C
+C     Declarations:
+C
+
+C
+C     Pointer argument
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+C
+C     main procedure name
+      Optional :: procname
+      External :: procname
+C
+C     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
+                                             ! procedure
+C
+C     One step on the current grid
+C
+      If (present(procname)) Then
+         Call procname ()      
+      Else
+        write(*,*) 'The name of the step subroutine has not '
+        write(*,*) 'been given in the subroutine Agrif_Integrate'
+        stop
+      endif
+C
+C     Number of time steps on the current grid
+C
+C
+      parcours => g % child_grids
+C
+C     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+C
+C       Instanciation of the variables of the current grid
+        Call Agrif_Instance
+     &           (parcours % gr)
+
+C       
+           If (present(procname)) Then
+                 Call Agrif_Integrate_Child (parcours % gr, procname)
+           Else
+                 Call Agrif_Integrate_Child (parcours % gr)
+           endif
+C  
+        parcours => parcours % next
+C     
+      enddo
+C
+C
+      End Subroutine Agrif_Integrate_Child
+
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Init_Grids
+C     **************************************************************************
+C      
+      Subroutine Agrif_Init_Grids
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: iii
+C
+C             definition of the probdim and modtypes variables
+C
+#ifdef key_mpp_mpi
+      INCLUDE 'mpif.h'
+      Agrif_MPIPREC = MPI_DOUBLE_PRECISION
+#endif
+      Call Agrif_probdim_modtype_def()
+C      
+      Agrif_UseSpecialValue = .FALSE.
+      Agrif_UseSpecialValueFineGrid = .FALSE.
+      Agrif_SpecialValue = 0.
+      Agrif_SpecialValueFineGrid = 0.
+C      
+C     Allocation of Agrif_Mygrid
+      allocate(Agrif_Mygrid)
+C      
+C     Space and time refinement factors are set to 1 on the root grid
+C
+      do iii = 1 , Agrif_Probdim
+         Agrif_Mygrid % spaceref(iii) = 1
+         Agrif_Mygrid % timeref(iii) = 1
+      enddo
+C      
+C     Initialization of the number of time steps    
+      Agrif_Mygrid % ngridstep = 0
+      Agrif_Mygrid % grid_id = 0
+C
+C     No parent grid for the root coarse grid
+      Nullify(Agrif_Mygrid % parent)
+C      
+C     Initialization of the minimum positions, global abscissa and space steps  
+      do iii= 1 ,  Agrif_Probdim
+         Agrif_Mygrid % ix(iii) = 1            
+         Agrif_Mygrid % Agrif_x(iii) = 0.
+         Agrif_Mygrid % Agrif_d(iii) = 1. 
+C     Borders of the root coarse grid 
+         Agrif_Mygrid % NearRootBorder(iii) = .true.  
+         Agrif_Mygrid % DistantRootBorder(iii) = .true.      
+      enddo
+C  
+C     The root coarse grid is a fixed grid
+      Agrif_Mygrid % fixed = .TRUE.
+C     Level of the root grid
+      Agrif_Mygrid % level = 0
+C     Maximum level in the hierarchy
+      Agrif_MaxLevelLoc = 0
+      
+C      
+C     Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+      Agrif_Mygrid % rank = 1      
+C 
+C     Number of the root grid as a fixed grid   
+      Agrif_Mygrid % fixedrank = 0  
+C 
+C     Initialization of some fields of the root grid variables     
+      Call Agrif_Create_Var (Agrif_Mygrid)
+C      
+C     Initialization of the other fields of the root grid variables (number of 
+C     cells, positions, number and type of its dimensions, ...)  
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)
+C      
+      Call Agrif_Instance (Agrif_Mygrid)        
+C
+      Call Agrif_Set_numberofcells(Agrif_Mygrid)          
+C             
+C     Allocation of the array containing the values of the grid variables
+      Call Agrif_Allocation (Agrif_Mygrid)
+C        
+      Call Agrif_initialisations(Agrif_Mygrid)    
+C      
+      nullify(Agrif_Mygrid % child_grids)
+C 
+C     Total number of fixed grids   
+      Agrif_nbfixedgrids = 0         
+C      
+      Call Agrif_Instance (Agrif_Mygrid)
+C        
+      End Subroutine Agrif_Init_Grids  
+C
+C
+C     **************************************************************************
+CCC   Subroutine Agrif_Deallocation
+C     **************************************************************************
+C      
+      Subroutine Agrif_Deallocation
+C
+CCC   Description:
+CCC   Subroutine to initialize the root coarse grid pointed by Agrif_Mygrid. 
+CCC   It is called in the main program.
+C
+C     Declarations:
+C
+C
+      INTEGER :: nb
+C
+C             definition of the probdim and modtypes variables
+C
+      do nb = 1, Agrif_NbVariables
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6)
+C
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1)
+          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 
+     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2)
+      enddo
+C
+      do nb = 1, Agrif_NbVariables
+        Deallocate(Agrif_Mygrid % tabvars(nb) % var)
+      enddo
+C
+      Deallocate(Agrif_Mygrid % tabvars)
+C
+      Deallocate(Agrif_Mygrid)
+C
+      End Subroutine  Agrif_Deallocation 
+C
+      End module Agrif_Util 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modvariables.F	(revision 3437)
@@ -0,0 +1,152 @@
+      Module Agrif_Variables 
+      Use Agrif_CurgridFunctions
+      
+      Contains
+      Subroutine Agrif_Declare_Variable(posvar,firstpoint,
+     &    raf,lb,ub,varid,torestore)
+      character*(80) :: variablename
+      Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep
+      INTEGER, DIMENSION(:) :: posvar
+      INTEGER, DIMENSION(:) :: lb,ub
+      INTEGER, DIMENSION(:) :: firstpoint
+      CHARACTER(*) ,DIMENSION(:) :: raf        
+      TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var
+      INTEGER :: dimensio
+      INTEGER :: varid
+      LOGICAL, OPTIONAL :: torestore
+      LOGICAL :: restaure
+            
+!      if (agrif_root()) return
+
+      variablename = 'xxx'
+      
+      restaure = .FALSE.
+      if (agrif_mygrid%ngridstep /= 0) then
+        if (present(torestore)) restaure = torestore
+      endif
+      
+      dimensio = SIZE(posvar)
+C
+C    
+      Allocate(newvariable)
+      Allocate(newvariable%pvar)
+      Allocate(newvariable%pvar%var)
+      Allocate(newvariable%pvar%var%posvar(dimensio))
+      Allocate(newvariable%pvar%var%interptab(dimensio))
+      newvariable%pvar%var%variablename = variablename
+      newvariable%pvar%var%interptab = raf
+      newvariable%pvar%var%nbdim = dimensio
+      newvariable%pvar%var%posvar = posvar
+      newvariable%pvar%var%point(1:dimensio) = firstpoint
+      newvariable%pvar%var%restaure = restaure
+
+      newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+      newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+      
+      if (restaure) then
+      select case(dimensio)
+      case(1)
+                  Allocate( newvariable%pvar%var%Restore1D(  
+     &      lb(1):ub(1)))         
+            newvariable%pvar%var%Restore1D = 0      
+      case(2)
+                  Allocate( newvariable%pvar%var%Restore2D(  
+     &      lb(1):ub(1),lb(2):ub(2)))         
+            newvariable%pvar%var%Restore2D = 0
+      case(3)
+                  Allocate( newvariable%pvar%var%Restore3D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))         
+            newvariable%pvar%var%Restore3D = 0
+      case(4)
+                  Allocate( newvariable%pvar%var%Restore4D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))         
+            newvariable%pvar%var%Restore4D = 0
+      case(5)
+                  Allocate( newvariable%pvar%var%Restore5D(  
+     &      lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),
+     &      lb(5):ub(5)))         
+            newvariable%pvar%var%Restore5D = 0            
+      end select
+      endif
+      
+      newvariable % nextvariable => Agrif_Curgrid%variables
+      
+      Agrif_Curgrid%variables => newvariable
+      Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1
+
+      varid = -Agrif_Curgrid%Nbvariables
+
+!       if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables)
+!     &       then
+!      Allocate(newvariablep)
+!      Allocate(newvariablep%pvar)
+!      Allocate(newvariablep%pvar%var)      
+!      Allocate(newvariablep%pvar%var%posvar(dimensio))
+!      Allocate(newvariablep%pvar%var%interptab(dimensio))
+!      newvariablep%pvar%var%variablename = variablename
+!      newvariablep%pvar%var%interptab = raf
+!      newvariablep%pvar%var%nbdim = dimensio
+!      newvariablep%pvar%var%posvar = posvar
+!      newvariablep%pvar%var%point(1:dimensio) = firstpoint
+!      newvariablep%pvar%var%restaure = restaure      
+! 
+!      newvariablep%pvar%var%lb(1:dimensio) = lb(1:dimensio)
+!      newvariablep%pvar%var%ub(1:dimensio) = ub(1:dimensio)
+!           
+!      newvariablep % nextvariable => Agrif_Curgrid%parent%variables
+!      
+!      Agrif_Curgrid%parent%variables => newvariablep       
+!      
+!      Agrif_Curgrid%parent%Nbvariables = 
+!     &    Agrif_Curgrid%parent%Nbvariables + 1
+!      parent_var=>newvariablep%pvar
+!      else
+!      parent_var=>Agrif_Search_Variable
+!     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)
+!       endif
+       
+       if (.not.agrif_root()) then
+      parent_var=>Agrif_Search_Variable
+     &              (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables)       
+       
+       newvariable%pvar%parent_var=>parent_var
+       do i=1,dimensio
+         if (parent_var%var%interptab(i)=='N') then
+           parent_var%var%lb(i)=lb(i)
+           parent_var%var%ub(i)=ub(i)
+         endif
+       enddo
+       endif       
+      
+      root_var=>Agrif_Search_Variable
+     &              (Agrif_Mygrid,Agrif_Curgrid%nbvariables)
+     
+      newvariable%pvar%var%root_var=>root_var%var
+      
+           
+      End Subroutine Agrif_Declare_Variable
+
+      FUNCTION Agrif_Search_Variable(grid,varid)
+      integer :: varid
+      Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable
+      Type(Agrif_grid), Pointer :: grid
+      
+      Type(Agrif_List_Variables), pointer :: parcours
+      Logical :: foundvariable
+      integer nb
+      integer :: varidinv
+      
+      foundvariable = .FALSE.
+      parcours => grid%variables
+      varidinv = 1 + grid%nbvariables - varid
+
+      do nb=1,varidinv-1
+         parcours => parcours%nextvariable    
+      End Do
+      
+      Agrif_Search_variable => parcours%pvar
+      
+      
+      End Function Agrif_Search_variable
+      
+      End Module Agrif_Variables      
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c	(revision 3437)
@@ -0,0 +1,606 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_C];
+   char ligne[LONG_C];
+   int out;
+
+   if ( firstpass == 1 )
+   {
+
+   newvar = (listvar *)malloc(sizeof(listvar));
+   newvariable = (variable *)malloc(sizeof(variable));
+   /*                                                                         */
+   Init_Variable(newvariable);
+   /*                                                                         */
+   strcpy(newvariable->v_nomvar,commonvar);
+   Save_Length(commonvar,4);
+   strcpy(newvariable->v_commonname,commonblockname);
+   Save_Length(commonblockname,7);
+   strcpy(newvariable->v_modulename,curmodulename);
+   Save_Length(curmodulename,6);
+   strcpy(newvariable->v_subroutinename,subroutinename);
+   Save_Length(subroutinename,11);
+   newvariable->v_positioninblock= positioninblock;
+   newvariable->v_common=1;
+   strcpy(newvariable->v_commoninfile,mainfile);
+   Save_Length(mainfile,10);
+
+   newvar->var = newvariable;
+
+   if ( commondim )
+   {
+      newvariable->v_dimension=commondim;
+      newvariable->v_dimensiongiven=1;
+      newvariable->v_nbdim=num_dims(commondim);
+      /* Creation of the string for the dimension of this variable            */
+      dimsempty = 1;
+      strcpy(listdimension,"");
+
+      if ( commondim )
+      {
+         dims = commondim;
+         while (dims)
+         {
+            if ( strcasecmp(dims->dim.first,"") ||
+                 strcasecmp(dims->dim.last,""))  dimsempty = 0;
+            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+            strcat(listdimension,ligne);
+            if ( dims->suiv ) strcat(listdimension,",");
+            dims = dims->suiv;
+         }
+         if ( dimsempty == 1 ) newvariable->v_dimsempty=1;
+      }
+      strcpy(newvariable->v_readedlistdimension,listdimension);
+      Save_Length(listdimension,15);
+   }
+
+
+   newvar->suiv = NULL;
+
+   if ( !List_Common_Var )
+   {
+      List_Common_Var = newvar;
+   }
+   else
+   {
+      newvar2 = List_Common_Var;
+      out = 0 ;
+      while ( newvar2 && out == 0 )
+      {
+         if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
+              !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
+              !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
+                          ) out = 1 ;
+         else newvar2 = newvar2->suiv;
+      }
+      if ( out == 0 )
+      {
+         newvar->suiv = List_Common_Var;
+         List_Common_Var = newvar;
+      }
+      else
+      {
+         free(newvar);
+      }
+   }
+   }
+}
+
+/******************************************************************************/
+/*                           Addtolistnom                                     */
+/******************************************************************************/
+/* This subroutine is used to add a variable to the list                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+listnom *Addtolistnom(char *nom, listnom *listin,int value)
+{
+   listnom *newnom;
+   listnom *parcours;
+   int out;
+
+   newnom=(listnom *) malloc (sizeof (listnom));
+   strcpy(newnom->o_nom,nom);
+   Save_Length(nom,23);
+   newnom->o_val = value;
+   newnom->suiv = NULL;
+
+   if ( !listin ) listin = newnom;
+   else
+   {
+      parcours = listin;
+      out = 0 ;
+      while ( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
+         else parcours=parcours->suiv;
+      }
+      if ( out == 0 )
+      {
+          newnom->suiv = listin;
+          listin = newnom;
+      }
+      else
+      {
+         free(newnom);
+      }
+   }
+   return listin;
+}
+
+/******************************************************************************/
+/*                           Addtolistname                                    */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listname *Addtolistname(char *nom,listname *input)
+{
+   listname *newnom;
+   listname *parcours;
+   int out;
+
+   if ( !input )
+   {
+      newnom=(listname *) malloc (sizeof (listname));
+      strcpy(newnom->n_name,nom);
+      Save_Length(nom,20);
+      newnom->suiv = NULL;
+      input = newnom;
+   }
+   else
+   {
+      parcours = input;
+      out = 0 ;
+      while ( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
+         else parcours=parcours->suiv;
+      }
+      if ( out == 0 )
+      {
+         newnom=(listname *) malloc (sizeof (listname));
+         strcpy(newnom->n_name,nom);
+         Save_Length(nom,20);
+         newnom->suiv = input;
+         input = newnom;
+      }
+   }
+   return input;
+}
+
+/******************************************************************************/
+/*                    ModuleIsDefineInInputFile                               */
+/******************************************************************************/
+/* This subroutine is used to know if the module is defined in the input file */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int ModuleIsDefineInInputFile(char *name)
+{
+   listnom *newnom;
+   int out;
+
+   out = 0;
+   if ( listofmodules )
+   {
+      newnom = listofmodules;
+      while( newnom && out == 0 )
+      {
+         if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
+         else newnom=newnom->suiv;
+      }
+   }
+   return out;
+}
+
+/******************************************************************************/
+/*                      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(char *name)
+{
+  listusemodule *newmodule;
+  listusemodule *parcours;
+  int out;
+
+  if ( !listofmoduletmp)
+  {
+    newmodule =(listusemodule *)malloc(sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule,name);
+    Save_Length(name,16);
+    strcpy(newmodule->u_cursubroutine,subroutinename);
+    Save_Length(subroutinename,18);
+    newmodule->suiv = NULL;
+    listofmoduletmp = newmodule ;
+  }
+  else
+  {
+    parcours = listofmoduletmp;
+    out = 0;
+    while( parcours && out == 0 )
+    {
+       if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1;
+       else parcours = parcours->suiv;
+    }
+    if ( out == 0 )
+    {
+       newmodule =(listusemodule *)malloc(sizeof(listusemodule));
+       strcpy(newmodule->u_usemodule,name);
+       Save_Length(name,16);
+       strcpy(newmodule->u_cursubroutine,subroutinename);
+       Save_Length(subroutinename,18);
+       newmodule->suiv = listofmoduletmp;
+       listofmoduletmp = newmodule;
+    }
+  }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfModule_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfModule_1(char *nom)
+{
+   listnom *newnom;
+
+   if ( firstpass == 1 )
+   {
+      newnom=(listnom *) malloc (sizeof (listnom));
+      strcpy(newnom->o_nom,nom);
+      Save_Length(nom,23);
+      newnom->suiv = List_NameOfModule;
+      List_NameOfModule = newnom;
+   }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfCommon_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfCommon_1(char *nom,char *cursubroutinename)
+{
+   listnom *newnom;
+   listnom *parcours;
+
+   if ( firstpass == 1 )
+   {
+      parcours = List_NameOfCommon;
+      while ( parcours && strcasecmp(parcours->o_nom,nom) )
+                                                      parcours = parcours->suiv;
+      if ( !parcours )
+      {
+         newnom=(listnom *) malloc (sizeof (listnom));
+         strcpy(newnom->o_nom,nom);
+         strcpy(newnom->o_subroutinename,cursubroutinename);
+         Save_Length(nom,23);
+         newnom->suiv = List_NameOfCommon;
+         List_NameOfCommon = newnom;
+      }
+   }
+}
+
+/******************************************************************************/
+/*                     Add_CouplePointed_Var_1                                */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the listvarpointtovar                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple)
+{
+   listvarpointtovar *pointtmp;
+
+   if ( firstpass == 1 )
+   {
+      /* we should complete the List_CouplePointed_Var                        */
+      pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar));
+      strcpy(pointtmp->t_usemodule,namemodule);
+      Save_Length(namemodule,28);
+      strcpy(pointtmp->t_cursubroutine,subroutinename);
+      Save_Length(subroutinename,29);
+      pointtmp->t_couple = couple;
+      if ( List_CouplePointed_Var )
+      {
+         pointtmp->suiv = List_CouplePointed_Var;
+         List_CouplePointed_Var = pointtmp;
+      }
+      else
+      {
+         pointtmp->suiv = NULL;
+         List_CouplePointed_Var = pointtmp;
+      }
+   }
+}
+
+/******************************************************************************/
+/*                           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(char *name)
+{
+  listusemodule *newinclude;
+
+  if ( firstpass == 1 )
+  {
+  newinclude =(listusemodule *)malloc(sizeof(listusemodule));
+  strcpy(newinclude->u_usemodule,name);
+  Save_Length(name,16);
+  strcpy(newinclude->u_cursubroutine,subroutinename);
+  Save_Length(subroutinename,18);
+  newinclude->suiv = NULL;
+
+  if ( !List_Include)
+  {
+     List_Include  = newinclude ;
+  }
+  else
+  {
+    newinclude->suiv = List_Include;
+    List_Include = newinclude;
+  }
+  }
+}
+
+/******************************************************************************/
+/*                     Add_ImplicitNoneSubroutine_1                           */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_ImplicitNoneSubroutine_1()
+{
+
+  if ( firstpass == 1 )
+  {
+     List_ImplicitNoneSubroutine = Addtolistname(subroutinename,
+                                                   List_ImplicitNoneSubroutine);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WriteIncludeDeclaration                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteIncludeDeclaration()
+{
+  listusemodule *newinclude;
+
+  newinclude = List_Include;
+  fprintf(fortranout,"\n");
+  while ( newinclude )
+  {
+     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
+     {
+        fprintf(fortranout,"      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 (char *name,listdim *d)
+{
+  listvar *newvar;
+  listdim *dims;
+  char ligne[LONG_C];
+  char listdimension[LONG_C];
+
+  if ( firstpass == 1 )
+  {
+     newvar=(listvar *)malloc(sizeof(listvar));
+     newvar->var=(variable *)malloc(sizeof(variable));
+     /*                                                                       */
+     Init_Variable(newvar->var);
+     /*                                                                       */
+     newvar->var->v_save=1;
+     strcpy(newvar->var->v_nomvar,name);
+     Save_Length(name,4);
+     strcpy(newvar->var->v_modulename,curmodulename);
+     Save_Length(curmodulename,6);
+     strcpy(newvar->var->v_subroutinename,subroutinename);
+     Save_Length(subroutinename,11);
+     strcpy(newvar->var->v_commoninfile,mainfile);
+     Save_Length(mainfile,10);
+
+     newvar->var->v_dimension=d;
+     /* Creation of the string for the dimension of this variable             */
+     dimsempty = 1;
+
+     if ( d )
+     {
+        newvar->var->v_dimensiongiven=1;
+        dims = d;
+        while (dims)
+        {
+           if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                                                                  dimsempty = 0;
+           sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+           strcat(listdimension,ligne);
+           if ( dims->suiv )
+           {
+              strcat(listdimension,",");
+           }
+           dims = dims->suiv;
+        }
+        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1;
+     }
+
+/*     strcpy(newvar->var->v_readedlistdimension,listdimension);
+     Save_Length(listdimension,15);*/
+     /*                                                                       */
+     newvar->suiv = NULL;
+
+     if ( !List_Save_Var )
+     {
+        List_Save_Var  = newvar ;
+     }
+     else
+     {
+        newvar->suiv = List_Save_Var;
+        List_Save_Var = newvar;
+     }
+  }
+}
+
+void Add_Save_Var_dcl_1 (listvar *var)
+{
+  listvar *newvar;
+  listvar *parcours;
+
+  if ( firstpass == 1 )
+  {
+     parcours = var;
+     while ( parcours )
+     {
+        newvar=(listvar *)malloc(sizeof(listvar));
+        newvar->var=(variable *)malloc(sizeof(variable));
+        /*                                                                    */
+        Init_Variable(newvar->var);
+        /*                                                                    */
+        newvar->var->v_save=1;
+        strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        Save_Length(curmodulename,6);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        Save_Length(subroutinename,11);
+        strcpy(newvar->var->v_commoninfile,mainfile);
+        Save_Length(mainfile,10);
+        /*                                                                    */
+        strcpy(newvar->var->v_readedlistdimension,
+             parcours->var->v_readedlistdimension);
+        newvar->var->v_nbdim = parcours->var->v_nbdim;
+        newvar->var->v_dimension = parcours->var->v_dimension;
+        /*                                                                    */
+        newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
+        /*                                                                    */
+        newvar->suiv = NULL;
+
+        if ( !List_Save_Var ) List_Save_Var  = newvar ;
+        else
+        {
+           newvar->suiv = List_Save_Var;
+           List_Save_Var = newvar;
+        }
+        parcours = parcours->suiv;
+     }
+  }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile	(revision 3437)
@@ -0,0 +1,50 @@
+#- option to debug
+C_D = -g # -g -Wall
+# Compilation:
+CC		= cc -O
+#-
+OBJS = main.o WriteInFile.o toamr.o fortran.o  \
+       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
+       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 CONV is ok
+
+conv :  $(OBJS)
+	@$(CC) $(OBJS) -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 : 
+	/bin/rm -f *.o y.output
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex	(revision 3437)
@@ -0,0 +1,77 @@
+# Compilation:
+CC		= cc -O -g -Wall
+LEX		= flex
+
+# option de flex et pas de lex
+LEXFLAGS=-i
+YACC = byacc -t -v -g
+YACC = bison -t -v -g
+YACC = bison 
+
+
+OBJS = main.o WriteInFile.o toamr.o fortran.o  \
+       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
+       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
+       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
+       UtilNotGridDep.o WorkWithlistdatavariable.o \
+       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
+       UtilCharacter.o UtilListe.o UtilFile.o \
+       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
+       WorkWithlistofcoupled.o
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+all : conv
+
+conv :  $(OBJS)
+	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
+
+main.o : main.c
+main.c : convert.tab.c  convert.yy.c
+	rm -f main.c
+	cat convert.tab.c  convert.yy.c > main.c
+	rm -f convert.yy.c convert.tab.c
+fortran.o : fortran.c
+fortran.c : fortran.tab.c fortran.yy.c
+	rm -f fortran.c
+	cat fortran.tab.c  fortran.yy.c > fortran.c
+#rm -f fortran.yy.c fortran.tab.c
+convert.tab.c : convert.y decl.h
+	$(YACC) convert.y
+#	mv -f y.tab.c convert.tab.c
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran fortran.y
+#	mv -f y.tab.c fortran.tab.c
+#	mv -f y.output fortran.output
+#	mv -f y.dot fortran.dot
+convert.yy.c : convert.lex
+	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
+fortran.yy.c : fortran.lex
+	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
+	
+toamr.o : toamr.c decl.h
+WriteInFile.o : WriteInFile.c decl.h
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
+WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
+UtilCharacter.o : UtilCharacter.c decl.h
+UtilListe.o : UtilListe.c decl.h
+UtilFile.o : UtilFile.c decl.h
+WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
+WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
+WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
+clean : 
+	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
+	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
+	y.output
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex.byacc	(revision 3437)
@@ -0,0 +1,76 @@
+# Compilation:
+CC		= cc -O -g -Wall
+LEX		= flex
+
+# option de flex et pas de lex
+LEXFLAGS=-i
+YACC = byacc -t -v -g
+YACC = bison -t -v -g
+
+
+OBJS = main.o WriteInFile.o toamr.o fortran.o  \
+       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
+       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
+       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
+       UtilNotGridDep.o WorkWithlistdatavariable.o \
+       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
+       UtilCharacter.o UtilListe.o UtilFile.o \
+       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
+       WorkWithlistofcoupled.o
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+all : conv
+
+conv :  $(OBJS)
+	$(CC) $(OBJS)  $(LEXLIB) -o ../$@
+
+main.o : main.c
+main.c : convert.tab.c  convert.yy.c
+	rm -f main.c
+	cat convert.tab.c  convert.yy.c > main.c
+	rm -f convert.yy.c convert.tab.c
+fortran.o : fortran.c
+fortran.c : fortran.tab.c fortran.yy.c
+	rm -f fortran.c
+	cat fortran.tab.c  fortran.yy.c > fortran.c
+#rm -f fortran.yy.c fortran.tab.c
+convert.tab.c : convert.y decl.h
+	$(YACC) convert.y
+	mv -f y.tab.c convert.tab.c
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran fortran.y
+	mv -f y.tab.c fortran.tab.c
+	mv -f y.output fortran.output
+	mv -f y.dot fortran.dot
+convert.yy.c : convert.lex
+	$(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex
+fortran.yy.c : fortran.lex
+	$(LEX) $(LEXFLAGS) -Pfortran -ofortran.yy.c fortran.lex
+	
+toamr.o : toamr.c decl.h
+WriteInFile.o : WriteInFile.c decl.h
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
+WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
+UtilCharacter.o : UtilCharacter.c decl.h
+UtilListe.o : UtilListe.c decl.h
+UtilFile.o : UtilFile.c decl.h
+WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
+WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
+WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
+clean : 
+	/bin/rm -f *.o y.tab.c main.c lex.yy.c fortran.c \
+	fortran.tab.c fortran.yy.c convert.tab.c convert.yy.c \
+	y.output
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c	(revision 3437)
@@ -0,0 +1,492 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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             */
+/******************************************************************************/
+
+
+/******************************************************************************/
+/*                             writeheadnewsub_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write the head of the subroutine sub_loop_<subroutinename>       */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void writeheadnewsub_0()
+{
+   char ligne[LONG_C];
+
+   if ( firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
+   {
+      if ( todebug == 1 ) printf("Enter in writeheadnewsub_0\n");
+      /* we should add the use agrif_uti l if it is necessary                 */
+      WriteHeadofSubroutineLoop();
+      WriteUsemoduleDeclaration(subroutinename);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
+                                                       "      IMPLICIT NONE\n");
+      WriteIncludeDeclaration();
+      /*                                                                      */
+      /* We should write once the declaration of tables (extract              */
+      /*    from pointer) in the new subroutine                               */
+      if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n");
+
+      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration();
+      if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n");
+
+      sprintf(ligne,"\n#include \"ParamFile%s.h\" \n",subroutinename);
+      tofich(fortranout,ligne,1);
+
+      WriteArgumentDeclaration_Sort();
+
+      if ( mark == 1 ) fprintf(fortranout,"!!! 222222222222222 \n");
+      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortranout);
+      if ( mark == 1 ) fprintf(fortranout,"!!! 333333333333333 \n");
+      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,paramout);
+      if ( mark == 1 ) fprintf(fortranout,"!!! 444444444444444 \n");
+      /* now we should write the function declaration                         */
+      /*    case if it is the                                                 */
+      WriteFunctionDeclaration(1);
+      if ( mark == 1 ) fprintf(fortranout,"!!! 555555555555555 \n");
+
+//      if ( SubInList_ContainsSubroutine() == 0 ) WriteSubroutineDeclaration(1);
+  
+      if ( mark == 1 ) fprintf(fortranout,"!!! 666666666666666 \n");
+      if ( todebug == 1 ) printf("Out of writeheadnewsub_0\n");
+   }
+   else if ( firstpass == 0 )
+   {
+      AddUseAgrifUtil_0(fortranout);
+      WriteUsemoduleDeclaration(subroutinename);
+      WriteIncludeDeclaration();
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
+                                                       "      IMPLICIT NONE\n");
+      if ( mark == 1 ) fprintf(fortranout,"!!! aaaaaaaaaaaaaaa \n");
+      WriteLocalParamDeclaration();
+      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n");
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1);
+      if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n");      
+      WriteArgumentDeclaration_beforecall();
+/*      writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout);
+      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortranout);*/
+      if ( mark == 1 ) fprintf(fortranout,"!!! ccccccccccccccc \n");
+      if ( mark == 1 ) fprintf(fortranout,"!!! ddddddddddddddd \n");
+//      WriteSubroutineDeclaration(1);
+      if ( mark == 1 ) fprintf(fortranout,"!!! eeeeeeeeeeeeeee \n");
+   }
+}
+
+
+/******************************************************************************/
+/*                    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(FILE *outputfile,char *ligne)
+{
+   listvar *parcours;
+   int compteur;
+
+   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop\n");
+   parcours = List_SubroutineArgument_Var;
+   didvariableadded = 0;
+   compteur = 0 ;
+
+   while ( parcours )
+   {
+
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subroutinename we should write the name of this variable          */
+      /*    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(FILE *outputfile,char *ligne)
+{
+   listvar *parcours;
+   char ligne2[10];
+   int i;
+   int compteur ;
+
+   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n");
+   parcours = List_UsedInSubroutine_Var;
+   compteur = 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)  &&
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
+         )
+      {
+         if ( didvariableadded == 1 )
+         {
+            strcat(ligne," , ");
+         }
+         strcat(ligne,vargridcurgridtabvars(parcours->var,0));
+         /* 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
+                {
+                   strcat(ligne," lbound( ");
+                   strcat(ligne,vargridcurgridtabvars(parcours->var,0));
+                   strcat(ligne,",");
+                   strcpy(ligne2,"");
+                   sprintf(ligne2,"%d",i);
+                   strcat(ligne,ligne2);
+                   if ( i != parcours->var->v_nbdim ) strcat(ligne,"),");
+                }
+                if ( i == parcours->var->v_nbdim ) strcat(ligne,"))");
+                i++;
+             }
+         }
+         didvariableadded = 1;
+         compteur = compteur +1 ;
+         /*if ( retour77 == 0 )
+         {
+            strcat(ligne," &");
+            fprintf(outputfile,"\n");
+         }
+         else fprintf(outputfile,"\n     & ");*/
+         /*tofich(outputfile,ligne,0);*/
+      }
+      parcours = parcours -> suiv;
+   }
+   
+//   Save_Length(ligne,41);
+//   tofich(outputfile,ligne,0);
+   /* Now we should replace the last ", &" by " &"                            */
+/*   if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
+   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
+   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Call\n");
+}
+
+
+/******************************************************************************/
+/*                       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(FILE *outputfile, char *ligne)
+{
+   listvar *parcours;
+/*   char ligne[LONG_40M];*/
+   int compteur;
+
+   if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n");
+   parcours = List_UsedInSubroutine_Var;
+   compteur = 0 ;
+   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;
+   }
+ /*  if ( compteur != 3 && compteur != 0 )
+   {
+      if ( retour77 == 0 ) fprintf(outputfile,"\n      %s &",ligne);
+      else fprintf(outputfile,"\n     & %s",ligne);
+   }*/
+   Save_Length(ligne,41);
+ //  tofich(outputfile,ligne,0);
+
+   /* Now we should replace the last ", &" by " &"                            */
+  /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR);
+   if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/
+   if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n");
+   
+}
+
+
+
+/******************************************************************************/
+/*                      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_40M];
+   FILE * subloop;
+
+   if ( todebug == 1 ) printf("Enter in WriteHeadofSubroutineLoop\n");
+   tofich(fortranout,"\n",1);
+   /* Open this newfile                                                       */
+   sprintf(ligne,"Sub_Loop_%s.h",subroutinename);
+   subloop = associate(ligne);
+   /*                                                                         */
+   if (isrecursive) 
+   {
+   sprintf(ligne,"      recursive subroutine Sub_Loop_%s(",subroutinename);
+   }
+   else
+   {
+   sprintf(ligne,"      subroutine Sub_Loop_%s(",subroutinename);
+   }
+   /*                                                                         */
+   WriteVariablelist_subloop(subloop,ligne);
+   WriteVariablelist_subloop_Def(subloop,ligne);
+   /*                                                                         */
+     strcat(ligne,")");
+   tofich(subloop,ligne,1);
+   /* if USE agrif_Uti l should be add                                        */
+   AddUseAgrifUtil_0(subloop);
+   /*                                                                         */
+   oldfortranout = fortranout;
+   fortranout = subloop;
+   if ( todebug == 1 ) printf("Out of WriteHeadofSubroutineLoop\n");
+}
+
+/******************************************************************************/
+/*                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[LONG_40M];
+
+   if ( firstpass == 0 )
+   {
+
+   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should remove the key word end subroutine                         */
+      RemoveWordCUR_0(fortranout,(long)(-(pos_cur-pos_endsubroutine)),
+                                          pos_cur-pos_endsubroutine);
+      /* We should close the loop subroutine                                  */
+      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
+      tofich(fortranout,ligne,1);
+      fclose(fortranout);
+      fortranout = oldfortranout;
+
+
+      AddUseAgrifUtilBeforeCall_0(fortranout);
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
+      WriteArgumentDeclaration_beforecall();
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+      /* Now we add the call af the new subroutine                            */
+      sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(fortranout,ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(fortranout,ligne);
+      /* Close the parenthesis of the new subroutine called                   */
+       strcat(ligne,")");
+      
+      tofich(fortranout,ligne,1);
+
+      /* We should close the original subroutine                              */
+      if ( suborfun == 3 ) sprintf(ligne,"\n      end program %s"
+                                                               ,subroutinename);
+      if ( suborfun == 2 ) sprintf(ligne,"\n      end");
+      if ( suborfun == 1 ) sprintf(ligne,"\n      end subroutine %s"
+                                                               ,subroutinename);
+      if ( suborfun == 0 ) sprintf(ligne,"\n      end function %s"
+                                                               ,subroutinename);
+      tofich(fortranout,ligne,1);
+      /* we should include the above file in the original code                */
+      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
+      tofich(fortranout,ligne,1);
+      }
+    oldfortranout = (FILE *)NULL;      
+   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
+   }
+   
+}
+
+
+
+
+void closeandcallsubloop_contains_0()
+{
+   char ligne[LONG_40M];
+
+   if ( firstpass == 0 )
+   {
+   if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n");
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      Remove_Word_Contains_0();
+      sprintf(ligne,"\n      end subroutine Sub_Loop_%s",subroutinename);
+      tofich(fortranout,ligne,1);
+      fclose(fortranout);
+      fortranout = oldfortranout;
+
+      AddUseAgrifUtilBeforeCall_0(fortranout);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout,
+                                                       "      IMPLICIT NONE\n");
+      WriteLocalParamDeclaration();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(0);
+      WriteArgumentDeclaration_beforecall();
+      WriteSubroutineDeclaration(0);
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+                     fprintf(oldfortranout,"      Call Agrif_Init_Grids () \n");
+      /* Now we add the call af the new subroutine                            */
+      if ( retour77 == 0 ) sprintf(ligne,"\n      Call Sub_Loop_%s( &"
+                                                               ,subroutinename);
+      else sprintf(ligne,"\n      Call Sub_Loop_%s( ",subroutinename);
+      fprintf(fortranout,ligne);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(fortranout,ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(fortranout,ligne);
+      /* Close the parenthesis of the new subroutine called                   */
+      sprintf(ligne,")");
+      tofich(fortranout,ligne,1);
+      /* We should close the original subroutine                              */
+      sprintf(ligne,"\n      contains");
+      tofich(fortranout,ligne,1);
+      /* we should include the above file in the original code                */
+      sprintf(ligne,"\n#include \"Sub_Loop_%s.h\" \n",subroutinename);
+      tofich(fortranout,ligne,1);
+      }
+   oldfortranout = (FILE *)NULL;
+   if ( todebug == 1 ) printf("Out of closeandcallsubloopandincludeit_0\n");
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c	(revision 3437)
@@ -0,0 +1,996 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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(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;
+
+   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(char *tokname)
+{
+   int agrifintheword;
+
+   if ( strncasecmp(tokname,"Agrif_",6) == 0 )  agrifintheword = 1;
+   else agrifintheword = 0;
+
+   return agrifintheword;
+}
+
+/******************************************************************************/
+/*                     ModifyTheVariableName_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheVariableName_0(char *ident, int lengthname)
+{
+   listvar *newvar;
+   int out;
+   
+   printf("ICI ident = %s\n",ident);
+   
+   if ( firstpass == 0 )
+   {
+      newvar = List_Global_Var;
+      out=0;
+      while ( newvar && out == 0 )
+      {
+         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+         else newvar=newvar->suiv;
+      }
+       printf("out1 = %d\n",out);
+      if ( out == 0 )
+      {
+         newvar = List_ModuleUsed_Var;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+      if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return;
+
+      if ( out == 0 )
+      {
+         newvar = List_Common_Var;
+         while ( newvar && out == 0 )
+         {
+            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"))
+      {
+      printf("ICIC3\n");
+         /* remove the variable                                               */
+         RemoveWordCUR_0(fortranout,(long)(-lengthname),
+                               lengthname);
+         fseek(fortranout,(long)(-lengthname),SEEK_CUR);
+         /* then write the new name                                           */
+         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
+         else
+         {
+            if ( retour77 == 0 )
+            {
+               fprintf(fortranout," Agrif_tabvars & \n      ");
+            }
+            else
+            {
+               fprintf(fortranout,"Agrif_tabvars");
+               fprintf(fortranout," \n     & ");
+            }
+            fprintf(fortranout,"%s",
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+         }
+      }
+      else
+      {
+         /* we should look in the List_ModuleUsed_Var                         */
+         if ( inagrifcallargument != 1 )
+         {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+               if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+               else newvar=newvar->suiv;
+            }
+            if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+            {
+            printf("ICICIC4 %s\n",newvar->var->v_typevar);
+               /* remove the variable                                         */
+               RemoveWordCUR_0(fortranout,(long)(-lengthname),
+                                     lengthname);
+               fseek(fortranout,(long)(-lengthname),SEEK_CUR);
+               /* then write the new name                                     */
+               if ( retour77 == 0 )
+               {
+                  fprintf(fortranout," Agrif_tabvars & \n      ");
+               }
+               else
+               {
+                  fprintf(fortranout," \n     & Agrif_tabvars");
+               }
+               fprintf(fortranout,"%s",
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+               colnum = strlen(
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            }
+         }
+      }
+   }
+}
+
+/******************************************************************************/
+/*                     ModifyTheVariableName_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident)
+{
+   listvar *newvar;
+   int out;
+   
+   if ( firstpass == 0 )
+   {
+      newvar = List_Global_Var;
+      out=0;
+      while ( newvar && out == 0 )
+      {
+         if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
+         else newvar=newvar->suiv;
+      }
+
+      if ( out == 0 )
+      {
+         newvar = List_ModuleUsed_Var;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+      if ( out == 0 )
+      {
+         newvar = List_Common_Var;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+
+      if ( out == 0 )
+      {
+         newvar = List_ModuleUsedInModuleUsed_Var;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+
+      if ( out == 1 )
+      {
+         /* remove the variable                                               */
+         RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
+                               strlen(ident));
+         fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
+         /* then write the new name                                           */
+         if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortranout,"%d",newvar->var->v_indicetabvars);
+         else
+         {
+            if ( retour77 == 0 )
+            {
+               fprintf(fortranout," Agrif_tabvars & \n      ");
+            }
+            else
+            {
+               fprintf(fortranout,"Agrif_tabvars");
+               fprintf(fortranout," \n     & ");
+            }
+            fprintf(fortranout,"%s",
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            colnum = strlen(vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+         }
+      }
+      else
+      {
+         /* we should look in the List_ModuleUsed_Var                         */
+         if ( inagrifcallargument != 1 )
+         {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+               if ( !strcasecmp(newvar->var->v_nomvar,coupledident) ) out = 1;
+               else newvar=newvar->suiv;
+            }
+            if ( out == 1 )
+            {
+               /* remove the variable                                         */
+               RemoveWordCUR_0(fortranout,(long)(-strlen(ident)),
+                                     strlen(ident));
+               fseek(fortranout,(long)(-strlen(ident)),SEEK_CUR);
+               /* then write the new name                                     */
+               if ( retour77 == 0 )
+               {
+                  fprintf(fortranout," Agrif_tabvars & \n      ");
+               }
+               else
+               {
+                  fprintf(fortranout," \n     & Agrif_tabvars");
+               }
+               fprintf(fortranout,"%s",
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+               colnum = strlen(
+                             vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            }
+         }
+      }
+   }
+}
+
+
+
+/******************************************************************************/
+/*                         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(char *sub,char *mod)
+{
+  listnom *listnomtmp;
+  listnom *parcours;
+
+  if ( firstpass == 1 )
+  {
+  if ( !List_SubroutineWhereAgrifUsed )
+  {
+     listnomtmp=(listnom *)malloc(sizeof(listnom));
+     strcpy(listnomtmp->o_nom,sub);
+     Save_Length(sub,23);
+     strcpy(listnomtmp->o_module,mod);
+     Save_Length(mod,24);
+     listnomtmp->suiv = NULL;
+     List_SubroutineWhereAgrifUsed  =  listnomtmp;
+  }
+  else
+  {
+    parcours = List_SubroutineWhereAgrifUsed;
+    while ( parcours && strcasecmp(parcours->o_nom,sub) )
+    {
+       parcours = parcours->suiv;
+    }
+    if ( !parcours )
+    {
+       listnomtmp=(listnom *)malloc(sizeof(listnom));
+       strcpy(listnomtmp->o_nom,sub);
+       Save_Length(sub,23);
+       strcpy(listnomtmp->o_module,mod);
+       Save_Length(mod,24);
+       listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
+       List_SubroutineWhereAgrifUsed  =  listnomtmp;
+    }
+  }
+  }
+}
+
+/******************************************************************************/
+/*                                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");
+  }
+}
+
+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(char *ident)
+{
+   if ( firstpass == 0 )
+   {
+      if ( !strcasecmp(ident,"Agrif_parent") )
+      {
+         InAgrifParentDef = 1;
+         pos_curagrifparent = setposcur()-12;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
+      {
+         InAgrifParentDef = 2;
+         pos_curagrifparent = setposcur()-21;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Rhox") )
+      {
+         InAgrifParentDef = 3;
+         pos_curagrifparent = setposcur()-10;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
+      {
+         InAgrifParentDef = 4;
+         pos_curagrifparent = setposcur()-17;
+      }
+      else if ( !strcasecmp(ident,"Agrif_IRhox") )
+      {
+         InAgrifParentDef = 5;
+         pos_curagrifparent = setposcur()-11;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
+      {
+         InAgrifParentDef = 6;
+         pos_curagrifparent = setposcur()-18;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Rhoy") )
+      {
+         InAgrifParentDef = 7;
+         pos_curagrifparent = setposcur()-10;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
+      {
+         InAgrifParentDef = 8;
+         pos_curagrifparent = setposcur()-17;
+      }
+      else if ( !strcasecmp(ident,"Agrif_IRhoy") )
+      {
+         InAgrifParentDef = 9;
+         pos_curagrifparent = setposcur()-11;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
+      {
+         InAgrifParentDef = 10;
+         pos_curagrifparent = setposcur()-18;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Rhoz") )
+      {
+         InAgrifParentDef = 11;
+         pos_curagrifparent = setposcur()-10;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
+      {
+         InAgrifParentDef = 12;
+         pos_curagrifparent = setposcur()-17;
+      }
+      else if ( !strcasecmp(ident,"Agrif_IRhoz") )
+      {
+         InAgrifParentDef = 13;
+         pos_curagrifparent = setposcur()-11;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
+      {
+         InAgrifParentDef = 14;
+         pos_curagrifparent = setposcur()-18;
+      }
+      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
+      {
+         InAgrifParentDef = 15;
+         pos_curagrifparent = setposcur()-23;
+      }
+      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
+      {
+         InAgrifParentDef = 16;
+         pos_curagrifparent = setposcur()-23;
+      }
+      else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
+      {
+         InAgrifParentDef = 17;
+         pos_curagrifparent = setposcur()-23;
+      }
+      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
+      {
+         InAgrifParentDef = 18;
+         pos_curagrifparent = setposcur()-26;
+      }
+      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
+      {
+         InAgrifParentDef = 19;
+         pos_curagrifparent = setposcur()-26;
+      }
+      else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
+      {
+         InAgrifParentDef = 20;
+         pos_curagrifparent = setposcur()-26;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
+      {
+         InAgrifParentDef = 21;
+         pos_curagrifparent = setposcur()-19;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
+      {
+         InAgrifParentDef = 22;
+         pos_curagrifparent = setposcur()-17;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
+      {
+         InAgrifParentDef = 23;
+         pos_curagrifparent = setposcur()-15;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
+      {
+         InAgrifParentDef = 24;
+         pos_curagrifparent = setposcur()-15;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
+      {
+         InAgrifParentDef = 25;
+         pos_curagrifparent = setposcur()-15;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Iz") )
+      {
+         InAgrifParentDef = 26;
+         pos_curagrifparent = setposcur()-8;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Iy") )
+      {
+         InAgrifParentDef = 27;
+         pos_curagrifparent = setposcur()-8;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Ix") )
+      {
+         InAgrifParentDef = 28;
+         pos_curagrifparent = setposcur()-8;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
+      {
+         InAgrifParentDef = 29;
+         pos_curagrifparent = setposcur()-20;
+      }
+      else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
+      {
+         InAgrifParentDef = 29;
+         pos_curagrifparent = setposcur()-19;
+      }
+      else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
+      {
+         InAgrifParentDef = 30;
+         pos_curagrifparent = setposcur()-13;
+      }
+   }
+}
+
+/******************************************************************************/
+/*                       ModifyTheAgrifFunction_0                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheAgrifFunction_0(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(char *ident,int whichone)
+{
+   char toprint[LONG_C];
+   if ( firstpass == 0 )
+   {
+      strcpy(toprint,"");
+      pos_end = setposcur();
+      fseek(fortranout,pos_curagrifparent,SEEK_SET);
+      if ( whichone == 1 || whichone == 2 )
+      {
+         /*                                                                   */
+         FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
+         if ( !strcasecmp(ident,toprint) )
+         {
+            /* la liste des use de cette subroutine                           */
+            strcpy(toprint,"");
+            FindAndChangeNameToTabvars(ident,
+                                          toprint,List_Common_Var,whichone);
+         }
+         if ( !strcasecmp(ident,toprint) )
+         {
+            /* la liste des use de cette subroutine                           */
+            strcpy(toprint,"");
+            FindAndChangeNameToTabvars(ident,
+                                          toprint,List_ModuleUsed_Var,whichone);
+         }
+      }
+      else if ( whichone == 3 ) /* Agrif_Rhox                                 */
+      {
+         sprintf(toprint,"REAL(");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"Agrif_Curgrid % spaceref(1))");
+      }
+      else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
+      {
+         sprintf(toprint,"REAL(");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
+      }
+      else if ( whichone == 5 ) /* Agrif_Rhox                                 */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% spaceref(1)");
+      }
+      else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % spaceref(1)");
+      }
+      else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
+      {
+         sprintf(toprint,"REAL(Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% spaceref(2))");
+      }
+      else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
+      {
+         sprintf(toprint,"REAL(Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % spaceref(2))");
+      }
+      else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% spaceref(2)");
+      }
+      else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % spaceref(2)");
+      }
+      else if ( whichone == 11 ) /* Agrif_Rhoz                                */
+      {
+         sprintf(toprint,"REAL(Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% spaceref(3))");
+      }
+      else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
+      {
+         sprintf(toprint,"REAL(Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % spaceref(3))");
+      }
+      else if ( whichone == 13 ) /* Agrif_Rhoz                                */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% spaceref(3)");
+      }
+      else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % spaceref(3)");
+      }
+      else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% NearRootBorder(1)");
+      }
+      else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% NearRootBorder(2)");
+      }
+      else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% NearRootBorder(3)");
+      }
+      else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% DistantRootBorder(1)");
+      }
+      else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% DistantRootBorder(2)");
+      }
+      else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% DistantRootBorder(3)");
+      }
+      else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % grid_id");
+      }
+      else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% grid_id");
+      }
+      else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % ix(3)");
+      }
+      else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % ix(2)");
+      }
+      else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% parent % ix(1)");
+      }
+      else if ( whichone == 26 ) /* Agrif_Iz                                  */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint," % ix(3)");
+      }
+      else if ( whichone == 27 ) /* Agrif_Iy                                  */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% ix(2)");
+      }
+      else if ( whichone == 28 ) /* Agrif_Ix                                  */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% ix(1)");
+      }
+      else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
+      {
+         sprintf(toprint,"Agrif_nbfixedgrids");
+      }
+      else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
+      {
+         sprintf(toprint,"Agrif_Curgrid");
+         if( retour77 == 0 ) strcat(toprint," & \n");
+         else strcat(toprint,"\n     & ");
+         strcat(toprint,"% ngridstep");
+      }
+      /*                                                                      */
+      if ( whichone == 1 || whichone == 2 )
+      {
+         Save_Length(toprint,43);
+         tofich(fortranout,toprint,2);
+      }
+      else
+      {
+/*         if( retour77 == 0 ) fprintf(fortranout," & \n");
+         else fprintf(fortranout,"\n     & ");*/
+         Save_Length(toprint,43);
+         fprintf(fortranout,"%s",toprint);
+      }
+   }
+}
+
+
+/******************************************************************************/
+/*                             Instanciation_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void Instanciation_0(char *ident)
+{
+   listvar *newvar;
+   int out;
+
+   if ( firstpass == 0 && sameagrifargument == 1 )
+   {
+      newvar = List_Global_Var;
+
+      out=0;
+      while ( newvar && out == 0 )
+      {
+         if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+         else newvar=newvar->suiv;
+      }
+
+      if ( out == 0 )
+      {
+         newvar = List_Common_Var;
+
+         out=0;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+      if ( out == 0 )
+      {
+         newvar = List_ModuleUsed_Var;
+
+         out=0;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar=newvar->suiv;
+         }
+      }
+
+      if ( out == 1 )
+      {
+         /* then write the instanciation                                      */
+         fprintf(fortranout,"\n      %s = %s",ident,
+                                          vargridcurgridtabvars(newvar->var,3));
+         colnum = 0;
+      }
+   }
+   sameagrifargument = 0;
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c	(revision 3437)
@@ -0,0 +1,447 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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) % var % array2                     */
+/*                                                                            */
+/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % var % array2         */
+/*                                                                            */
+/******************************************************************************/
+void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+                                              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                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
+                                                                   int whichone)
+{
+   char toprinttmp[LONG_4C];
+   int i;
+   char chartmp[2];
+
+   i=0;
+   strcpy(toprintglob,"");
+   strcpy(toprinttmp,"");
+
+   /*                                                                         */
+   while ( i < strlen(nom) )
+   {
+      if ( nom[i] == '+' )
+      {
+        FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,"+");
+      }
+      else if ( nom[i] == '-' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,"-");
+      }
+      else if ( nom[i] == '*' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,"*");
+      }
+      else if ( nom[i] == '/' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,"/");
+      }
+      else if ( nom[i] == '(' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,"(");
+      }
+      else if ( nom[i] == ')' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,")");
+      }
+      else if ( nom[i] == ':' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,":");
+      }
+      else if ( nom[i] == ',' )
+      {
+         FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+         strcpy(toprinttmp,"");
+         strcat(toprintglob,",");
+      }
+      else
+      {
+         sprintf(chartmp,"%c",nom[i]);
+         strcat(toprinttmp,chartmp);
+      }
+      /*                                                                      */
+      i=i+1;
+   }
+   FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,whichone);
+   strcpy(toprinttmp,"");
+
+   Save_Length(toprinttmp,44);
+   Save_Length(toprintglob,39);
+
+   /*                                                                         */
+   return toprintglob;
+}
+
+/******************************************************************************/
+/*                            IsVariableReal                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int IsVariableReal(char *nom)
+{
+   int Real;
+
+   Real = 0;
+   if ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
+        ( nom[0] >= 'A' && nom[0] <= 'H' ) ||
+        ( nom[0] >= 'o' && nom[0] <= 'z' ) ||
+        ( nom[0] >= 'O' && nom[0] <= 'Z' )
+       )
+       {
+          Real = 1;
+       }
+   /*                                                                         */
+   return Real;
+}
+/******************************************************************************/
+/*                         IsVarInUseFile                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void IsVarInUseFile(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(char *nom, listnom * listout)
+{
+   char toprinttmp[LONG_4C];
+   int i;
+   char chartmp[2];
+
+   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);
+   }
+   strcpy(toprinttmp,"");
+   Save_Length(toprinttmp,44);
+
+   return listout;
+}
+
+
+/******************************************************************************/
+/*                      DecomposeTheName                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void DecomposeTheName(char *nom)
+{
+   char toprinttmp[LONG_4C];
+   int i;
+   char chartmp[2];
+
+   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;
+   }
+   Save_Length(toprinttmp,44);
+   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+   {
+      ajoutevarindoloop_definedimension (toprinttmp);
+      /* Is this variable present in globvarofusefile                         */
+      IsVarInUseFile(toprinttmp);
+   }
+   strcpy(toprinttmp,"");
+
+}
+
+void convert2lower(char *name)
+{
+   int l;
+   int i;
+   int caractere;
+
+   l=strlen(name)-1;
+   for (i=0;i<=l;i++)
+   {
+      caractere=name[i];
+      if ((caractere>=65 && caractere<=90)||(caractere>=192 && caractere<=221))
+      {
+         name[i]+=32;
+      }
+   }
+}
+
+int convert2int(char *name)
+{
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFile.c	(revision 3437)
@@ -0,0 +1,146 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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"
+
+
+/******************************************************************************/
+/*                            associate                                       */
+/******************************************************************************/
+/* This subroutine is used to open a file                                     */
+/******************************************************************************/
+FILE * associate (char *filename)
+{
+  char filefich[LONG_C];
+  sprintf(filefich,"%s/%s",nomdir,filename);
+  return fopen (filefich, "w");
+}
+
+
+/******************************************************************************/
+/*                          associateaplus                                    */
+/******************************************************************************/
+/* This subroutine is used to open a file with option a+                      */
+/******************************************************************************/
+FILE * associateaplus (char *filename)
+{
+  char filefich[LONG_C];
+  sprintf(filefich,"%s/%s",nomdir,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()
+{
+   fflush(fortranout);
+   return ftell(fortranout);
+}
+
+/******************************************************************************/
+/*                      setposcurinoldfortranout                              */
+/******************************************************************************/
+/* This subroutine is used to know the position in the oldfortranout         */
+/******************************************************************************/
+/*                                                                            */
+/*             setposcurinoldfortranout ---------> position in file           */
+/*                                                                            */
+/******************************************************************************/
+long int setposcurinoldfortranout()
+{
+   fflush(oldfortranout);
+   return ftell(oldfortranout);
+}
+
+/******************************************************************************/
+/*                         copyuse_0                                          */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortranout the USE tok_name                         */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuse_0(char *namemodule)
+{
+   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should write this declaration into the original subroutine too    */
+      fprintf(oldfortranout,"      USE %s \n",namemodule);
+   }
+}
+
+/******************************************************************************/
+/*                         copyuseonly_0                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortranout the USE tok_name, only                   */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuseonly_0(char *namemodule)
+{
+   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should write this declaration into the original subroutine too    */
+      fprintf(oldfortranout,"      USE %s , ONLY : \n",namemodule);
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c	(revision 3437)
@@ -0,0 +1,801 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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, char * nx, char * ny,char* nz)
+{
+  dimprob = dimprobmod;
+
+  strcpy(nbmaillesX,nx);
+  strcpy(nbmaillesY,ny);
+  strcpy(nbmaillesZ,nz);
+}
+
+/******************************************************************************/
+/*                      Variableshouldberemove                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+int Variableshouldberemove(char *nom)
+{
+
+   int remove;
+
+   remove = 0 ;
+
+   if ( remove == 0 && Agrif_in_Tok_NAME(nom) == 1 ) remove = 1 ;
+
+   return remove;
+}
+
+/******************************************************************************/
+/*                          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                                    */
+        printf("QDKFLSDFKSLDF\n");
+        strcpy(curvar->var->v_typevar,newvar->var->v_typevar);
+        strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar);
+        curvar->var->v_nbdim = newvar->var->v_nbdim;
+        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_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);
+        CopyRecord(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) )
+     {
+        CopyRecord(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, char *module, FILE *fileout, long int oldposcuruse)
+{
+  int Globalite;
+  listcouple *newvar;
+  listcouple *newvarprec;
+  listvar *tempo;
+  listvar *newvar2;
+  int out;
+  char truename[LONG_C];  
+
+  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 Remove_Word_Contains_0()
+{
+   if ( firstpass == 0 )
+   {
+      RemoveWordCUR_0(fortranout,(long)(-9),9);
+   }
+}
+
+void Remove_Word_end_module_0(int modulenamelength)
+{
+   if ( firstpass == 0 )
+   {
+      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12),
+                                         modulenamelength+11);
+   }
+}
+
+void Write_Word_Contains_0()
+{
+   if ( firstpass == 0 )
+   {
+      fprintf(fortranout,"\n      contains\n");
+   }
+}
+
+
+void Write_Word_end_module_0()
+{
+   if ( firstpass == 0 )
+   {
+      fprintf(fortranout,"\n      end module %s",curmodulename);
+   }
+}
+
+void Add_Subroutine_For_Alloc(char *nom)
+{
+   listnom *parcours;
+   listnom *newvar;
+   int out;
+
+   newvar = (listnom *)malloc(sizeof(listnom));
+   strcpy(newvar->o_nom,nom);
+   Save_Length(nom,23);
+   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_Alloc_Subroutine_0()
+{
+   listnom *parcours_nom;
+   listnom *parcours_nomprec;
+   int out;
+   char ligne[LONG_C];
+
+   if ( firstpass == 0 )
+   {
+      parcours_nomprec = (listnom *)NULL;
+      parcours_nom = List_NameOfModule;
+      out = 0 ;
+      while ( parcours_nom && out == 0 )
+      {
+         /*                                                                   */
+         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+         else parcours_nom = parcours_nom -> suiv;
+      }
+      if ( out == 1 )
+      {
+         if ( parcours_nom->o_val == 1 )
+         {
+            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
+            strcat (ligne, curmodulename);
+            strcat (ligne, "\n");
+            convert2lower(ligne);
+            fprintf(fortranout,ligne);
+         }
+      }
+      Write_Word_Contains_0();
+      if ( out == 1 )
+      {
+         if ( parcours_nom->o_val == 1 )
+         {
+            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
+                                                                 curmodulename);
+            tofich(fortranout,ligne,1);
+            strcpy(ligne,"Use Agrif_Util");
+            tofich(fortranout,ligne,1);
+            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
+            tofich(fortranout,ligne,1);
+            strcpy(ligne, "INTEGER :: i");
+            tofich (fortranout, ligne,1);
+            strcpy (ligne, "\n#include \"alloc_agrif_");
+            strcat (ligne, curmodulename);
+            strcat (ligne, ".h\"\n");
+            convert2lower(ligne);
+            fprintf(fortranout,ligne);
+            strcpy (ligne, "Return");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
+            tofich(fortranout,ligne,1);
+            /* List all Call Alloc_agrif_                                     */
+            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 == 1 )
+            {
+               if ( parcours_nom == List_Subroutine_For_Alloc)
+               {
+                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+               }
+               else
+               {
+                  parcours_nomprec->suiv = parcours_nom->suiv;
+                  parcours_nom = parcours_nomprec->suiv ;
+               }
+            }
+         }
+      }
+   }
+}
+
+
+void Write_Alloc_Subroutine_For_End_0()
+{
+   listnom *parcours_nom;
+   listnom *parcours_nomprec;
+   int out;
+   char ligne[LONG_C];
+
+   if ( firstpass == 0 )
+   {
+      parcours_nomprec = (listnom *)NULL;
+      parcours_nom = List_NameOfModule;
+      out = 0 ;
+      while ( parcours_nom && out == 0 )
+      {
+         /*                                                                   */
+         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+         else parcours_nom = parcours_nom -> suiv;
+      }
+      if ( out == 1 )
+      {
+         if ( parcours_nom->o_val == 1 )
+         {
+            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
+            strcat (ligne, curmodulename);
+            strcat (ligne, "\n");
+            convert2lower(ligne);
+            fprintf(fortranout,ligne);
+            strcpy (ligne, "\n      contains\n");
+            fprintf(fortranout,ligne);
+            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
+                                                                 curmodulename);
+            tofich(fortranout,ligne,1);
+            strcpy(ligne,"Use Agrif_Util");
+            tofich(fortranout,ligne,1);
+            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
+            tofich(fortranout,ligne,1);
+            strcpy(ligne, "INTEGER :: i");
+            tofich (fortranout, ligne,1);
+            strcpy (ligne, "\n#include \"alloc_agrif_");
+            strcat (ligne, curmodulename);
+            strcat (ligne, ".h\"\n");
+            convert2lower(ligne);
+            fprintf(fortranout,ligne);
+            strcpy (ligne, "Return");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
+            tofich(fortranout,ligne,1);
+            /* List all Call Alloc_agrif                                      */
+            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+         }
+         else
+         {
+            parcours_nom = List_Subroutine_For_Alloc;
+            out = 0;
+            while ( parcours_nom && out == 0 )
+            {
+               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
+               else
+               {
+                  parcours_nomprec = parcours_nom;
+                  parcours_nom = parcours_nom->suiv;
+               }
+            }
+            if ( out == 1 )
+            {
+               if ( parcours_nom == List_Subroutine_For_Alloc)
+               {
+                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+               }
+               else
+               {
+                  parcours_nomprec->suiv = parcours_nom->suiv;
+                  parcours_nom = parcours_nomprec->suiv ;
+               }
+            }
+         }
+      }
+   }
+}
+
+void Write_GlobalParameter_Declaration_0()
+{
+   listvar *parcours;
+
+   if ( firstpass == 0 )
+   {
+      parcours = List_GlobalParameter_Var;
+      while( parcours )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+         {
+            writevardeclaration(parcours,module_declar,0,1);
+         }
+         parcours = parcours -> suiv;
+      }
+   }
+}
+
+void Write_GlobalType_Declaration_0()
+{
+   listvar *parcours;
+   int out = 0;
+   int headtypewritten = 0;
+   char ligne[LONGNOM];
+   int changeval;
+
+   if ( firstpass == 0 )
+   {
+      parcours = List_Global_Var;
+      while( parcours )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+         {
+           if (!strcasecmp(parcours->var->v_typevar,"type"))
+           {
+            out = 1;
+            if (headtypewritten == 0)
+              {
+/*RB*/
+                sprintf (ligne, "Module_DeclarType_%s.h",curmodulename);
+                module_declar_type = associate(ligne);
+                sprintf (ligne, " ");
+                tofich (module_declar_type, ligne,1);
+                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename);
+                tofich(module_declar_type,ligne,1);
+                headtypewritten = 1;
+/*RBend*/
+              }
+            changeval = 0;
+            if (parcours->var->v_allocatable == 1)
+             {
+               changeval = 1;
+               parcours->var->v_allocatable = 0;
+               parcours->var->v_pointerdeclare = 1;
+             }
+/*RB*/
+            writevardeclaration(parcours,module_declar_type,0,0);
+/*RBend*/
+            if (changeval == 1)
+              {
+               parcours->var->v_allocatable = 1;
+               parcours->var->v_pointerdeclare = 0;
+              }
+            }
+         }
+         parcours = parcours -> suiv;
+      }
+      if (out == 1)
+        {
+/*RB*/
+                sprintf(ligne,"END TYPE Agrif_%s",curmodulename);
+                tofich(module_declar_type,ligne,1);
+                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 
+                tofich(module_declar_type,ligne,1);
+                sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename); 
+                tofich(module_declar_type,ligne,1);
+                sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename); 
+                tofich(module_declar_type,ligne,1);
+/*RBend*/
+        }
+   }
+}
+
+void Write_NotGridDepend_Declaration_0()
+{
+   listvar *parcours;
+
+   if ( firstpass == 0 )
+   {
+      parcours = List_NotGridDepend_Var;
+      while( parcours )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+         {
+            writevardeclaration(parcours,fortranout,0,1);
+         }
+         parcours = parcours -> suiv;
+      }
+   }
+}
+
+/******************************************************************************/
+/*                          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 *)malloc(sizeof(listname));
+         strcpy(newvar->n_name,nom);
+         Save_Length(nom,20);
+         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 *)malloc(sizeof(listname));
+              strcpy(newvar->n_name,nom);
+              Save_Length(nom,20);
+              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;
+}
+
+
+/******************************************************************************/
+/*                          VariableIsNotFunction                             */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int VariableIsNotFunction(char *ident)
+{
+   int out;
+   listvar *newvar;
+
+   out =0;
+
+   if ( !strcasecmp(ident,"size") ||
+        !strcasecmp(ident,"if")   ||
+        !strcasecmp(ident,"max")  ||
+        !strcasecmp(ident,"min")
+      )
+   {
+      newvar = List_SubroutineDeclaration_Var;
+      while ( newvar && out == 0 )
+      {
+         if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
+              !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+         newvar = newvar -> suiv ;
+      }
+      if ( out == 1 ) out = 0;
+      else out = 1;
+      /* if it has not been found                                             */
+      if ( out == 1 )
+      {
+         out = 0;
+         newvar = List_Global_Var;
+         while ( newvar && out == 0 )
+         {
+            if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+            newvar = newvar -> suiv ;
+         }
+         if ( out == 1 ) out = 0;
+         else out = 1;
+      }
+   }
+   /*                                                                         */
+   return out;
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c	(revision 3437)
@@ -0,0 +1,691 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_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(char *type,variable *curvar)
+{
+   if (!strcasecmp(type,"character") && strcasecmp(CharacterSize,"") )
+   {
+      strcpy(curvar->v_dimchar,CharacterSize);
+      Save_Length(CharacterSize,5);
+   }
+
+  /* On donne la precision de la variable si elle a ete donnee                */
+  curvar->v_c_star = 0;
+  if ( c_star == 1 ) curvar->v_c_star = 1;
+  /*                                                                          */
+  strcpy(curvar->v_vallengspec,"");
+  if ( strcasecmp(vallengspec,"") )
+  {
+     strcpy(curvar->v_vallengspec,vallengspec);
+     Save_Length(vallengspec,8);
+  }
+
+  strcpy(curvar->v_precision,"");
+  if ( strcasecmp(NamePrecision,"") )
+  {
+     strcpy(curvar->v_precision,NamePrecision);
+     Save_Length(NamePrecision,12);
+  }
+  /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
+  if ( inmoduledeclare == 1 || SaveDeclare == 1)
+  {
+      curvar->v_module = 1;
+   }
+   /* Puis on donne le nom du module dans curvar->v_modulename                */
+   strcpy(curvar->v_modulename,curmodulename);
+   Save_Length(curmodulename,6);
+   /* Si cette variable a ete initialisee                                     */
+/*RB*/
+   if ( ! strcmp(InitialValueGiven,"=")  ) 
+/*RBend*/
+   {
+      strcpy(curvar->v_initialvalue,InitValue);
+      Save_Length(InitValue,14);
+   }
+   /* Si cette variable est declaree en save                                  */
+/*RB*/
+   if (SaveDeclare == 1 &&  !strcasecmp(curvar->v_typevar,"type")) {
+/*RBend*/
+   curvar->v_save = 1;
+   }
+
+   /* Si cette variable est v_allocatable                                     */
+   if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
+   
+   /* Si cette variable est v_targer                                     */
+   if (Targetdeclare == 1 ) curvar->v_target=1;
+   /* if INTENT spec has been given                                           */
+   if ( strcasecmp(IntentSpec,"") )
+   {
+      strcpy(curvar->v_IntentSpec,IntentSpec);
+      Save_Length(IntentSpec,13);
+   }
+}
+
+
+/******************************************************************************/
+/*                        duplicatelistvar                                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void duplicatelistvar(listvar *orig)
+{
+   listvar *parcours;
+   listvar *tmplistvar;
+   listvar *tmplistvarprec;
+   listdim *tmplistdim;
+   variable *tmpvar;
+
+   tmplistvarprec = (listvar *)NULL;
+   parcours = orig;
+   while ( parcours )
+   {
+      tmplistvar = (listvar *)malloc(sizeof(listvar));
+      tmpvar = (variable *)malloc(sizeof(variable));
+      /*                                                                      */
+      Init_Variable(tmpvar);
+      /*                                                                      */
+      strcpy(tmpvar->v_typevar,parcours->var->v_typevar);
+      strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar);
+      strcpy(tmpvar->v_oldname,parcours->var->v_oldname);
+      strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar);
+      if ( parcours->var->v_dimension )
+      {
+         tmplistdim = (listdim *)malloc(sizeof(listdim));
+         tmplistdim = parcours->var->v_dimension;
+         tmpvar->v_dimension = tmplistdim;
+      }
+      tmpvar->v_nbdim=parcours->var->v_nbdim;
+      tmpvar->v_common=parcours->var->v_common;
+      tmpvar->v_positioninblock=parcours->var->v_positioninblock;
+      tmpvar->v_module=parcours->var->v_module;
+      tmpvar->v_save=parcours->var->v_save;
+      tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter;
+      printf("QLKDF\n");
+      tmpvar->v_indicetabvars=parcours->var->v_indicetabvars;
+      strcpy(tmpvar->v_modulename,parcours->var->v_modulename);
+      strcpy(tmpvar->v_commonname,parcours->var->v_commonname);
+      strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec);
+
+      strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename);
+            
+      tmpvar->v_pointedvar=parcours->var->v_pointedvar;
+      strcpy(tmpvar->v_commoninfile,mainfile);
+      Save_Length(mainfile,10);
+      strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename);
+      tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven;
+      tmpvar->v_c_star=parcours->var->v_c_star;
+      strcpy(tmpvar->v_precision,parcours->var->v_precision);
+      strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue);
+      tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare;
+      tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare;
+      tmpvar->v_allocatable=parcours->var->v_allocatable;
+      tmpvar->v_target=parcours->var->v_target;
+      strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec);
+      tmpvar->v_dimsempty=parcours->var->v_dimsempty;
+      strcpy(tmpvar->v_readedlistdimension,
+                                          parcours->var->v_readedlistdimension);
+      /*                                                                      */
+      tmplistvar->var = tmpvar;
+      tmplistvar->suiv = NULL;
+      /*                                                                      */
+      if ( !listduplicated )
+      {
+         listduplicated = tmplistvar;
+         tmplistvarprec = listduplicated;
+      }
+      else
+      {
+         tmplistvarprec->suiv = tmplistvar;
+         tmplistvarprec = tmplistvar;
+      }
+      /*                                                                      */
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                           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 *) malloc (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);
+      Save_Length((lin->dim).last,5);
+      parcours_var=parcours_var->suiv;
+   }
+}
+
+
+/******************************************************************************/
+/*                                num_dims                                    */
+/******************************************************************************/
+/* This subroutine is used to know the dimension of a table                   */
+/******************************************************************************/
+/*                                                                            */
+/*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */
+/*                                                                            */
+/******************************************************************************/
+int num_dims(listdim *d)
+{
+   listdim *parcours;
+   int compteur = 0;
+
+   parcours = d;
+   while(parcours)
+   {
+     compteur++;
+     parcours=parcours->suiv;
+   }
+   return compteur;
+}
+
+
+/******************************************************************************/
+/*                          CREATEVAR                                         */
+/******************************************************************************/
+/* This subroutine is used to create and initialized a record of the          */
+/*      struct : variable                                                     */
+/******************************************************************************/
+variable * createvar(char *nom,listdim *d)
+{
+  variable *var;
+  listdim *dims;
+  char ligne[LONG_C];
+  char listdimension[LONG_C];
+
+   var=(variable *) malloc(sizeof(variable));
+   /*                                                                         */
+   Init_Variable(var);
+   /*                                                                         */
+   strcpy(var->v_nomvar,nom);
+   Save_Length(nom,4);
+   /*                                                                         */
+   strcpy(listdimension,"");
+   strcpy(var->v_modulename,curmodulename);
+   Save_Length(curmodulename,6);
+   strcpy(var->v_commoninfile,mainfile);
+   Save_Length(mainfile,10);
+   strcpy(var->v_subroutinename,subroutinename);
+   Save_Length(subroutinename,11);
+   /*                                                                         */
+   if ( strcasecmp(nameinttypename,"") )
+   {
+      strcpy(var->v_nameinttypename,nameinttypename);
+      Save_Length(nameinttypename,9);
+   }
+         
+   if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
+   if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
+   if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
+   if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
+   if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
+   if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
+   /*                                                                         */
+   var->v_dimension=d;
+
+   /* Creation of the string for the dimension of this variable               */
+   dimsempty = 1;
+   if ( d )
+   {
+      var->v_dimensiongiven=1;
+      dims = d;
+      while (dims)
+      {
+         if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                                                                  dimsempty = 0;
+         sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+         strcat(listdimension,ligne);
+         if ( dims->suiv )
+         {
+            strcat(listdimension,",");
+         }
+         dims = dims->suiv;
+      }
+/*RB*/
+      if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty=1;
+/*RBend*/
+   }
+   strcpy(var->v_readedlistdimension,listdimension);
+   Save_Length(listdimension,15);
+   /*                                                                         */
+   var->v_nbdim=num_dims(d);
+   /*                                                                         */
+   return var;
+}
+
+/******************************************************************************/
+/*                            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 *) malloc (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(char *nom,listvar *lin)
+{
+   listvar *newvar;
+   variable *v;
+
+   newvar=lin;
+   while (newvar)
+   {
+      v=newvar->var;
+      strcpy(v->v_typevar,nom);
+      Save_Length(nom,3);
+      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 *) malloc (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 *listemp;
+  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_40M];
+  char tempname[LONG_4M];
+  
+  if (lin)
+  {
+  sprintf(ligne,"public :: ");
+  parcours1 = lin;
+  
+  while (parcours1)
+  {
+    strcat(ligne,parcours1->n_name);
+    if (parcours1->suiv) strcat(ligne,", ");
+    parcours1 = parcours1->suiv;  
+  }
+  tofich(fortranout,ligne,1);
+  }
+
+}
+
+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;
+
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilNotGridDep.c	(revision 3437)
@@ -0,0 +1,110 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 *)malloc(sizeof(listvar));
+   newvar->var=(variable *)malloc(sizeof(variable));
+   strcpy(newvar->var->v_nomvar,name);
+   Save_Length(name,4);
+   strcpy(newvar->var->v_commoninfile,mainfile);
+   Save_Length(mainfile,10);
+   strcpy(newvar->var->v_subroutinename,subroutinename);
+   Save_Length(subroutinename,11);
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithAllocatelist.c	(revision 3437)
@@ -0,0 +1,152 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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(char *nom,char *nommodule)
+{
+   listallocate *newvar;
+   listallocate *parcours;
+   int out;
+
+   if ( firstpass == 1 )
+   {
+      if ( !List_Allocate_Var )
+      {
+         newvar = (listallocate *)malloc(sizeof(listallocate));
+         strcpy(newvar->a_nomvar,nom);
+         Save_Length(nom,25);
+         strcpy(newvar->a_subroutine,subroutinename);
+         Save_Length(subroutinename,26);
+         strcpy(newvar->a_module,nommodule);
+         Save_Length(nommodule,27);
+         newvar->suiv = NULL;
+         List_Allocate_Var = newvar;
+      }
+      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 *)malloc(sizeof(listallocate));
+              strcpy(newvar->a_nomvar,nom);
+              Save_Length(nom,25);
+              strcpy(newvar->a_subroutine,subroutinename);
+              Save_Length(subroutinename,26);
+              strcpy(newvar->a_module,nommodule);
+              Save_Length(nommodule,27);
+              newvar->suiv = NULL;
+              parcours->suiv = newvar;
+            }
+         }
+      }
+   }
+}
+
+
+/******************************************************************************/
+/*                            IsVarAllocatable_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int IsVarAllocatable_0(char *ident)
+{
+   listallocate *parcours;
+   int out;
+
+   out = 0 ;
+   if ( firstpass == 0 )
+   {
+      parcours = List_Allocate_Var;
+      while ( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
+         else parcours=parcours->suiv;
+      }
+   }
+   return out;
+}
+
+
+/******************************************************************************/
+/*                          varisallocatable_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varisallocatable_0(char *ident)
+{
+   listallocate *newvaralloc;
+   int out;
+
+   out =0;
+   if (firstpass == 0 )
+   {
+         newvaralloc = List_Allocate_Var;
+         while ( newvaralloc && out == 0 )
+         {
+            if ( !strcasecmp(ident,newvaralloc->a_nomvar) )  out = 1;
+            else newvaralloc = newvaralloc->suiv;
+         }
+   }
+   return out;
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c	(revision 3437)
@@ -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_GlobalParameter_Var_1                            */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_GlobalParameter_Var_1(listvar *listin)
+{
+   if ( firstpass == 1 )
+   {
+      if ( VariableIsParameter == 1 ) {
+      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 ( firstpass == 1 && VariableIsParameter == 1 )
+   {
+      if ( !List_Parameter_Var )
+      {
+         List_Parameter_Var = listin;
+      }
+      else
+      {
+         parcours = List_Parameter_Var;
+         while (parcours->suiv) parcours=parcours->suiv;
+         parcours->suiv = listin;
+      }
+   }
+}
+
+/******************************************************************************/
+/*                       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 ( firstpass == 1 )
+   {
+      if ( !List_Dimension_Var )
+      {
+         List_Dimension_Var = listin;
+      }
+      else
+      {
+         parcours = List_Dimension_Var;
+         while (parcours->suiv) parcours=parcours->suiv;
+         parcours->suiv = listin;
+      }
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithglobliste.c	(revision 3437)
@@ -0,0 +1,111 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 ( firstpass == 1 )
+   {
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 3437)
@@ -0,0 +1,143 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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_C];
+
+//  if ( firstpass == 1 )
+//  {
+     newvar=(listvar *)malloc(sizeof(listvar));
+     newvar->var=(variable *)malloc(sizeof(variable));
+     /*                                                                       */
+     Init_Variable(newvar->var);
+     /*                                                                       */
+     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     strcpy(newvar->var->v_nomvar,name);
+     Save_Length(name,4);
+     strcpy(newvar->var->v_subroutinename,subroutinename);
+     Save_Length(subroutinename,11);
+     strcpy(newvar->var->v_modulename,curmodulename);
+     Save_Length(curmodulename,6);
+     strcpy(newvar->var->v_commoninfile,mainfile);
+     Save_Length(mainfile,10);
+     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;  
+  char ligne[LONG_C];
+  
+  tmpvar1 = l1;
+  tmpvar2 = l2;
+  
+  while (tmpvar1)
+     {
+     newvar=(listvar *)malloc(sizeof(listvar));
+     newvar->var=(variable *)malloc(sizeof(variable));
+     /*                                                                       */
+     Init_Variable(newvar->var);
+     /*                                                                       */
+     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
+     Save_Length(tmpvar1->n_name,4);
+     strcpy(newvar->var->v_subroutinename,subroutinename);
+     Save_Length(subroutinename,11);
+     strcpy(newvar->var->v_modulename,curmodulename);
+     Save_Length(curmodulename,6);
+     strcpy(newvar->var->v_commoninfile,mainfile);
+     Save_Length(mainfile,10);
+       
+     strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
+     Save_Length(tmpvar2->n_name,14);
+     newvar->suiv = NULL;
+     
+     if ( ! (*curlist) )
+     {
+        *curlist  = newvar ;
+     }
+     else
+     {
+        tmpvar = *curlist;
+        while (tmpvar->suiv)
+          tmpvar=tmpvar->suiv;
+        tmpvar->suiv = newvar;
+     }
+     
+  tmpvar1 = tmpvar1->suiv;
+  tmpvar2 = tmpvar2->suiv;  
+  }
+  return;
+
+
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 3437)
@@ -0,0 +1,530 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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(char *nom, int whichone)
+{
+   if ( whichone == 1  && strlen(nom) > length_last )
+   {
+      length_last               = strlen(nom);
+      if ( length_last > LONG_C )
+      {
+         printf("WARNING 1 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_last+100);
+      }
+   }
+   if ( whichone == 2  && strlen(nom) > length_first )
+   {
+      length_first              = strlen(nom);
+      if ( length_first > LONG_C )
+      {
+         printf("WARNING 2 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_first+100);
+      }
+   }
+   if ( whichone == 3  && strlen(nom) > length_v_typevar )
+   {
+      length_v_typevar          = strlen(nom);
+      if ( length_v_typevar > LONG_C )
+      {
+         printf("WARNING 3 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_v_typevar+100);
+      }
+   }
+   if ( whichone == 4  && strlen(nom) > length_v_nomvar )
+   {
+      length_v_nomvar           = strlen(nom);
+      if ( length_v_nomvar > LONG_C )
+      {
+         printf("WARNING 4 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_v_nomvar+100);
+      }
+   }
+   if ( whichone == 5  && strlen(nom) > length_v_dimchar )
+   {
+      length_v_dimchar          = strlen(nom);
+      if ( length_v_dimchar > LONG_C )
+      {
+         printf("WARNING 5 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                          length_v_dimchar+100);
+      }
+   }
+   if ( whichone == 6  && strlen(nom) > length_v_modulename )
+   {
+      length_v_modulename       = strlen(nom);
+      if ( length_v_modulename > LONG_C )
+      {
+         printf("WARNING 6 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_v_modulename+100);
+      }
+   }
+   if ( whichone == 7  && strlen(nom) > length_v_commonname )
+   {
+      length_v_commonname       = strlen(nom);
+      if ( length_v_commonname > LONG_C )
+      {
+         printf("WARNING 7 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_v_commonname+100);
+      }
+   }
+   if ( whichone == 8  && strlen(nom) > length_v_vallengspec )
+   {
+      length_v_vallengspec      = strlen(nom);
+      if ( length_v_vallengspec > LONG_C )
+      {
+         printf("WARNING 8 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                      length_v_vallengspec+100);
+      }
+   }
+   if ( whichone == 9  && strlen(nom) > length_v_nameinttypename )
+   {
+      length_v_nameinttypename  = strlen(nom);
+      if ( length_v_nameinttypename > LONG_C )
+      {
+         printf("WARNING 9 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                  length_v_nameinttypename+100);
+      }
+   }
+   if ( whichone == 10 && strlen(nom) > length_v_commoninfile )
+   {
+      length_v_commoninfile     = strlen(nom);
+      if ( length_v_commoninfile > LONG_C )
+      {
+         printf("WARNING 10 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                     length_v_commoninfile+100);
+      }
+   }
+   if ( whichone == 11 && strlen(nom) > length_v_subroutinename )
+   {
+      length_v_subroutinename   = strlen(nom);
+      if ( length_v_subroutinename > LONG_C )
+      {
+         printf("WARNING 11 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                   length_v_subroutinename+100);
+      }
+   }
+   if ( whichone == 12 && strlen(nom) > length_v_precision )
+   {
+      length_v_precision        = strlen(nom);
+      if ( length_v_precision > LONG_C )
+      {
+         printf("WARNING 12 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_v_precision+100);
+      }
+   }
+   if ( whichone == 13 && strlen(nom) > length_v_IntentSpec )
+   {
+      length_v_IntentSpec       = strlen(nom);
+      if ( length_v_IntentSpec > LONG_C )
+      {
+         printf("WARNING 13 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_v_IntentSpec+100);
+      }
+   }
+   if ( whichone == 14 && strlen(nom) > length_v_initialvalue )
+   {
+      length_v_initialvalue     = strlen(nom);
+      if ( length_v_initialvalue > LONG_4C )
+      {
+         printf("WARNING 14 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                     length_v_initialvalue+100);
+      }
+   }
+   if ( whichone == 15 && strlen(nom) > length_v_readedlistdimension )
+   {
+      length_v_readedlistdimension = strlen(nom);
+      if ( length_v_readedlistdimension > LONG_C )
+      {
+         printf("WARNING 15 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                              length_v_readedlistdimension+100);
+      }
+   }
+   if ( whichone == 16 && strlen(nom) > length_u_usemodule )
+   {
+      length_u_usemodule        = strlen(nom);
+      if ( length_u_usemodule > LONG_C )
+      {
+         printf("WARNING 16 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_u_usemodule+100);
+      }
+   }
+   if ( whichone == 17 && strlen(nom) > length_u_charusemodule )
+   {
+      length_u_charusemodule    = strlen(nom);
+      if ( length_u_charusemodule > LONG_C )
+      {
+         printf("WARNING 17 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                    length_u_charusemodule+100);
+      }
+   }
+   if ( whichone == 18 && strlen(nom) > length_u_cursubroutine )
+   {
+      length_u_cursubroutine    = strlen(nom);
+      if ( length_u_cursubroutine > LONG_C )
+      {
+         printf("WARNING 18 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                    length_u_cursubroutine+100);
+      }
+   }
+   if ( whichone == 19 && strlen(nom) > length_u_modulename )
+   {
+      length_u_modulename       = strlen(nom);
+      if ( length_u_modulename > LONG_C )
+      {
+         printf("WARNING 19 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_u_modulename+100);
+      }
+   }
+   if ( whichone == 20 && strlen(nom) > length_n_name )
+   {
+      length_n_name             = strlen(nom);
+      if ( length_n_name > LONG_C )
+      {
+         printf("WARNING 20 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_n_name+100);
+      }
+   }
+   if ( whichone == 21 && strlen(nom) > length_c_namevar )
+   {
+      length_c_namevar          = strlen(nom);
+      if ( length_c_namevar > LONG_C )
+      {
+         printf("WARNING 21 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_c_namevar+100);
+      }
+   }
+   if ( whichone == 22 && strlen(nom) > length_c_namepointedvar )
+   {
+      length_c_namepointedvar   = strlen(nom);
+      if ( length_c_namepointedvar > LONG_C )
+      {
+         printf("WARNING 22 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                   length_c_namepointedvar+100);
+      }
+   }
+   if ( whichone == 23 && strlen(nom) > length_o_nom )
+   {
+      length_o_nom              = strlen(nom);
+      if ( length_o_nom > LONG_C )
+      {
+         printf("WARNING 23 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_o_nom+100);
+      }
+   }
+   if ( whichone == 24 && strlen(nom) > length_o_module )
+   {
+      length_o_module           = strlen(nom);
+      if ( length_o_module > LONG_C )
+      {
+         printf("WARNING 24 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_o_module+100);
+      }
+   }
+   if ( whichone == 25 && strlen(nom) > length_a_nomvar )
+   {
+      length_a_nomvar           = strlen(nom);
+      if ( length_a_nomvar > LONG_C )
+      {
+         printf("WARNING 25 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_a_nomvar+100);
+      }
+   }
+   if ( whichone == 26 && strlen(nom) > length_a_subroutine )
+   {
+      length_a_subroutine       = strlen(nom);
+      if ( length_a_subroutine > LONG_C )
+      {
+         printf("WARNING 26 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_a_subroutine+100);
+      }
+   }
+   if ( whichone == 27 && strlen(nom) > length_a_module )
+   {
+      length_a_module           = strlen(nom);
+      if ( length_a_module > LONG_C )
+      {
+         printf("WARNING 27 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_a_module+100);
+      }
+   }
+   if ( whichone == 28 && strlen(nom) > length_t_usemodule )
+   {
+      length_t_usemodule        = strlen(nom);
+      if ( length_t_usemodule > LONG_C )
+      {
+         printf("WARNING 28 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_t_usemodule+100);
+      }
+   }
+   if ( whichone == 29 && strlen(nom) > length_t_cursubroutine )
+   {
+      length_t_cursubroutine    = strlen(nom);
+      if ( length_t_cursubroutine > LONG_C )
+      {
+         printf("WARNING 29 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                    length_t_cursubroutine+100);
+      }
+   }
+   if ( whichone == 30 && strlen(nom) > length_curfilename )
+   {
+      length_curfilename        = strlen(nom);
+      if (length_curfilename  > LONG_C )
+      {
+         printf("WARNING 30 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_curfilename+100);
+      }
+   }
+   if ( whichone == 31 && strlen(nom) > length_nomfileoutput )
+   {
+      length_nomfileoutput      = strlen(nom);
+      if ( length_nomfileoutput > LONG_C )
+      {
+         printf("WARNING 31 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                      length_nomfileoutput+100);
+      }
+   }
+   if ( whichone == 32 && strlen(nom) > length_motparse )
+   {
+      length_motparse           = strlen(nom);
+      if ( length_motparse > LONG_4C )
+      {
+         printf("WARNING 32 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_motparse+100);
+      }
+   }
+   if ( whichone == 33 && strlen(nom) > length_mainfile )
+   {
+      length_mainfile           = strlen(nom);
+      if ( length_mainfile > LONG_C )
+      {
+         printf("WARNING 33 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_mainfile+100);
+      }
+   }
+   if ( whichone == 34 && strlen(nom) > length_nomdir )
+   {
+      length_nomdir             = strlen(nom);
+      if ( length_nomdir > LONG_C )
+      {
+         printf("WARNING 34 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_nomdir+100);
+      }
+   }
+   if ( whichone == 35 && strlen(nom) > length_commondirout )
+   {
+      length_commondirout       = strlen(nom);
+      if ( length_commondirout > LONG_C )
+      {
+         printf("WARNING 35 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_commondirout+100);
+      }
+   }
+   if ( whichone == 36 && strlen(nom) > length_commondirin )
+   {
+      length_commondirin        = strlen(nom);
+      if ( length_commondirin > LONG_C )
+      {
+         printf("WARNING 36 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_commondirin+100);
+      }
+   }
+   if ( whichone == 37 && strlen(nom) > length_filetoparse )
+   {
+      length_filetoparse        = strlen(nom);
+      if ( length_filetoparse > LONG_C )
+      {
+         printf("WARNING 37 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_filetoparse+100);
+      }
+   }
+   if ( whichone == 38 && strlen(nom) > length_curbuf )
+   {
+      length_curbuf             = strlen(nom);
+      if ( length_curbuf > LONG_40M )
+      {
+         printf("WARNING 38 : The value of LONG_40M - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",length_curbuf+100);
+      }
+   }
+   if ( whichone == 39 && strlen(nom) > length_toprintglob )
+   {
+      length_toprintglob        = strlen(nom);
+      if ( length_toprintglob > LONG_4C )
+      {
+         printf("WARNING 39 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                        length_toprintglob+100);
+      }
+   }
+   if ( whichone == 40 && strlen(nom) > length_tmpvargridname )
+   {
+      length_tmpvargridname     = strlen(nom);
+      if ( length_tmpvargridname > LONG_4C )
+      {
+         printf("WARNING 40 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                     length_tmpvargridname+100);
+      }
+   }
+   if ( whichone == 41 && strlen(nom) > length_ligne_Subloop )
+   {
+       length_ligne_Subloop    = strlen(nom);
+      if ( length_ligne_Subloop > LONG_40M )
+      {
+         printf("WARNING 41 : The value of LONG_40M - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                      length_ligne_Subloop+100);
+      }
+   }
+   if ( whichone == 42 && strlen(nom) > length_lvargridname_toamr )
+   {
+      length_lvargridname_toamr     = strlen(nom);
+      if ( length_lvargridname_toamr > LONG_4C )
+      {
+         printf("WARNING 42 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                 length_lvargridname_toamr+100);
+      }
+   }
+   if ( whichone == 43 && strlen(nom) > length_toprint_utilagrif )
+   {
+      length_toprint_utilagrif     = strlen(nom);
+      if ( length_toprint_utilagrif > LONG_C )
+      {
+         printf("WARNING 43 : The value of LONG_C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                  length_toprint_utilagrif+100);
+      }
+   }
+   if ( whichone == 44 && strlen(nom) > length_toprinttmp_utilchar )
+   {
+      length_toprinttmp_utilchar     = strlen(nom);
+      if ( length_toprinttmp_utilchar > LONG_4C)
+      {
+         printf("WARNING 44 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                length_toprinttmp_utilchar+100);
+      }
+   }
+   if ( whichone == 45 && strlen(nom) > length_ligne_writedecl )
+   {
+      length_ligne_writedecl     = strlen(nom);
+      if ( length_ligne_writedecl > LONG_4C )
+      {
+         printf("WARNING 45 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                    length_ligne_writedecl+100);
+      }
+   }
+   if ( whichone == 46 && strlen(nom) > length_newname_toamr )
+   {
+      length_newname_toamr    = strlen(nom);
+      if ( length_newname_toamr > LONG_4C )
+      {
+         printf("WARNING 46 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                      length_newname_toamr+100);
+      }
+   }
+   if ( whichone == 47 && strlen(nom) > length_newname_writedecl )
+   {
+      length_newname_writedecl    = strlen(nom);
+      if ( length_newname_writedecl > LONG_4C )
+      {
+         printf("WARNING 47 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                 length_newname_writedecl +100);
+      }
+   }
+   if ( whichone == 48 && strlen(nom) > length_ligne_toamr )
+   {
+      length_ligne_toamr    = strlen(nom);
+      if ( length_ligne_toamr > LONGNOM )
+      {
+         printf("WARNING 48 : The value of LONGNOM - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                       length_ligne_toamr +100);
+      }
+   }
+   if ( whichone == 49 && strlen(nom) > length_tmpligne_writedecl )
+   {
+      length_tmpligne_writedecl     = strlen(nom);
+      if ( length_tmpligne_writedecl > LONG_4C )
+      {
+         printf("WARNING 49 : The value of LONG_4C - define in decl.h -\n");
+         printf("             should be upgrated to %d\n",
+                                                 length_tmpligne_writedecl+100);
+      }
+   }
+}
+
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 3437)
@@ -0,0 +1,111 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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"
+
+/******************************************************************************/
+/*                          varisallocatable_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int variscoupled_0(char *ident)
+{
+   listallocate *newvaralloc;
+  listvarpointtovar *pointtmplist; 
+  listcouple *coupletmp;   
+  int out;
+
+   out =0;
+   if (firstpass == 0 )
+   {
+  pointtmplist = List_CouplePointed_Var;
+  while ( pointtmplist && out == 0)
+  {
+      coupletmp = pointtmplist->t_couple;
+      while ( coupletmp && out == 0)
+      {
+           /* we should find the same variable name in the same subroutine    */
+           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
+                !strcasecmp(subroutinename,
+                                       pointtmplist->t_cursubroutine) &&
+                 strcasecmp(coupletmp->c_namepointedvar,"")
+              )
+           {
+              out = 1;
+           }
+         coupletmp = coupletmp->suiv;
+     }
+     pointtmplist = pointtmplist->suiv;
+   }
+   }
+   return out;
+}
+
+char * getcoupledname_0(char *ident)
+{
+   listallocate *newvaralloc;
+  listvarpointtovar *pointtmplist; 
+  listcouple *coupletmp;   
+  int out;
+
+   out =0;
+   if (firstpass == 0 )
+   {
+  pointtmplist = List_CouplePointed_Var;
+  while ( pointtmplist && out == 0)
+  {
+      coupletmp = pointtmplist->t_couple;
+      while ( coupletmp && out == 0)
+      {
+           /* we should find the same variable name in the same subroutine    */
+           if ( !strcasecmp(ident,coupletmp->c_namevar) &&
+                !strcasecmp(subroutinename,
+                                       pointtmplist->t_cursubroutine) &&
+                 strcasecmp(coupletmp->c_namepointedvar,"")
+              )
+           {
+              return(coupletmp->c_namepointedvar);
+           }
+         coupletmp = coupletmp->suiv;
+     }
+     pointtmplist = pointtmplist->suiv;
+   }
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 3437)
@@ -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);
+         printf("PPPPPPPPPPPPPP\n");
+           List_GlobParamModuleUsed_Var = ReaddependParameterList
+                      (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var);
+
+        }
+
+        tmplistmodule = tmplistmodule->suiv;
+     }
+  }
+}
+
+/******************************************************************************/
+/*                RecordUseModulesUseModulesVariables                         */
+/******************************************************************************/
+/******************************************************************************/
+void  RecordUseModulesUseModulesVariables()
+{
+  listusemodule *tmplistmodule;
+  listusemodule *tmplistmodule1;
+
+  /* we should record all variables defined in modules used in this file      */
+  if ( List_NameOfModuleUsed )
+  {
+     /* and we should read the .depend of the module used by the module used  */
+     tmplistmodule = List_NameOfModuleUsed;
+     while ( tmplistmodule )
+     {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+           tmplistmodule1 = tmpuselocallist->suiv;
+           free(tmpuselocallist);
+           tmpuselocallist = tmplistmodule1;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+     }
+
+     tmplistmodule = listofmoduletmp;
+     while ( tmplistmodule )
+     {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+           Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+           tmplistmodule1 = tmpuselocallist->suiv;
+           free(tmpuselocallist);
+           tmpuselocallist = tmplistmodule1;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+     }
+
+
+
+     tmplistmodule = listofmoduletmp;
+     while ( tmplistmodule )
+     {
+        /* check if the file .depend<u_usemodule> exist                       */
+        List_ModuleUsedInModuleUsed_Var = Readthedependfile
+                   (tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
+
+        List_GlobParamModuleUsedInModuleUsed_Var = ReaddependParameterList
+          (tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
+        tmplistmodule = 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;
+
+  if ( firstpass == 1 )
+  {
+     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
+     strcpy(newmodule->u_usemodule,name);
+     Save_Length(name,16);
+     strcpy(newmodule->u_charusemodule,charusemodule);
+     Save_Length(charusemodule,17);
+     strcpy(newmodule->u_modulename,curmodulename);
+     Save_Length(curmodulename,19);
+     strcpy(newmodule->u_cursubroutine,subroutinename);
+     Save_Length(subroutinename,18);
+     newmodule->u_firstuse = 1 ;
+     newmodule->suiv = NULL;
+
+     if ( !List_NameOfModuleUsed)
+     {
+         List_NameOfModuleUsed = newmodule ;
+     }
+     else
+     {
+    parcours = List_NameOfModuleUsed;
+    while ( parcours && newmodule->u_firstuse == 1 )
+    {
+       if ( !strcasecmp(name,parcours->u_usemodule) )
+       {
+          newmodule->u_firstuse = 0 ;
+       }
+       parcours=parcours->suiv;
+    }
+    /* we can not add the same module twice for the same subroutine           */
+    parcours = List_NameOfModuleUsed;
+    out = 0 ;
+    while ( parcours && out == 0 )
+    {
+       if ( !strcasecmp(name,parcours->u_usemodule) &&
+            !strcasecmp(subroutinename,parcours->u_cursubroutine)
+           )
+       {
+          out = 1 ;
+          free(newmodule);
+       }
+       else parcours=parcours->suiv;
+    }
+    if ( out == 0 )
+    {
+       newmodule->suiv = List_NameOfModuleUsed;
+       List_NameOfModuleUsed = newmodule;
+    }
+  }
+  }
+}
+
+
+/******************************************************************************/
+/*                        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(char *name)
+{
+  listusemodule *newmodule;
+  listusemodule *parcours;
+  int out;
+
+     newmodule =(listusemodule *)malloc(sizeof(listusemodule));
+     strcpy(newmodule->u_usemodule,name);
+     Save_Length(name,16);
+     strcpy(newmodule->u_charusemodule,charusemodule);
+     Save_Length(charusemodule,17);
+     strcpy(newmodule->u_cursubroutine,subroutinename);
+     Save_Length(subroutinename,18);
+     newmodule->u_firstuse = 1 ;
+     newmodule->suiv = NULL;
+
+     if ( !List_NameOfModuleUsed)
+     {
+         List_NameOfModuleUsed = newmodule ;
+     }
+     else
+     {
+    parcours = List_NameOfModuleUsed;
+    while ( parcours && newmodule->u_firstuse == 1 )
+    {
+       if ( !strcasecmp(name,parcours->u_usemodule) )
+       {
+          newmodule->u_firstuse = 0 ;
+       }
+       parcours=parcours->suiv;
+    }
+    /* we can not add the same module twice for the same subroutine           */
+    parcours = List_NameOfModuleUsed;
+    out = 0 ;
+    while ( parcours && out == 0 )
+    {
+       if ( !strcasecmp(name,parcours->u_usemodule) &&
+            !strcasecmp(subroutinename,parcours->u_cursubroutine)
+           )
+       {
+          out = 1 ;
+          free(newmodule);
+       }
+       else parcours=parcours->suiv;
+    }
+    if ( out == 0 )
+    {
+       newmodule->suiv = List_NameOfModuleUsed;
+       List_NameOfModuleUsed = newmodule;
+    }
+  }
+}
+
+
+/******************************************************************************/
+/*                        WriteUsemoduleDeclaration                           */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteUsemoduleDeclaration(char *cursubroutinename)
+{
+  listusemodule *newmodule;
+  
+
+  newmodule = List_NameOfModuleUsed;
+  fprintf(fortranout,"\n");
+
+  while ( newmodule )
+  {
+     if ( !strcasecmp(newmodule->u_cursubroutine,cursubroutinename) )
+     {
+     if (strcmp(newmodule->u_charusemodule,""))
+     {
+             fprintf(fortranout,"      USE %s \n"
+                                                   ,newmodule->u_charusemodule);
+     }
+     }
+        newmodule = newmodule ->suiv;
+  }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 3437)
@@ -0,0 +1,1940 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 (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 *)malloc(sizeof(listvar));
+      newvar->var=(variable *)malloc(sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,ident);
+
+      Save_Length(ident,4);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      Save_Length(curmodulename,6);
+     printf("ICI %d\n",newvar->var->v_module);
+
+      strcpy(newvar->var->v_commoninfile,mainfile);
+      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      Save_Length(subroutinename,11);
+      newvar->var->v_pointedvar=pointedvar;
+      List_UsedInSubroutine_Var = newvar ;
+       printf("jaoute %s\n",newvar->var->v_nomvar);
+  }
+  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 *)malloc(sizeof(listvar));
+         newvar->var=(variable *)malloc(sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,ident);
+
+         Save_Length(ident,4);
+         strcpy(newvar->var->v_commoninfile,mainfile);
+         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         Save_Length(curmodulename,6);
+       printf("ICI %d\n",newvar->var->v_module);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         Save_Length(subroutinename,11);
+         newvar->var->v_pointedvar=pointedvar;
+         newvar->suiv = List_UsedInSubroutine_Var;
+         printf("jaoute %s\n",newvar->var->v_nomvar);
+         List_UsedInSubroutine_Var = newvar;        
+      }
+  }
+
+   }
+}
+
+/******************************************************************************/
+/*                        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 *)malloc(sizeof(listvar));
+      newvar->var=(variable *)malloc(sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,name);
+
+      Save_Length(name,4);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      Save_Length(curmodulename,6);
+      strcpy(newvar->var->v_commoninfile,mainfile);
+      Save_Length(mainfile,10);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      Save_Length(subroutinename,11);
+      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 *)malloc(sizeof(listvar));
+         newvar->var=(variable *)malloc(sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,name);
+
+         Save_Length(name,4);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         Save_Length(curmodulename,6);
+         strcpy(newvar->var->v_commoninfile,mainfile);
+         Save_Length(mainfile,10);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         Save_Length(subroutinename,11);
+         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;
+  }
+}
+
+/******************************************************************************/
+/*                             CopyRecord                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void CopyRecord(variable *var1,variable *var2)
+{
+   if ( !strcasecmp(var1->v_typevar,"") )
+                                        strcpy(var1->v_typevar,var2->v_typevar);
+   else strcpy(var2->v_typevar,var1->v_typevar);
+
+   if ( !strcasecmp(var1->v_oldname,"") )
+                                        strcpy(var1->v_oldname,var2->v_oldname);
+   else strcpy(var2->v_oldname,var1->v_oldname);
+
+   if ( !strcasecmp(var1->v_dimchar,"") )
+                                        strcpy(var1->v_dimchar,var2->v_dimchar);
+   else strcpy(var2->v_dimchar,var1->v_dimchar);
+
+   if ( !strcasecmp(var1->v_commonname,"") )
+                                  strcpy(var1->v_commonname,var2->v_commonname);
+   else strcpy(var2->v_commonname,var1->v_commonname);
+   
+   printf("modulenameII = %s %s %d %s\n",var1->v_modulename,var2->v_modulename,var1->v_module,var1->v_nomvar);
+
+   if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
+                                  strcpy(var1->v_modulename,var2->v_modulename);
+   else strcpy(var2->v_modulename,var1->v_modulename);
+
+   if ( !strcasecmp(var1->v_vallengspec,"") )
+                                strcpy(var1->v_vallengspec,var2->v_vallengspec);
+   else strcpy(var2->v_vallengspec,var1->v_vallengspec);
+
+   if ( !strcasecmp(var1->v_nameinttypename,"") )
+                        strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
+   else strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
+          
+   if ( !strcasecmp(var1->v_commoninfile,"") )
+                              strcpy(var1->v_commoninfile,var2->v_commoninfile);
+   else strcpy(var2->v_commoninfile,var1->v_commoninfile);
+
+   if ( !strcasecmp(var1->v_precision,"") )
+                                    strcpy(var1->v_precision,var2->v_precision);
+   else strcpy(var2->v_precision,var1->v_precision);
+
+   if ( !strcasecmp(var1->v_initialvalue,"") )
+                              strcpy(var1->v_initialvalue,var2->v_initialvalue);
+   else strcpy(var2->v_initialvalue,var1->v_initialvalue);
+
+   if ( !strcasecmp(var1->v_IntentSpec,"") )
+                                  strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
+   else strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
+
+   if ( !strcasecmp(var1->v_readedlistdimension,"") )
+                strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
+   else strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
+
+   if ( var1->v_dimension ) var2->v_dimension = var1->v_dimension ;
+   else var1->v_dimension = var2->v_dimension ;
+
+   if ( var1->v_nbdim == 0 ) var1->v_nbdim = var2->v_nbdim ;
+   else var2->v_nbdim = var1->v_nbdim ;
+
+   if ( var1->v_common == 0 ) var1->v_common = var2->v_common ;
+   else var2->v_common = var1->v_common ;
+
+   if ( var1->v_positioninblock == 0 ) var1->v_positioninblock =
+                                                       var2->v_positioninblock ;
+   else var2->v_positioninblock = var1->v_positioninblock ;
+
+   if ( var1->v_module == 0 ) var1->v_module = var2->v_module ;
+   else var2->v_module = var1->v_module ;
+
+   if ( var1->v_save == 0 ) var1->v_save = var2->v_save ;
+   else var2->v_save = var1->v_save ;
+   
+   if ( var1->v_VariableIsParameter == 0 )
+                     var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
+                    
+   else var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
+   if ( var1->v_indicetabvars == 0 )
+   {
+   
+                                 var1->v_indicetabvars = var2->v_indicetabvars ;
+       printf("HERHEHR %s mm %s mm %d\n",var1->v_nomvar,var2->v_modulename,var2->v_indicetabvars);
+                                 }
+   else var2->v_indicetabvars = var1->v_indicetabvars ;
+
+   if ( var1->v_ExternalDeclare == 0 )
+                             var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
+   else var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
+
+   if ( var1->v_pointedvar == 0 ) var1->v_pointedvar = var2->v_pointedvar ;
+   else var2->v_pointedvar = var1->v_pointedvar ;
+
+   if ( var1->v_dimensiongiven == 0 )
+                                var1->v_dimensiongiven = var2->v_dimensiongiven;
+   else var2->v_dimensiongiven = var1->v_dimensiongiven ;
+
+   if ( var1->v_c_star == 0 ) var1->v_c_star = var2->v_c_star;
+   else var2->v_c_star = var1->v_c_star ;
+
+   if ( var1->v_pointerdeclare == 0 )
+                               var1->v_pointerdeclare = var2->v_pointerdeclare ;
+   else var2->v_pointerdeclare = var1->v_pointerdeclare ;
+
+
+   if ( var1->v_notgrid == 0 ) var1->v_notgrid = var2->v_notgrid ;
+   else var2->v_notgrid = var1->v_notgrid;
+
+   if ( var1->v_optionaldeclare == 0 )
+                              var1->v_optionaldeclare = var2->v_optionaldeclare;
+   else var2->v_optionaldeclare = var1->v_optionaldeclare ;
+
+   if ( var1->v_allocatable == 0 ) var1->v_allocatable = var2->v_allocatable ;
+   else var2->v_allocatable = var1->v_allocatable ;
+   
+   if ( var1->v_target == 0 ) var1->v_target = var2->v_target ;
+   else var2->v_target = var1->v_target ;
+
+   if ( var1->v_dimsempty == 0 ) var1->v_dimsempty = var2->v_dimsempty ;
+   else var2->v_dimsempty = var1->v_dimsempty ;
+}
+
+
+/******************************************************************************/
+/*                      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 ) CopyRecord(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 )
+        {
+           CopyRecord(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 ligne[LONG_C];
+
+   parcours = List_Save_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,"") )
+      /* Save in subroutine which is not defined in a module                  */
+      {
+         newvar = (listvar *)malloc(sizeof(listvar));
+         newvar->var = (variable *)malloc(sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+         CopyRecord(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+
+         sprintf(ligne,"save_%s",parcours->var->v_subroutinename);
+         Add_NameOfCommon_1(ligne,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_commonname,ligne);
+         Save_Length(ligne,7);
+         List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
+      }
+      else
+      /* Save in subroutine which is defined in a module                      */
+      {
+         newvar = (listvar *)malloc(sizeof(listvar));
+         newvar->var = (variable *)malloc(sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+
+         CopyRecord(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+
+         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);
+             
+         CopyRecord(parcours->var,parcours1->var);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                          Update_List_Var                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int out;
+   int out2;
+   
+   parcours = list_to_modify;
+
+   while( parcours )
+   {
+     printf("LE NOM EST %s\n",parcours->var->v_nomvar);
+      /* looking in List_Global_Var                                           */
+      
+      out = 0;
+      
+//       if (list_to_modify != List_SubroutineDeclaration_Var && list_to_modify != List_UsedInSubroutine_Var) {
+//       parcours1 = List_Global_Var;
+//       while ( parcours1 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours->var->v_nomvar,
+//                           parcours1->var->v_nomvar)         &&
+//               !strcasecmp(parcours->var->v_modulename,
+//                           parcours1->var->v_modulename)
+//             ) out = 1;
+//          else parcours1 = parcours1->suiv;
+//       }
+//       }
+      
+  //    if (list_to_modify == List_UsedInSubroutine_Var) {
+      parcours1 = List_Global_Var;
+      while ( parcours1 && out == 0 )
+      {
+      printf("lenombis est %s\n",parcours1->var->v_nomvar);
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                          parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename,
+                             parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_modulename,
+                          parcours1->var->v_modulename)
+            ) {
+            out = 1;
+            }
+         else parcours1 = parcours1->suiv;
+      }
+//      }      
+
+      /* if variable has been found                                           */
+      if ( out == 1 ) {
+      CopyRecord(parcours->var,parcours1->var);
+      }
+      /* looking in List_SubroutineDeclaration_Var                            */
+      else
+      {
+         parcours1 = List_SubroutineDeclaration_Var ;
+         out = 0;
+         while ( parcours1)
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,
+                             parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename,
+                             parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_modulename,
+                             parcours1->var->v_modulename)
+               ) {
+
+               out = 1;
+               break;
+               }
+            else parcours1 = parcours1->suiv;
+         }
+             
+         /* if variable has been found                                        */
+         if ( out == 1 ) {
+         CopyRecord(parcours->var,parcours1->var);
+        
+         }
+         else
+         {
+            parcours1 = List_Common_Var ;
+            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 ) {
+            CopyRecord(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 ;
+      printf("OIEROZEIR %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
+      if ( parcours->var->v_indicetabvars == 0 )
+      {
+       printf("OIEROZEIR %s\n",parcours->var->v_nomvar);
+         parcours2 = List_NameOfModuleUsed;
+         while( parcours2 )
+         {
+            if ( !strcasecmp(parcours2->u_cursubroutine,"") &&
+                 !strcasecmp(parcours2->u_modulename,
+                             parcours->var->v_modulename)
+               )
+            {
+               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 ) CopyRecord(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 ) CopyRecord(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 ) CopyRecord(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 )
+      {
+         CopyRecord(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,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;
+}
+
+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) )
+         {
+            CopyRecord(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 - %d - %s - %s - %s - %s\n",
+      newvar->var->v_nomvar,
+      newvar->var->v_VariableIsParameter,
+      newvar->var->v_subroutinename,
+      newvar->var->v_modulename,
+      newvar->var->v_typevar,
+      newvar->var->v_initialvalue      
+            );
+      newvar = newvar->suiv;
+   }
+}
+
+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_C];
+
+   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 ( mark == 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 )
+         {
+            CopyRecord(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            */
+         {
+            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 *) malloc (sizeof (listindice));
+     newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+     newindice -> suiv = Listofavailableindices;
+     Listofavailableindices = newindice;
+     parcours1 = parcours1->suiv;
+  }
+}
+/******************************************************************************/
+/*                       IndiceTabvars_Global_Var_No_Treated                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Global_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+
+   if ( mark == 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 = indicemaxtabvars + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars;
+      }
+      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);
+         CopyRecord(parcours->var,record->var);
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+
+
+/******************************************************************************/
+/*                      IndiceTabvars_Common_Var_Treated                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   listvar *parcours1;
+   listvar *List_CommonUsed_Var;
+   listindice *newindice;
+   int out;
+
+   parcoursprec = (listvar *)NULL;
+
+   if ( mark == 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
+            {
+               parcoursprec = parcours1 ;
+               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);
+            CopyRecord(parcours->var,parcours1->var);
+         }
+         else
+         /* if we do not found the var common name in the old list            */
+         {
+            if ( Listofavailableindices )
+            {
+               parcours->var->v_indicetabvars = Listofavailableindices ->
+                                                                       i_indice;
+               if ( Listofavailableindices->suiv )
+                          Listofavailableindices = Listofavailableindices->suiv;
+               else
+                          Listofavailableindices = (listindice *)NULL;
+            }
+            else
+            {
+               indicemaxtabvars = indicemaxtabvars + 1 ;
+               parcours->var->v_indicetabvars = indicemaxtabvars;
+            }
+         }
+         /* 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 *) malloc (sizeof (listindice));
+        newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+        newindice -> suiv = Listofavailableindices;
+        Listofavailableindices = newindice;
+     }
+     parcours1 = parcours1->suiv;
+  }
+}
+/******************************************************************************/
+/*                     IndiceTabvars_Common_Var_No_Treated                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcours2;
+
+   if ( mark == 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 = indicemaxtabvars + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars;
+         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 ( Did_module_common_treaded(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 ( Did_module_common_treaded(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_initialvalue,"")
+              ) ) out = 1;
+         else parcours = parcours -> suiv;
+      }
+      if ( out == 1 )
+      {
+         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,mainfile)           &&
+              ( parcours->var->v_nbdim != 0 ||
+                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;
+   char ligne[LONG_C];
+   if ( firstpass == 0 )
+   {
+      parcours_nom = List_NameOfCommon;
+      while ( parcours_nom )
+      {
+         if ( parcours_nom->o_val == 1 )
+         {
+            strcpy(ligne,"");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "module %s",parcours_nom->o_nom);
+            tofich(fortranout,ligne,1);
+            WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
+            strcpy(ligne,"implicit none");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "public Alloc_agrif_%s",parcours_nom->o_nom);
+            tofich(fortranout,ligne,1);
+            strcpy (ligne, "contains");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "subroutine Alloc_agrif_%s(Agrif_Gr)",
+                                                           parcours_nom->o_nom);
+            tofich(fortranout,ligne,1);
+            strcpy(ligne,"Use Agrif_Util");
+            tofich(fortranout,ligne,1);
+            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
+            tofich(fortranout,ligne,1);
+            strcpy(ligne, "INTEGER :: i");
+            tofich (fortranout, ligne,1);
+            strcpy (ligne, "\n#include \"alloc_agrif_");
+            strcat (ligne, parcours_nom->o_nom);
+            strcat (ligne, ".h\"\n");
+            fprintf(fortranout,ligne);
+            strcpy (ligne, "Return");
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "end subroutine Alloc_agrif_%s",
+                                                           parcours_nom->o_nom);
+            tofich(fortranout,ligne,1);
+            sprintf (ligne, "end module %s",parcours_nom->o_nom);
+            tofich(fortranout,ligne,1);
+            /* List all Call Alloc_agrif                                      */
+            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+         }
+         parcours_nom = parcours_nom->suiv;
+      }
+   }
+}
+
+void UpdateList_SubroutineWhereAgrifUsed()
+{
+   listnom *parcours;
+   listusemodule *parcours1;
+   listallocate *parcours2;
+   listname *parcours3;
+   listvar *parcours4;
+   int out;
+   char name_module[LONG_C];
+
+   /* 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                 */
+      if ( out == 0 )
+      {
+         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 *parcours;
+
+   parcours = (listvar *)NULL;
+/*   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;                  */
+
+   while( parcours )
+   {
+      printf("module- %s \n",parcours->var->v_modulename);
+      printf("subroutine- %s  \n",parcours->var->v_subroutinename);
+      printf("nom- %s  \n",parcours->var->v_nomvar);
+      printf("common- %s  \n",parcours->var->v_commonname);
+      printf("type- %s  \n",parcours->var->v_typevar);
+      printf("indice- %d  \n",parcours->var->v_indicetabvars);
+      printf("variableisparameter- %d \n",parcours->var->v_VariableIsParameter);
+      printf("module1- %d  \n",parcours->var->v_module);
+      printf("save- %d  \n",parcours->var->v_save);
+      printf("notgrid- %d  \n",parcours->var->v_notgrid);
+      printf("nbdim- %d  \n",parcours->var->v_nbdim);
+      printf("common1- %d  \n",parcours->var->v_common);
+      printf("v_dimensiongiven- %d  \n",parcours->var->v_dimensiongiven);
+      printf("v_dimsempty- %d  \n",parcours->var->v_dimsempty);
+      printf("initialvalue- %s\n \n",parcours->var->v_initialvalue);
+      printf("dim- %s\n \n",parcours->var->v_readedlistdimension);
+
+      parcours = parcours -> suiv ;
+   }
+   if ( mark == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars);
+   
+}
+
+
+
+
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 3437)
@@ -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"
+
+/******************************************************************************/
+/*                      Add_SubroutineArgument_Var_1                          */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the                                                     */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_SubroutineArgument_Var_1(listvar *listtoadd)
+{
+
+   if ( firstpass == 1 )
+   {
+       List_SubroutineArgument_Var = AddListvarToListvar
+                              (listtoadd,List_SubroutineArgument_Var,1);
+   }
+}
+
+/******************************************************************************/
+/*                             Add_FunctionType_Var_1                         */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the                                                     */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_FunctionType_Var_1(char *nom)
+{
+   listvar *newvar;
+
+   if ( firstpass == 1 )
+   {
+      curvar=createvar(nom,NULL);
+      strcpy(curvar->v_typevar,DeclType);
+      newvar = insertvar(NULL,curvar);
+      List_FunctionType_Var = AddListvarToListvar
+                              (newvar,List_FunctionType_Var,1);
+   }
+}
+
+
+/******************************************************************************/
+/*                      Add_SubroutineDeclaration_Var_1                       */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the listvarofsubroutine                                 */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
+{
+   if ( firstpass == 1 )
+   {
+      if ( VariableIsParameter == 0 &&
+           SaveDeclare         == 0 )
+      {
+         listduplicated = (listvar *)NULL;
+         duplicatelistvar(listtoadd);
+         List_SubroutineDeclaration_Var = AddListvarToListvar
+                              (listduplicated,List_SubroutineDeclaration_Var,1);
+      }
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/WriteInFile.c	(revision 3437)
@@ -0,0 +1,250 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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, char *s,int returnlineornot)
+{
+  char temp[61];
+  char *tmp;
+  int size;
+  int val_min;
+
+  if (strlen (s) <= 60)
+    {
+      if ( returnlineornot == 0 ) fprintf (filout, "     &%s", s);
+      else if ( returnlineornot == 2 ) fprintf (filout, "&%s", s);
+      else if ( returnlineornot == 3 ) fprintf (filout, "&%s\n", s);
+      else                             fprintf (filout, "     &%s\n", s);
+      if ( returnlineornot == 0 ||
+           returnlineornot == 2 ) colnum=colnum+strlen(s)+6;
+      else colnum=0;
+    }
+  else
+    {
+      val_min = 60;
+      strncpy (temp, s, 60);
+      strcpy (&temp[60], "\0");
+
+      tmp = strrchr(temp, '+');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '-');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '/');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '*');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '%');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, ',');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, ')');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '(');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+
+      size = val_min;
+
+      strcpy (&temp[60-size], "\0");
+
+      if ( retour77 == 0 ) fprintf (filout, "     &%s&\n", temp);
+      else fprintf (filout, "     &%s\n", temp);
+      colnum=0;
+      tofich_reste (filout, (char *) &s[60-size],returnlineornot);
+    }
+}
+
+/******************************************************************************/
+/*                            tofich                                          */
+/******************************************************************************/
+/* This subroutine is used to write the string s into the fileout             */
+/******************************************************************************/
+void tofich (FILE * filout, char *s, int returnlineornot)
+{
+  char temp[61];
+  char *tmp;
+  int size;
+  int val_min;
+
+  if (strlen (s) <= 60)
+    {
+      if ( returnlineornot == 0 ) fprintf (filout, "      %s", s);
+      else if ( returnlineornot == 2 ) fprintf (filout, "%s", s);
+      else if ( returnlineornot == 3 ) fprintf (filout, "%s\n", s);
+      else                             fprintf (filout, "      %s\n", s);
+      if ( returnlineornot == 0 || returnlineornot == 2 )
+                                                      colnum=colnum+strlen(s)+6;
+      else colnum=0;
+    }
+  else
+    {
+      val_min = 60;
+      strncpy (temp, s, 60);
+      strcpy (&temp[60], "\0");
+
+      tmp = strrchr(temp, '+');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '-');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '/');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '*');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '%');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, ',');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, ')');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+      tmp = strrchr(temp, '(');
+      if ( tmp )
+      if ( strlen(tmp) < val_min ) val_min = strlen(tmp);
+
+      size = val_min;
+
+      strcpy (&temp[60-size], "\0");
+
+      if ( retour77 == 0 ) fprintf (filout, "      %s&\n", temp);
+      else fprintf (filout, "      %s\n", temp);
+      colnum=0;
+      tofich_reste (filout, (char *) &s[60-size], returnlineornot);
+    }
+}
+
+/******************************************************************************/
+/*                       tofich_blanc                                         */
+/******************************************************************************/
+/* This subroutine is used to write size blank into the fileout               */
+/******************************************************************************/
+void tofich_blanc (FILE * filout, int size)
+{
+  int i;
+
+  if (size <= 65) fprintf (filout, "%*s\n",size,EmptyChar);
+  else
+  {
+      i=0;
+      do
+      {
+         fprintf (filout, "%*s\n",65,EmptyChar);
+         i = i+1;
+      } while ( i <= size / 65 );
+         fprintf (filout, "%*s\n",size%65,EmptyChar);
+  }
+
+}
+/******************************************************************************/
+/*                       tofich_line                                          */
+/******************************************************************************/
+/* This subroutine is used to write size blank into the fileout               */
+/******************************************************************************/
+void tofich_line (FILE * filout, int size, int long position)
+{
+  int i;
+  int retour;
+
+  if (size <= 65) fprintf (filout, "%*s",size,EmptyChar);
+  else
+  {
+      i=0;
+      do
+      {
+         fprintf (filout, "%*s",65,EmptyChar);
+         i = i+1;
+      } while ( i <= size / 65 );
+         fprintf (filout, "%*s",size%65,EmptyChar);
+  }
+
+   if ( !strstr(motparse1,"\n") ) retour=0;
+   else retour=1;
+
+   fseek(filout,position,SEEK_SET);
+   if (retour == 1 ) fprintf (filout, "\n");
+
+}
+
+
+/******************************************************************************/
+/*                           RemoveWordSET_0                                  */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordSET_0(FILE * filout, long int position, long int sizetoremove)
+{
+   if ( firstpass == 0 && couldaddvariable == 1 )
+   {
+      fseek(filout,position,SEEK_SET);
+      tofich_line(filout,sizetoremove,position);
+
+   }
+}
+
+
+/******************************************************************************/
+/*                         RemoveWordCUR_0                                    */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordCUR_0(FILE * filout, long int position, long int sizetoremove)
+{
+   if ( firstpass == 0  && couldaddvariable == 1 )
+   {
+      fseek(filout,position,SEEK_CUR);
+      tofich_blanc(filout,sizetoremove);
+
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/Writedeclarations.c	(revision 3437)
@@ -0,0 +1,704 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 ligne[LONG_4C], int visibility)
+{
+  char tmpligne[LONG_4C];
+
+  if ( !strcasecmp(v->v_typevar,"") )
+  {
+     printf("WARNING : The type of the variable %s \n",v->v_nomvar);
+     printf("          is unknown. CONV should define a type\n");
+  }
+  
+  sprintf (ligne, "%s", v->v_typevar);
+  if ( v->v_c_star == 1 ) strcat(ligne,"*");
+  
+  /* We should give the precision of the variable if it has been given        */
+  if ( strcasecmp(v->v_precision,"") )
+  {
+     sprintf(tmpligne,"(%s)",v->v_precision);
+     Save_Length(tmpligne,49);
+     strcat(ligne,tmpligne);
+  }
+  
+  if (strcasecmp(v->v_dimchar,""))
+  {
+     sprintf(tmpligne,"(%s)",v->v_dimchar);
+     Save_Length(tmpligne,49);
+     strcat(ligne,tmpligne);
+  }
+  
+  if ( strcasecmp(v->v_nameinttypename,"") )
+  {
+     sprintf(tmpligne,"*%s",v->v_nameinttypename);
+     Save_Length(tmpligne,49);
+     strcat(ligne,tmpligne);
+  }
+  if (strcasecmp (v->v_IntentSpec, ""))
+  {
+     sprintf(tmpligne,",INTENT(%s) ",v->v_IntentSpec);
+     Save_Length(tmpligne,49);
+     strcat(ligne,tmpligne);
+  }
+  if ( v->v_VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER");
+  if (visibility == 1)
+  {
+  if ( v->v_PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC");
+  if ( v->v_PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE");
+  }
+  if ( v->v_ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL");
+  if ( v->v_allocatable         == 1)
+       {strcat(ligne,", ALLOCATABLE");
+       }
+  if ( v->v_target         == 1)
+       {strcat(ligne,", TARGET");
+       }
+  if ( v->v_optionaldeclare     == 1 ) strcat(ligne,", OPTIONAL");
+  if ( v->v_pointerdeclare      == 1 ) strcat(ligne,", POINTER");
+  Save_Length(ligne,45);
+}
+
+
+/******************************************************************************/
+/*                         WriteScalarDeclaration                             */
+/******************************************************************************/
+/* This subroutine is used to write a scalar declaration                      */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*       integer variable ----------->   INTEGER :: VARIABLE                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteScalarDeclaration(variable *v,char ligne[LONG_4C])
+{
+
+  strcat (ligne, " :: ");
+  strcat (ligne, v->v_nomvar);
+  if ( strcasecmp(v->v_vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+  if ( v->v_VariableIsParameter == 1 )
+  {
+     strcat(ligne," = ");
+     strcat(ligne,v->v_initialvalue);
+  }
+  Save_Length(ligne,45);
+}
+
+
+/******************************************************************************/
+/*                         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_4C],int tmpok)
+{
+  char newname[LONG_4C];
+
+  strcat (ligne, ", Dimension(");
+
+  if ( v->v_dimensiongiven == 1 && tmpok == 1 )
+  {
+                                         strcat(ligne,v->v_readedlistdimension);
+                                         }
+  if ( v->v_dimensiongiven == 1 && tmpok == 0 )
+  {
+     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                                  (v->v_readedlistdimension,List_Global_Var,0));
+
+     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                                 (newname,List_Common_Var,0));
+
+     if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); 
+     
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                              (newname,List_ModuleUsed_Var,0));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+     Save_Length(newname,47);
+     strcat(ligne,newname);
+  }
+  strcat (ligne, ")");
+  strcat (ligne, " :: ");
+  strcat (ligne, v->v_nomvar);
+  if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+
+  if ( v->v_VariableIsParameter == 1 )
+  {
+     strcat(ligne," = ");
+     strcat(ligne,v->v_initialvalue);
+  }
+  Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                        writevardeclaration                                 */
+/******************************************************************************/
+/* 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 (listvar * var_record, FILE *fileout, int value, int visibility)
+{
+  FILE *filecommon;
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_4C];
+
+  filecommon=fileout;
+  newvar = var_record;
+  
+  if ( newvar->var->v_save == 0 || inmodulemeet == 0 )
+  {
+     v = newvar->var;
+     if (mark == 1) fprintf(fileout,"222222233333333\n");
+     WriteBeginDeclaration(v,ligne,visibility);
+
+     if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
+     else WriteTableDeclaration(v,ligne,value);
+
+     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+     }
+     
+     tofich (filecommon, ligne,1);
+     if (mark == 1) fprintf(fileout,"44444433333333\n");     
+  }
+  Save_Length(ligne,45);
+  
+}
+
+
+void WriteLocalParamDeclaration()
+{
+   listvar *parcours;
+
+   parcours = List_Parameter_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+      {
+         writevardeclaration(parcours,fortranout,0,1);
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+void WriteFunctionDeclaration(int value)
+{
+   listvar *parcours;
+
+   parcours = List_FunctionType_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+            strcasecmp(parcours->var->v_typevar,"")
+         )
+      {
+         writevardeclaration(parcours,fortranout,value,1);
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+void WriteSubroutineDeclaration(int value)
+{
+   listvar *parcours;
+
+   parcours = List_SubroutineDeclaration_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+           parcours->var->v_save == 0                                  &&
+           parcours->var->v_pointerdeclare == 0                        &&
+           parcours->var->v_VariableIsParameter == 0                   &&
+           parcours->var->v_common == 0
+         )
+      {
+         writevardeclaration(parcours,fortranout,value,1);
+
+      }
+      else if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+           parcours->var->v_save == 0                                  &&
+           parcours->var->v_VariableIsParameter == 0                   &&
+           parcours->var->v_common == 0
+              )
+      {
+         writevardeclaration(parcours,fortranout,value,1);
+
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+void WriteArgumentDeclaration_beforecall()
+{
+   int position;
+   listnom *neededparameter;
+   FILE *paramtoamr;
+   listvar *newvar;
+   char ligne[LONG_4C];
+
+   fprintf(fortranout,"#include \"Param_BeforeCall_%s.h\" \n",subroutinename);
+   /*                                                                         */
+   sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
+   paramtoamr = associate (ligne);
+   /*                                                                         */
+   neededparameter = (listnom * )NULL;
+   /*                                                                         */
+   position = 1;
+   newvar = List_SubroutineArgument_Var;
+   while ( newvar )
+   {
+      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
+                       newvar->var->v_positioninblock == position
+         )
+      {
+         position = position + 1;
+
+         writevardeclaration(newvar,fortranout,0,1);
+         neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                   paramtoamr,newvar->var,newvar->var->v_subroutinename,
+                   neededparameter,subroutinename);
+
+         newvar = List_SubroutineArgument_Var;
+      }
+      else newvar = newvar -> suiv;
+   }
+   Save_Length(ligne,45);
+   fclose(paramtoamr);
+}
+
+void WriteArgumentDeclaration_Sort()
+{
+   int position;
+   listvar *newvar;
+
+   /*                                                                         */
+   position = 1;
+   newvar = List_SubroutineArgument_Var;
+   while ( newvar )
+   {
+      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
+                       newvar->var->v_positioninblock == position
+         )
+      {
+         position = position + 1;
+
+         writevardeclaration(newvar,fortranout,1,1);
+         /*                                                                   */
+         newvar = List_SubroutineArgument_Var;
+      }
+      else newvar = newvar -> suiv;
+   }
+   /*                                                                         */
+   newvar = List_SubroutineArgument_Var;
+   while ( newvar )
+   {
+      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
+                       newvar->var->v_positioninblock == 0           &&
+                       newvar->var->v_nbdim == 0
+         )
+      {
+
+         writevardeclaration(newvar,fortranout,1,1);
+      }
+      newvar = newvar -> suiv;
+   }
+   /*                                                                         */
+   newvar = List_SubroutineArgument_Var;
+   while ( newvar )
+   {
+      if ( !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
+                       newvar->var->v_positioninblock == 0           &&
+                       newvar->var->v_nbdim != 0
+         )
+      {
+         writevardeclaration(newvar,fortranout,1,1);
+      }
+      newvar = newvar -> suiv;
+   }
+}
+
+/******************************************************************************/
+/*                      writedeclarationintoamr                               */
+/******************************************************************************/
+/* This subroutine is used to write the declaration of parameters needed in   */
+/*    allocation subroutines creates in toamr.c                               */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                              variable *var , char commonname[LONG_C],
+                           listnom *neededparameter, char name_common[LONG_C])
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_4C];
+  int changeval;
+  int out;
+  int writeit;
+  listnom *parcours;
+  listnom *parcoursprec;
+
+  parcoursprec = (listnom * )NULL;
+
+  /* we should list the needed parameter                                      */
+  if ( !strcasecmp(name_common,commonname) )
+     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,
+                                                               neededparameter);
+  /*                                                                          */
+  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;
+   }
+  /*                                                                          */
+  tofich (fileout, "",1);
+  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_4C];
+
+  tofich (fileout, "",1);
+  newvar = deb_common;
+
+  while (newvar)
+  {
+     if ( newvar->var->v_nbdim == 0 &&
+          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
+/*RB*/
+           (newvar->var->v_pointerdeclare == 0  || !strcasecmp(newvar->var->v_typevar,"type"))  
+/*RBend*/
+         )
+     {
+        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_4C];
+  int changeval;
+
+  tofich (fileout, "",1);
+  newvar = deb_common;
+  while (newvar)
+  {
+  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
+     if ( newvar->var->v_nbdim != 0                                 &&
+          !strcasecmp(newvar->var->v_subroutinename,subroutinename) &&
+          (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type"))
+        )
+     {
+        changeval = 0;
+        v = newvar->var;
+        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;
+listvar *parcours2;
+listvar *parcours3;
+int out;
+
+if (insubroutinedeclare == 1)
+{
+parcours = listdecl;
+while (parcours)
+{
+/*
+parcours2 = List_SubroutineArgument_Var;
+out = 0;
+while (parcours2 && out == 0)
+{
+if (!strcasecmp(parcours2->var->v_subroutinename,subroutinename) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
+ {
+ out = 1;
+ }
+parcours2 = parcours2->suiv;
+}
+*/
+out = LookingForVariableInList(List_SubroutineArgument_Var,parcours->var);
+if (out == 0) out = VariableIsInListCommon(parcours,List_Common_Var);
+
+
+
+if (out == 0) out = LookingForVariableInList(List_Parameter_Var,parcours->var);
+if (out == 0) out = LookingForVariableInList(List_FunctionType_Var,parcours->var);
+if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+
+/*
+parcours2 = List_Common_Var;
+while (parcours2 && out == 0)
+{
+if (!strcasecmp(parcours2->var->v_commoninfile,mainfile) && !strcasecmp(parcours2->var->v_nomvar,parcours->var->v_nomvar))
+ {
+ out = 1;
+ }
+parcours2 = parcours2->suiv;
+}
+*/
+//printf("nom = %s %d %d %d\n",parcours->var->v_nomvar,out,VariableIsParameter,SaveDeclare);
+if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) 
+
+{
+writevardeclaration(parcours,fortranout,1,1);
+}
+//if (firstpass == 1 && out == 1)
+if (firstpass == 1)
+  {
+  if (VariableIsParameter == 0 && SaveDeclare == 0)
+    {
+    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var,parcours->var);
+    }
+  }
+parcours = parcours->suiv;
+}
+}
+}
+
+void ReWriteDataStatement_0(FILE * filout)
+{
+listvar *parcours;
+int out;
+char ligne[LONG_C];
+char initialvalue[LONG_C];
+
+if (insubroutinedeclare == 1)
+{
+parcours = List_Data_Var_Cur ;
+while (parcours)
+{
+out = VariableIsInListCommon(parcours,List_Common_Var);
+if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+
+if (out == 0)
+{
+if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+{
+strcpy(initialvalue,parcours->var->v_initialvalue);
+}
+else
+{
+strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
+strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+}
+sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
+tofich(filout,ligne,1);
+}
+parcours = parcours->suiv;
+}
+}
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.lex	(revision 3437)
@@ -0,0 +1,87 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%s character
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+int line_num=1;
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+%}
+
+COMMENT "%"
+SEPARATEUR "::"
+NIMPORTEQUOI .
+COMMENTAIRES1 {COMMENT}{NIMPORTEQUOI}*{COMMENT}
+PROBTYPE "1D"|"2D"|"3D"
+USEITEM "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
+NAME [a-zA-Z\_][a-zA-Z0-9\_]*
+DIGIT [0-9]+
+NEXTLINE \n+[ \t]+"$"|\n+[ \t]+"&"
+%%
+parammodule return TOK_MODULEMAIN; /* name of the module                      */
+notgriddep  return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
+use         return TOK_USE;
+{COMMENTAIRES1}    {}
+{SEPARATEUR}        return TOK_SEP;
+{USEITEM}          {strcpy(yylval.na,yytext); return TOK_USEITEM;}
+{PROBTYPE}         {strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
+                                   /* dimension of the problem                */
+{NAME}             {strcpy(yylval.na,yytext); return TOK_NAME;}
+;|\,|\(|\)|:|\[|\] {return (int) *yytext;}
+\n                 {line_num++;return (int) *yytext;}
+[ \t]+ ;
+%%
+
+
+int yywrap()
+{
+}
+
+
+yyerror(char *s)
+{
+if (!strcasecmp(curfile,mainfile))
+{
+   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
+}
+else
+{
+   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
+}
+exit(0);
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y	(revision 3437)
@@ -0,0 +1,450 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%{
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+%}
+
+%union {
+       int ival;
+       char na[LONG_C];
+       listnom * ln;
+       }
+
+%token TOK_SEP
+%token TOK_USE
+%token TOK_MODULEMAIN      /* name of the module                              */
+%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
+%token <na> TOK_USEITEM
+%token <na> TOK_NAME
+%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
+%token ','
+%token ';'
+%token ':'
+%token '('
+%token ')'
+%token '['
+%token ']'
+%%
+input :
+      | input line
+;
+line :'\n'
+      | TOK_PROBTYPE TOK_NAME ';'                   {initdimprob(1,$2,"0","0");}
+      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'      {initdimprob(2,$2, $4,"0");}
+      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'
+                                                    {initdimprob(3,$2, $4, $6);}
+      | TOK_MODULEMAIN TOK_NAME ';'
+                             {listofmodules = Addtolistnom($2,listofmodules,0);
+                                                        Addmoduletothelist($2);}
+      | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'       {Add_NotGridDepend_Var_1($3);}
+      | TOK_USE TOK_USEITEM ';'  {
+                                    if (!strcasecmp($2,"FIXED_GRIDS"))
+                                                                 fixedgrids=1;
+                                    if (!strcasecmp($2,"ONLY_FIXED_GRIDS"))
+                                                             onlyfixedgrids=1;
+                                 }
+      ;
+%%
+
+int main(int argc,char *argv[])
+{
+   extern FILE * yyin ;
+   FILE *dependglobaloutput;
+   int i;
+   listnom *parcours;
+   listvar *newvar;
+   int stylegiven = 0;
+   int infreegiven ;
+   int infixedgiven ;
+   int lengthmainfile;
+
+   if (argc < 2)
+   {
+       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
+       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
+       printf(" [-free|-fixed]\n");
+       exit(0);
+   }
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+   List_Global_Var=(listvar *)NULL;
+   List_GlobalParameter_Var=(listvar *)NULL;
+   List_Allocate_Var=(listallocate *)NULL;
+   List_Common_Var=(listvar *)NULL;
+   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
+   List_Subroutine_For_Alloc=(listnom *)NULL;
+   List_Include=(listusemodule *)NULL;
+   List_NameOfModuleUsed=(listusemodule *)NULL;
+   listofmoduletmp=(listusemodule *)NULL;
+   List_SubroutineDeclaration_Var=(listvar *)NULL;
+   List_UsedInSubroutine_Var=(listvar *)NULL;
+   List_NotGridDepend_Var=(listvar *)NULL;
+   Listofavailableindices=(listindice *)NULL;
+   List_CouplePointed_Var=(listvarpointtovar *)NULL;
+   List_ModuleUsed_Var = (listvar *)NULL;
+   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
+   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
+   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
+   List_SubroutineArgument_Var = (listvar *)NULL;
+   List_FunctionType_Var = (listvar *)NULL;
+   tmpuselocallist = (listusemodule *)NULL;
+   List_ContainsSubroutine = (listnom *)NULL;
+   oldfortranout = (FILE *)NULL;
+
+   strcpy(mainfile,argv[1]);
+   strcpy(nomdir,"AGRIF_INC");
+   strcpy(commondirin,".");
+   strcpy(commondirout,".");
+   strcpy(filetoparse," ");
+   strcpy(subofagrifinitgrids,"");
+   strcpy(meetagrifinitgrids,"");
+   strcpy(mpiinitvar,"");
+
+   length_last = 0 ;
+   length_first = 0 ;
+   length_v_typevar = 0 ;
+   length_v_nomvar = 0 ;
+   length_v_dimchar = 0 ;
+   length_v_modulename = 0 ;
+   length_v_commonname = 0 ;
+   length_v_vallengspec = 0 ;
+   length_v_nameinttypename = 0 ;
+   length_v_commoninfile = 0 ;
+   length_v_subroutinename = 0 ;
+   length_v_precision = 0 ;
+   length_v_IntentSpec = 0 ;
+   length_v_initialvalue = 0 ;
+   length_v_readedlistdimension = 0 ;
+   length_u_usemodule = 0 ;
+   length_u_charusemodule = 0 ;
+   length_u_cursubroutine = 0 ;
+   length_u_modulename = 0 ;
+   length_n_name = 0 ;
+   length_c_namevar = 0 ;
+   length_c_namepointedvar = 0 ;
+   length_o_nom = 0 ;
+   length_o_module = 0 ;
+   length_a_nomvar = 0 ;
+   length_a_subroutine = 0 ;
+   length_a_module = 0 ;
+   length_t_usemodule = 0 ;
+   length_t_cursubroutine = 0 ;
+   length_curfilename = 0 ;
+   length_nomfileoutput = 0 ;
+   length_motparse = 0 ;
+   length_mainfile = 0 ;
+   length_nomdir = 0 ;
+   length_commondirout = 0 ;
+   length_commondirin = 0 ;
+   length_filetoparse = 0 ;
+   length_curbuf = 0 ;
+   length_toprintglob = 0 ;
+   length_tmpvargridname = 0 ;
+   length_ligne_Subloop = 0 ;
+   length_lvargridname_toamr = 0 ;
+   length_toprint_utilagrif = 0 ;
+   length_toprinttmp_utilchar = 0 ;
+   length_ligne_writedecl = 0 ;
+   length_newname_toamr = 0 ;
+   length_newname_writedecl = 0 ;
+   length_ligne_toamr = 0 ;
+   length_tmpligne_writedecl = 0 ;
+   value_char_size = 0 ;
+   value_char_size1 = 0 ;
+   value_char_size2 = 0 ;
+   value_char_size3 = 0 ;
+   inallocate = 0;
+   infixed = 1;
+   infree  = 0;
+
+   checkexistcommon=1;
+   todebug=0;
+   onlyfixedgrids=0;
+   fixedgrids=0;
+   InAgrifParentDef = 0;
+   IndicenbmaillesX=0;
+   IndicenbmaillesY=0;
+   IndicenbmaillesZ=0;
+   created_dimensionlist = 1;
+   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
+   SubloopScalar = 0;
+   todebug = 0;
+   todebugfree = 0;
+   retour77 = 1 ;
+   mark = 0 ;
+   shouldincludempif = 0 ;
+   Read_val_max();
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+   if ((yyin=fopen(argv[1],"r"))==NULL)
+   {
+      printf("the file %s doesn't exist \n",argv[1]);
+      exit(0);
+   }
+
+   i=2;
+   while (i<argc)
+   {
+      if (!strcasecmp(argv[i],"-incdir"))
+      {
+         strcpy(nomdir,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
+      {
+         strcpy(commondirin,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
+      {
+         strcpy(commondirout,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
+      {
+         strcpy(filetoparse,argv[i+1]);
+         i++;
+         lengthmainfile = strlen(filetoparse);
+         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
+         {
+         infixed = 0;
+         infree = 1;
+         }
+         else
+         {
+         infixed = 1;
+         infree = 0;
+         }
+      }
+      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
+      {
+         stylegiven = 1;
+         infreegiven  = 1 ;
+         infixedgiven = 0;
+      }   
+      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
+      {
+         stylegiven = 1;
+         infreegiven  = 0;
+         infixedgiven = 1;
+      }         
+      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
+      {
+         SubloopScalar = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
+      {
+         SubloopScalar = 2 ;
+      }
+      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
+      {
+         todebug = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
+      {
+         mark = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
+      {
+         todebugfree = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-rm"))
+      {
+         checkexistcommon=0;
+      }
+      else
+      {
+         printf("Unkwon option : %s\n",argv[i]);
+         exit(0);
+      }
+      i++;
+   }
+
+   if (stylegiven == 1) 
+   {
+   infree = infreegiven;
+   infixed = infixedgiven;   
+   }
+   Save_Length(nomdir,34);
+   Save_Length(commondirout,35);
+   Save_Length(commondirin,36);
+   Save_Length(filetoparse,37);
+
+/******************************************************************************/
+/*  3-  Parsing of the  conv file <name>.in                                   */
+/******************************************************************************/
+
+   if ((yyin=fopen(argv[1],"r"))==NULL)
+   {
+       printf("the file %s doesn't exist \n",argv[1]);
+       exit(0);
+   }
+   strcpy(mainfile,argv[1]);
+   Save_Length(mainfile,33);
+
+   if ( strstr(filetoparse,".f90") ||
+        strstr(filetoparse,".F90") ) retour77 = 0;
+
+   yyparse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
+   {
+      printf("the file %s doesn't exist \n",filetoparse);
+      exit(0);
+   }
+   /* mainfile : the name of the file to parse                                */
+   strcpy(mainfile,filetoparse);
+   /*                                                                         */
+   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
+   {
+      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
+      fclose(dependglobaloutput);
+   }
+   Readthedependavailablefile();
+   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
+   /*    nbmailleY and nbmailleZ                                              */
+   Readthedependnbxnbyfile();
+   Read_Subroutine_For_Alloc();
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+   /* Record all variable in list                                             */
+   firstpass = 1;
+   processfortran(filetoparse);
+   /*                                                                         */
+   CompleteThelistvarindoloop();
+   /* Read list of module used                                                */
+   RecordUseModulesVariables();
+   /* Read list of module used in module used                                 */
+   RecordUseModulesUseModulesVariables();
+   /* Save variables are considered as globals ones                           */
+   Update_List_Global_Var_From_List_Save_Var();
+   /* Update all lists                                                        */
+   ListUpdate();
+   /*                                                                         */
+   Clean_List_Global_Var();
+   /* Indice tabvars identification                                           */
+   IndiceTabvarsIdentification();
+   /* Update all lists                                                        */
+   ListUpdate();
+   /* The allocation subroutine is necessary ????                             */
+   New_Allocate_Subroutine_Is_Necessary();
+   /* The allocation subroutine is necessary for common list                  */
+   New_Allocate_Subroutine_For_Common_Is_Necessary();
+   /* Sort List_SubroutineArgument_Var                                        */
+   Sort_List_SubroutineArgument_Var();
+   /* Clean all lists                                                         */
+   ListClean();
+   /* Update Indice of List_UsedInSubroutine_Var from module used             */
+   List_UsedInSubroutine_Var_Update_From_Module_Used();
+   /* Update List_SubroutineWhereAgrifUsed                                    */
+   UpdateList_SubroutineWhereAgrifUsed();
+   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+   UpdateList_UsedInSubroutine_With_dimension();;
+   /*                                                                         */
+   ModifyThelistvarindoloop();
+   /*                                                                         */
+   UpdateListDeclarationWithDimensionList();
+   /*                                                                         */
+   GiveTypeOfVariables();
+   Affiche();
+   /* Build new subroutines                                                   */
+   firstpass = 0;
+   processfortran(filetoparse);
+
+   newvar = (listvar *)NULL;
+/*newvar = List_Global_Var; */
+   while ( newvar )
+   {
+      printf("++++ %s %d %s %s %s\n",
+      newvar->var->v_nomvar,
+      newvar->var->v_nbdim,
+      newvar->var->v_subroutinename,
+      newvar->var->v_modulename,
+      newvar->var->v_typevar
+             );
+      newvar = newvar->suiv;
+   }
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+   /* Write the .dependglobal_agrif file which contain the max indice         */
+   /*    of the tabvars table                                                 */
+   dependglobaloutput = fopen(".dependglobal_agrif","w");
+   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
+   fclose(dependglobaloutput);
+   /* Write the list of available indice                                      */
+   Writethedependavailablefile();
+   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+   /*    nbmailleY and nbmailleZ                                              */
+   Writethedependnbxnbyfile();
+   /* Write the .depend<namefile> file which contain general informations     */
+   /*    about variable of this file                                          */
+   parcours = List_NameOfModule;
+   while( parcours )
+   {
+      Writethedependlistofmoduleused(parcours->o_nom);
+      WritedependParameterList(parcours->o_nom);
+      Writethedependfile(parcours->o_nom,List_Global_Var);
+      parcours=parcours->suiv;
+   }
+   parcours = List_NameOfCommon;
+   while( parcours )
+   {
+      Writethedependfile(parcours->o_nom,List_Common_Var);
+      parcours=parcours->suiv;
+   }
+   Write_Subroutine_For_Alloc();
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+   creefichieramr(NameTamponfile);
+
+   Write_val_max();
+
+   if ( todebug == 1 ) printf("Out of CONV \n");
+   return 0;
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h	(revision 3437)
@@ -0,0 +1,746 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 LONGNOM 8000
+
+#define LONG_C 3000
+#define LONG_4C 4000
+#define LONG_4M 4000
+#define LONG_40M 4000000
+
+/******************************************************************************/
+/*********** Declaration of structures used in conv ***************************/
+/******************************************************************************/
+
+typedef struct
+{
+   char first[LONG_C];
+   char last[LONG_C];
+} 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_C];
+   char v_nomvar[LONG_C] ;
+   char v_oldname[LONG_C] ;
+   char v_dimchar[LONG_C];
+   char v_modulename[LONG_C];
+   char v_commonname[LONG_C];
+   char v_vallengspec[LONG_C];
+   char v_nameinttypename[LONG_C];
+   char v_commoninfile[LONG_C];
+   char v_subroutinename[LONG_C];
+   char v_precision[LONG_C];
+   char v_initialvalue[LONG_4C];
+   char v_IntentSpec[LONG_C];
+   char v_readedlistdimension[LONG_C];
+   int  v_nbdim;
+   int  v_common;
+   int  v_positioninblock;
+   int  v_module;
+   int  v_save;
+   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_C];
+   char u_charusemodule[LONG_C];
+   char u_cursubroutine[LONG_C];
+   char u_modulename[LONG_C];
+   int  u_firstuse;
+   struct listusemodule * suiv;
+} listusemodule;           /* list of names                                   */
+
+typedef struct listparameter
+{
+   char p_name[LONG_C];
+   char p_modulename[LONG_C];
+   struct listparameter * suiv;
+} listparameter ;           /* list of names                                  */
+
+typedef struct listname
+{
+   char n_name[LONG_C];
+   struct  listname* suiv;
+} listname ;            /* list of names                                  */
+
+typedef struct listcouple
+{
+   char c_namevar[LONG_C];
+   char c_namepointedvar[LONG_C];
+   struct listcouple * suiv;
+} listcouple;              /* list of names                                   */
+
+
+typedef struct listnom
+{
+   char o_nom[LONG_C];
+   char o_module[LONG_C];
+   char o_subroutinename[LONG_C];
+   int  o_val;
+   listcouple *couple;
+   struct listnom * suiv;
+} listnom;                 /* list of names                                   */
+
+
+typedef struct listallocate
+{
+   char a_nomvar[LONG_C];
+   char a_subroutine[LONG_C];
+   char a_module[LONG_C];
+   struct listallocate * suiv;
+} listallocate ;
+
+
+typedef struct listvarpointtovar
+{
+   char t_usemodule[LONG_C];
+   char t_cursubroutine[LONG_C];
+   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 *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  */
+
+ listdim *curdim;
+ listdim *commondim;
+
+/******************************************************************************/
+/****************   *** COMMON Variables ***  *********************************/
+/******************************************************************************/
+
+ int positioninblock;
+ char commonvar[LONG_C];
+ char commonblockname[LONG_C];
+
+/******************************************************************************/
+/****************   *** AGRIF Variables ***   *********************************/
+/******************************************************************************/
+ int inagrifcallargument;
+ int afterpercent;
+ int sameagrifargument;
+ int InAgrifParentDef;
+ char sameagrifname[LONG_C];
+/******************************************************************************/
+/****************   *** VAR DEF Variables ***   *******************************/
+/******************************************************************************/
+ int indicemaxtabvars;     /* Number of variables in the model i.e. last      */
+                           /*    indice used in  the tabvars table            */
+ int PublicDeclare;        /* Variable has been declared as PUBLIC */
+ int PrivateDeclare;       /* Variable has been declared as PRIVATE */
+ int ExternalDeclare;      /* Variable has been declared as EXTERNAL */
+ char InitialValueGiven[LONG_C];  
+ int Allocatabledeclare;
+ int Targetdeclare;
+ int SaveDeclare;
+ int functiondeclarationisdone;
+ int pointerdeclare;
+ int optionaldeclare;
+ int VarType;
+ int VarTypepar;
+ int VariableIsParameter;
+ int dimsgiven;
+ int shouldincludempif;
+ int c_star;
+ char DeclType[LONG_C];
+ char nameinttypename[LONG_C];
+ char nameinttypenameback[LONG_C]; 
+ int GlobalDeclaration;
+ int GlobalDeclarationType;
+ char InitValue[LONG_4C];
+ char IntentSpec[LONG_C];
+ char NamePrecision[LONG_C];
+ char CharacterSize[LONG_C];
+ char curmodulename[LONG_C];
+ char vallengspec[LONG_C];
+ char subroutinename[LONG_C];
+ int isrecursive;
+ char previoussubroutinename[LONG_C];
+
+/******************************************************************************/
+/****************   *** 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 mark;
+ int todebugfree;
+ int fixedgrids;           /* = 1 if fixedgrids is true                       */
+ char nbmaillesX[LONG_C]; /* number of cells in the x direction              */
+ char nbmaillesY[LONG_C]; /* number of cells in the y direction              */
+ char nbmaillesZ[LONG_C]; /* number of cells in the z direction              */
+ 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 colnum;
+ int callagrifinitgrids;
+ int callmpiinit;
+ int firstpass;
+ int couldaddvariable;
+ 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 checkexistcommon;
+ int insubroutinedeclare;
+ int ininterfacedeclare;
+ int inmoduledeclare;
+ int dimsempty;
+ int created_dimensionlist;
+ int incontainssubroutine;
+
+ char meetagrifinitgrids[LONG_C];
+ char mpiinitvar[LONG_C];
+ char *NameTamponfile;
+ char toprintglob[LONG_4C];
+ char tmpvargridname[LONG_4C];
+ char EmptyChar[2];        /* An empty char */
+ char curfilename[LONG_C];
+ char nomfileoutput[LONG_C];
+ char curbuf[LONG_40M];
+ char motparse[LONG_4C];
+ char motparse1[LONG_4C];
+ char charusemodule[LONG_C];
+ char subofagrifinitgrids[LONG_C];
+ char curfile[LONG_C];
+ char mainfile[LONG_C];
+ char nomdir[LONG_C];
+ char commondirout[LONG_C];
+ char commondirin[LONG_C];
+ char filetoparse[LONG_C];
+
+ FILE *fortranout;          /* Output File                                    */
+ FILE *fortranin;           /* Input File                                     */
+ FILE *oldfortranout;
+ FILE *subloop;
+ FILE *module_declar;
+ FILE *module_declar_type;
+ FILE *allocationagrif;
+ FILE *paramout;
+
+ 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_curinit;     /* current position in the output file             */
+ long int pos_curinclude;  /* final position of a line in file                */
+ long int pos_end;         /* final position of a line in file                */
+ long int pos_endsubroutine;
+                           /* final position of a line in file                */
+
+/* v_oldname = v_nomvar; */
+/* commonvar = v_nomvar; */
+/* commonblockname = v_commonname;*/
+/* sameagrifname = v_nomvar ; */
+/* DeclType = v_typevar; */
+/* nameinttypename = v_nameinttypename; */
+/* IntentSpec = v_IntentSpec; */
+/* NamePrecision = v_precision; */
+/* CharacterSize = v_dimchar; */
+/* curmodulename = v_modulename; */
+/* vallengspec = v_vallengspec; */
+/* subroutinename = v_subroutinename; */
+/* meetagrifinitgrids = v_subroutinename; */
+/* nbmaillesX = v_nomvar; */
+/* nbmaillesY = v_nomvar; */
+/* nbmaillesZ = v_nomvar; */
+/* mpiinitvar = v_nomvar; */
+/* EmptyChar = 2; */
+/* motparse1 = motparse;*/
+/* charusemodule = p_modulename; */
+/* subofagrifinitgrids = v_subroutinename; */
+/* curfile = mainfile; */
+/* InitValue = v_initialvalue; */
+
+/* p_name;???????? */
+/* p_modulename; ?????????????*/
+
+ int length_last;
+ int length_first;
+ int length_v_typevar;
+ int length_v_nomvar;
+ int length_v_dimchar;
+ int length_v_modulename;
+ int length_v_commonname;
+ int length_v_vallengspec;
+ int length_v_nameinttypename;
+ int length_v_commoninfile;
+ int length_v_subroutinename;
+ int length_v_precision;
+ int length_v_IntentSpec;
+ int length_v_initialvalue;
+ int length_v_readedlistdimension;
+ int length_u_usemodule;
+ int length_u_charusemodule;
+ int length_u_cursubroutine;
+ int length_u_modulename;
+ int length_n_name;
+ int length_c_namevar;
+ int length_c_namepointedvar;
+ int length_o_nom;
+ int length_o_module;
+ int length_a_nomvar;
+ int length_a_subroutine;
+ int length_a_module;
+ int length_t_usemodule;
+ int length_t_cursubroutine;
+ int length_curfilename;
+ int length_nomfileoutput;
+ int length_motparse;
+ int length_mainfile;
+ int length_nomdir;
+ int length_commondirout;
+ int length_commondirin;
+ int length_filetoparse;
+ int length_curbuf;
+ int length_toprintglob;
+ int length_tmpvargridname;
+ int length_ligne_Subloop;
+ int length_lvargridname_toamr;
+ int length_toprint_utilagrif;
+ int length_toprinttmp_utilchar;
+ int length_ligne_writedecl;
+ int length_newname_toamr;
+ int length_newname_writedecl;
+ int length_ligne_toamr;
+ int length_tmpligne_writedecl;
+ 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 *****************************/
+/***************************************************** ************************/
+/******************************************************************************/
+/*********** convert.y ********************************************************/
+/******************************************************************************/
+extern int main(int argc,char *argv[]);
+/******************************************************************************/
+/*********** fortran.y ********************************************************/
+/******************************************************************************/
+extern void processfortran(char *fichier_entree);
+/******************************************************************************/
+/*********** dependfile.c *****************************************************/
+/******************************************************************************/
+extern void Writethedependnbxnbyfile();
+extern void Readthedependnbxnbyfile();
+extern void Writethedependlistofmoduleused(char *NameTampon );
+extern void Readthedependlistofmoduleused(char *NameTampon);
+extern void WritedependParameterList(char *NameTampon );
+extern listparameter *ReaddependParameterList(char *NameTampon,
+                                                        listparameter *listout);
+extern void Writethedependfile(char *NameTampon, listvar *input );
+extern listvar *Readthedependfile( char *NameTampon , listvar *listout);
+extern void Write_Subroutine_For_Alloc();
+extern void Read_Subroutine_For_Alloc();
+extern void Writethedependavailablefile();
+extern void Readthedependavailablefile();
+extern int Did_filetoparse_readed(char *NameTampon);
+extern int Did_module_common_treaded(char *NameTampon);
+extern void Write_val_max();
+extern void Read_val_max();
+/******************************************************************************/
+/*********** DiversListe.c ****************************************************/
+/******************************************************************************/
+extern void Add_Common_var_1();
+extern listnom *Addtolistnom(char *nom, listnom *listin,int value);
+extern listname *Addtolistname(char *nom,listname *input);
+extern int ModuleIsDefineInInputFile(char *name);
+extern void Addmoduletothelisttmp(char *name);
+extern void Add_NameOfModule_1(char *nom);
+extern void Add_NameOfCommon_1(char *nom,char *cursubroutinename);
+extern void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple);
+extern void Add_Include_1(char *name);
+extern void Add_ImplicitNoneSubroutine_1();
+extern void WriteIncludeDeclaration();
+extern void Add_Save_Var_1 (char *name,listdim *d);
+extern void Add_Save_Var_dcl_1 (listvar *var);
+/******************************************************************************/
+/*********** SubLoopCreation.c ************************************************/
+/******************************************************************************/
+extern void writeheadnewsub_0();
+extern void WriteVariablelist_subloop(FILE *outputfile,char *ligne);
+extern void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne);
+extern void WriteVariablelist_subloop_Def(FILE *outputfile,char *ligne);
+extern void WriteHeadofSubroutineLoop();
+extern void closeandcallsubloopandincludeit_0(int suborfun);
+extern void closeandcallsubloop_contains_0();
+/******************************************************************************/
+/*********** toamr.c **********************************************************/
+/******************************************************************************/
+extern char *variablenameroottabvars (variable * var);
+extern char *variablenametabvars (variable * var, int iorindice);
+extern char *variablecurgridtabvars (variable * var,int ParentOrCurgrid);
+extern void WARNING_CharSize(variable *var);
+extern char *vargridnametabvars (variable * var,int iorindice);
+extern char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid);
+extern char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var);
+extern char *vargridparam (variable * v, int whichone);
+extern void 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_Setnumberofcells_file();
+extern void write_Getnumberofcells_file();
+extern void write_initialisationsagrif_file(variable *v,FILE *initproc,
+                                                             int *VarnameEmpty);
+extern void Write_Alloc_Agrif_Files();
+extern int IndiceInlist(int indic, listindice *listin);
+extern void write_allocation_Common_0();
+extern void write_allocation_Global_0();
+extern void creefichieramr (char *NameTampon);
+/******************************************************************************/
+/*********** UtilAgrif.c ******************************************************/
+/******************************************************************************/
+extern int Vartonumber(char *tokname);
+extern int Agrif_in_Tok_NAME(char *tokname);
+extern void ModifyTheVariableName_0(char *ident,int lengthname);
+extern void Add_SubroutineWhereAgrifUsed_1(char *sub,char *mod);
+extern void AddUseAgrifUtil_0(FILE *fileout);
+extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout);
+extern void NotifyAgrifFunction_0(char *ident);
+extern void ModifyTheAgrifFunction_0(char *ident);
+extern void AgriffunctionModify_0(char *ident,int whichone);
+extern void Instanciation_0(char *ident);
+/******************************************************************************/
+/*********** UtilCharacter.c **************************************************/
+/******************************************************************************/
+extern void FindAndChangeNameToTabvars(char name[LONG_C],char toprint[LONG_4C],
+                                             listvar * listtosee, int whichone);
+extern char *ChangeTheInitalvaluebyTabvarsName(char *nom,listvar *listtoread,
+                                                                  int whichone);
+extern int IsVariableReal(char *nom);
+extern void IsVarInUseFile(char *nom);
+extern listnom *DecomposeTheNameinlistnom(char *nom, listnom * listout);
+extern void DecomposeTheName(char *nom);
+extern void convert2lower(char *name);
+extern int convert2int(char *name);
+/******************************************************************************/
+/*********** UtilFile.c *******************************************************/
+/******************************************************************************/
+extern FILE * associate (char *filename);
+extern FILE * associateaplus (char *filename);
+extern long int setposcur();
+extern long int setposcurname(FILE *fileout);
+extern long int setposcurinoldfortranout();
+extern void copyuse_0(char *namemodule);
+extern void copyuseonly_0(char *namemodule);
+/******************************************************************************/
+/*********** UtilFortran.c ****************************************************/
+/******************************************************************************/
+extern void initdimprob(int dimprobmod, char * nx, char * ny,char* nz);
+extern int Variableshouldberemove(char *nom);
+extern int variableisglobal(listvar *curvar, listvar *listin);
+extern int VariableIsInListCommon(listvar *curvar,listvar *listin);
+extern int VariableIsInList(listvar *curvar,listvar *listin);
+extern void variableisglobalinmodule(listcouple *listin, char *module,
+                                                                 FILE *fileout,long int oldposcuruse);
+extern void Remove_Word_Contains_0();
+extern void Remove_Word_end_module_0(int modulenamelength);
+extern void Write_Word_Contains_0();
+extern void Write_Word_end_module_0();
+extern void Add_Subroutine_For_Alloc(char *nom);
+extern void Write_Alloc_Subroutine_0();
+extern void Write_Alloc_Subroutine_For_End_0();
+extern void Write_GlobalParameter_Declaration_0();
+extern void Write_GlobalType_Declaration_0();
+extern void Write_NotGridDepend_Declaration_0();
+extern 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 VariableIsNotFunction(char *ident);
+extern int varistyped_0(char *ident);
+/******************************************************************************/
+/*********** UtilListe.c ******************************************************/
+/******************************************************************************/
+extern void Init_Variable(variable *var);
+extern listvar * AddListvarToListvar(listvar *l,listvar *glob,
+                                                            int ValueFirstpass);
+extern void CreateAndFillin_Curvar(char *type,variable *curvar);
+extern void duplicatelistvar(listvar *orig);
+extern listdim * insertdim(listdim *lin,typedim nom);
+extern void change_dim_char(listdim *lin,listvar * l);
+extern int num_dims(listdim *d);
+extern variable * createvar(char *nom,listdim *d);
+extern listvar * insertvar(listvar *lin,variable *v);
+extern listvar *settype(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();
+/******************************************************************************/
+/*********** UtilNotGridDep.c *************************************************/
+/******************************************************************************/
+extern void Add_NotGridDepend_Var_1 (char *name);
+extern int VarIsNonGridDepend(char *name);
+/******************************************************************************/
+/*********** WorkWithAllocatelist.c *******************************************/
+/******************************************************************************/
+extern void Add_Allocate_Var_1(char *nom,char *nommodule);
+extern int IsVarAllocatable_0(char *ident);
+extern int varisallocatable_0(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(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(char *name);
+extern void WriteUsemoduleDeclaration(char *cursubroutinename);
+/******************************************************************************/
+/*********** WorkWithlistvarindoloop.c ****************************************/
+/******************************************************************************/
+extern void Add_UsedInSubroutine_Var_1 (char *ident);
+extern void ajoutevarindoloop_definedimension (char *name);
+extern void  ModifyThelistvarindoloop();
+extern void  CompleteThelistvarindoloop();
+extern void CopyRecord(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,char *var);
+extern int LookingForVariableInListGlob(listvar *listin,variable *var);
+extern int LookingForVariableInListParamGlob(listparameter *listin,
+                                                                 variable *var);
+extern void UpdateListDeclarationWithDimensionList();
+extern void Clean_List_UsedInSubroutine_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();
+extern int SubInList_ContainsSubroutine();
+/******************************************************************************/
+/*********** 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(char *nom);
+extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
+/******************************************************************************/
+/*********** Writedeclarations.c **********************************************/
+/******************************************************************************/
+extern void WriteBeginDeclaration(variable *v,char ligne[LONG_4C],int visibility);
+extern void WriteScalarDeclaration(variable *v,char ligne[LONG_4C]);
+extern void WriteTableDeclaration(variable * v,char ligne[LONG_4C],int tmpok);
+extern void writevardeclaration (listvar * var_record, FILE *fileout,
+                                                                     int value,int visibility);
+extern void WriteLocalParamDeclaration();
+extern void WriteFunctionDeclaration(int value);
+extern void WriteSubroutineDeclaration(int value);
+extern void WriteArgumentDeclaration_beforecall();
+extern void WriteArgumentDeclaration_Sort();
+extern listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                                       variable *var , char commonname[LONG_C],
+                           listnom *neededparameter, char name_common[LONG_C]);
+extern void writesub_loopdeclaration_scalar (listvar * deb_common,
+                                                                 FILE *fileout);
+extern void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout);
+extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl);
+extern void ReWriteDataStatement_0(FILE * filout);
+/******************************************************************************/
+/*********** WriteInFile.c ****************************************************/
+/******************************************************************************/
+extern void tofich_reste (FILE * filout, char *s,int returnlineornot);
+extern void tofich (FILE * filout, char *s, int returnlineornot);
+extern void tofich_blanc (FILE * filout, int size);
+extern void tofich_line (FILE * filout, int size, int long position);
+extern void RemoveWordSET_0(FILE * filout, long int position,
+                                                         long int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, long int position,
+                                                         long int sizetoremove);
+
+/******************************************************************************/
+/*********** WorkWithlistofcoupled.c **********************************************/
+/******************************************************************************/                                                        
+extern int variscoupled_0(char *ident) ;
+extern char * getcoupledname_0(char *ident);
+extern void ModifyTheVariableNamecoupled_0(char *ident, char* coupledident);
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/dependfile.c	(revision 3437)
@@ -0,0 +1,1150 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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 are looking for all the variable of the current filetoparse file      */
+  /*    in the List_Global_Var                                                */
+  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;
+     dependfileoutput = fopen(".dependnbxnby","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;
+
+  if ((dependfileoutput = fopen(".dependnbxnby","r"))!=NULL)
+  {
+     fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
+     if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
+     if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
+     fclose(dependfileoutput);
+  }
+}
+
+/******************************************************************************/
+/*                     Writethedependlistofmoduleused                         */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependlistofmoduleused(char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listusemodule *parcours;
+  char ligne[LONG_C];
+
+
+  if ( List_NameOfModuleUsed )
+  {
+     convert2lower(NameTampon);
+     sprintf(ligne,".dependuse%s",NameTampon);
+     dependfileoutput = fopen(ligne,"w");
+     /*                                                                       */
+     parcours = List_NameOfModuleUsed;
+     while (parcours)
+     {
+        if ( !strcasecmp(NameTampon,parcours->u_modulename) &&
+             !strcasecmp(parcours->u_cursubroutine,"")
+           )
+        {
+           /* We are looking for all the variable of the current              */
+           /*    filetoparse file in the List_Global_Var                      */
+           fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+        }
+        parcours = parcours->suiv;
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+/******************************************************************************/
+/*                    Readthedependlistofmoduleused                           */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependlistofmoduleused(char *NameTampon)
+{
+  FILE *dependfileoutput;
+  listusemodule *parcours;
+  char ligne[LONG_C];
+
+  convert2lower(NameTampon);
+  sprintf(ligne,".dependuse%s",NameTampon);
+
+  tmpuselocallist = (listusemodule *)NULL;
+  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  {
+  }
+  else
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listusemodule *)malloc(sizeof(listusemodule));
+         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
+
+         parcours->suiv = tmpuselocallist;
+         tmpuselocallist = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WritedependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void WritedependParameterList(char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  char ligne[LONG_C];
+
+  if ( List_GlobalParameter_Var )
+  {
+     convert2lower(NameTampon);
+     sprintf(ligne,".dependparameter%s",NameTampon);
+     dependfileoutput = fopen(ligne,"w");
+     /*                                                                       */
+     parcours = List_GlobalParameter_Var;
+     while (parcours)
+     {
+        if ( !strcasecmp(NameTampon,parcours->var->v_modulename) )
+        {
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+        }
+        parcours = parcours->suiv;
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                         ReaddependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+listparameter *ReaddependParameterList(char *NameTampon,listparameter *listout)
+{
+  FILE *dependfileoutput;
+  listparameter *parcours;
+  char ligne[LONG_C];
+
+  convert2lower(NameTampon);
+  sprintf(ligne,".dependparameter%s",NameTampon);
+
+  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  {
+  }
+  else
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listparameter *)malloc(sizeof(listparameter));
+         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(char *NameTampon, listvar *input )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  listdim *dims;
+  char ligne[LONG_C];
+  char listdimension[LONG_C];
+  char curname[LONG_C];
+  int out;
+
+  if ( input )
+  {
+  convert2lower(NameTampon);
+
+  sprintf(ligne,".depend%s",NameTampon);
+  dependfileoutput = fopen(ligne,"w");
+  /* We are looking for all the variable of the current filetoparse file      */
+  /*    in the input                                                          */
+  parcours =input;
+  out = 0;
+  strcpy(curname,"");
+  while (parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->var->v_modulename,NameTampon) ||
+          !strcasecmp(parcours->var->v_commonname,NameTampon) )
+     {
+        /*                                                                    */
+        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);
+           /********** 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;
+              }
+              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( char *NameTampon , listvar *listout)
+{
+  char ligne[LONG_C];
+  FILE *dependfileoutput;
+  listvar *parcours0;
+  listvar *parcours;
+  listvar *parcoursprec;
+  char nothing[LONG_C];
+  int i;
+
+  parcoursprec = (listvar *)NULL;
+
+  convert2lower(NameTampon);
+  sprintf(ligne,".depend%s",NameTampon);
+  if ((dependfileoutput = fopen(ligne,"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 *)malloc(sizeof(listvar));
+         parcours->var=(variable *)malloc(sizeof(variable));
+         /*                                                                   */
+         Init_Variable(parcours->var);
+         /*                                                                   */
+           /********** TYPEVAR ************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** 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);
+         
+         printf("MODULENAME = %s %s\n",parcours->var->v_nomvar,parcours->var->v_modulename);
+         
+         if ( !strcasecmp(parcours->var->v_modulename,"T") )
+         {
+            strcpy(parcours->var->v_modulename,"");
+         }
+         
+
+           /********** NBDIM **************************************************/
+/*         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 )
+   {
+      if ((dependfileoutput=fopen(".dependAllocAgrif","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;
+  if ((dependfileoutput=fopen(".dependAllocAgrif","r"))!=NULL)
+  {
+     List_Subroutine_For_Alloc = (listnom *)NULL;
+     while (!feof(dependfileoutput))
+     {
+        parcours=(listnom *)malloc(sizeof(listnom));
+        strcpy(parcours->o_nom,"");
+
+        fscanf(dependfileoutput,"%s\n",&parcours->o_nom);
+        parcours->suiv = NULL;
+
+        if ( !List_Subroutine_For_Alloc )
+        {
+           List_Subroutine_For_Alloc = parcours;
+           ref = parcours;
+        }
+        else
+        {
+            ref->suiv = parcours;
+            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;
+
+  if ((dependfileoutput=fopen(".dependavailable","w"))!=NULL)
+  {
+     /* We are looking for all the indices of the Listofavailableindices      */
+     parcours = Listofavailableindices;
+     while (parcours)
+     {
+        if ( parcours->i_indice != 0 )
+        {
+           fprintf(dependfileoutput,"%d\n",parcours->i_indice);
+        }
+        parcours = parcours->suiv;
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+/******************************************************************************/
+/*                        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;
+
+  if ((dependfileoutput=fopen(".dependavailable","r"))!=NULL)
+  {
+     /* We are looking for all the indices of the Listofavailableindices      */
+     Listofavailableindices = (listindice *)NULL;
+     while (!feof(dependfileoutput))
+     {
+        parcours=(listindice *)malloc(sizeof(listindice));
+        fscanf(dependfileoutput,"%d\n",&parcours->i_indice);
+        if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 )
+        {
+           parcours -> suiv = Listofavailableindices;
+           Listofavailableindices = parcours;
+        }
+        else
+        {
+           free(parcours);
+        }
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                      Did_filetoparse_readed                                */
+/******************************************************************************/
+/* This subroutine is used to know if the .depend<NameTampon> exist           */
+/*    it means if the file has been ever parsed                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int Did_filetoparse_readed(char *NameTampon)
+{
+  FILE *dependfileoutput;
+  char ligne[LONG_C];
+  int out;
+
+  convert2lower(NameTampon);
+  sprintf(ligne,".depend%s",NameTampon);
+  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  {
+      out = 0;
+  }
+  else
+  {
+      out = 1;
+      fclose(dependfileoutput);
+  }
+  return out;
+}
+
+
+/******************************************************************************/
+/*                      Did_module_common_treaded                             */
+/******************************************************************************/
+/* This subroutine is used to know if the .depend<NameTampon> exist           */
+/*    it means if the file has been ever parsed                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int Did_module_common_treaded(char *NameTampon)
+{
+  FILE *dependfileoutput;
+  char ligne[LONG_C];
+  int out;
+
+  convert2lower(NameTampon);
+  sprintf(ligne,".depend%s",NameTampon);
+  if ((dependfileoutput = fopen(ligne,"r"))==NULL)
+  {
+      out = 0;
+  }
+  else
+  {
+      out = 1;
+      fclose(dependfileoutput);
+  }
+  return out;
+}
+
+
+
+void Write_val_max()
+{
+  FILE *dependfileoutput;
+
+  if ((dependfileoutput=fopen(".dependvalmax","w"))!=NULL)
+  {
+     fprintf(dependfileoutput,"length_last\n");
+     fprintf(dependfileoutput,"%d\n",length_last);
+     fprintf(dependfileoutput,"length_first\n");
+     fprintf(dependfileoutput,"%d\n",length_first);
+     fprintf(dependfileoutput,"length_v_typevar\n");
+     fprintf(dependfileoutput,"%d\n",length_v_typevar);
+     fprintf(dependfileoutput,"length_v_nomvar\n");
+     fprintf(dependfileoutput,"%d\n",length_v_nomvar);
+     fprintf(dependfileoutput,"length_v_dimchar\n");
+     fprintf(dependfileoutput,"%d\n",length_v_dimchar);
+     fprintf(dependfileoutput,"length_v_modulename\n");
+     fprintf(dependfileoutput,"%d\n",length_v_modulename);
+     fprintf(dependfileoutput,"length_v_commonname\n");
+     fprintf(dependfileoutput,"%d\n",length_v_commonname);
+     fprintf(dependfileoutput,"length_v_vallengspec\n");
+     fprintf(dependfileoutput,"%d\n",length_v_vallengspec);
+     fprintf(dependfileoutput,"length_v_nameinttypename\n");
+     fprintf(dependfileoutput,"%d\n",length_v_nameinttypename);
+     fprintf(dependfileoutput,"length_v_commoninfile\n");
+     fprintf(dependfileoutput,"%d\n",length_v_commoninfile);
+     fprintf(dependfileoutput,"length_v_subroutinename\n");
+     fprintf(dependfileoutput,"%d\n",length_v_subroutinename);
+     fprintf(dependfileoutput,"length_v_precision\n");
+     fprintf(dependfileoutput,"%d\n",length_v_precision);
+     fprintf(dependfileoutput,"length_v_IntentSpec\n");
+     fprintf(dependfileoutput,"%d\n",length_v_IntentSpec);
+     fprintf(dependfileoutput,"length_v_initialvalue\n");
+     fprintf(dependfileoutput,"%d\n",length_v_initialvalue);
+     fprintf(dependfileoutput,"length_v_readedlistdimension\n");
+     fprintf(dependfileoutput,"%d\n",length_v_readedlistdimension);
+     fprintf(dependfileoutput,"length_u_usemodule\n");
+     fprintf(dependfileoutput,"%d\n",length_u_usemodule);
+     fprintf(dependfileoutput,"length_u_charusemodule\n");
+     fprintf(dependfileoutput,"%d\n",length_u_charusemodule);
+     fprintf(dependfileoutput,"length_u_cursubroutine\n");
+     fprintf(dependfileoutput,"%d\n",length_u_cursubroutine);
+     fprintf(dependfileoutput,"length_u_modulename\n");
+     fprintf(dependfileoutput,"%d\n",length_u_modulename);
+     fprintf(dependfileoutput,"length_n_name\n");
+     fprintf(dependfileoutput,"%d\n",length_n_name);
+     fprintf(dependfileoutput,"length_c_namevar\n");
+     fprintf(dependfileoutput,"%d\n",length_c_namevar);
+     fprintf(dependfileoutput,"length_c_namepointedvar\n");
+     fprintf(dependfileoutput,"%d\n",length_c_namepointedvar);
+     fprintf(dependfileoutput,"length_o_nom\n");
+     fprintf(dependfileoutput,"%d\n",length_o_nom);
+     fprintf(dependfileoutput,"length_o_module\n");
+     fprintf(dependfileoutput,"%d\n",length_o_module);
+     fprintf(dependfileoutput,"length_a_nomvar\n");
+     fprintf(dependfileoutput,"%d\n",length_a_nomvar);
+     fprintf(dependfileoutput,"length_a_subroutine\n");
+     fprintf(dependfileoutput,"%d\n",length_a_subroutine);
+     fprintf(dependfileoutput,"length_a_module\n");
+     fprintf(dependfileoutput,"%d\n",length_a_module);
+     fprintf(dependfileoutput,"length_usemodule\n");
+     fprintf(dependfileoutput,"%d\n",length_t_usemodule);
+     fprintf(dependfileoutput,"length_cursubroutine\n");
+     fprintf(dependfileoutput,"%d\n",length_t_cursubroutine);
+     fprintf(dependfileoutput,"length_curfilename\n");
+     fprintf(dependfileoutput,"%d\n",length_curfilename);
+     fprintf(dependfileoutput,"length_nomfileoutput\n");
+     fprintf(dependfileoutput,"%d\n",length_nomfileoutput);
+     fprintf(dependfileoutput,"length_motparse\n");
+     fprintf(dependfileoutput,"%d\n",length_motparse);
+     fprintf(dependfileoutput,"length_mainfile\n");
+     fprintf(dependfileoutput,"%d\n",length_mainfile);
+     fprintf(dependfileoutput,"length_nomdir\n");
+     fprintf(dependfileoutput,"%d\n",length_nomdir);
+     fprintf(dependfileoutput,"length_commondirout\n");
+     fprintf(dependfileoutput,"%d\n",length_commondirout);
+     fprintf(dependfileoutput,"length_commondirin\n");
+     fprintf(dependfileoutput,"%d\n",length_commondirin);
+     fprintf(dependfileoutput,"length_filetoparse\n");
+     fprintf(dependfileoutput,"%d\n",length_filetoparse);
+     fprintf(dependfileoutput,"length_curbuf\n");
+     fprintf(dependfileoutput,"%d\n",length_curbuf);
+     fprintf(dependfileoutput,"length_toprintglob\n");
+     fprintf(dependfileoutput,"%d\n",length_toprintglob);
+     fprintf(dependfileoutput,"Size_char0d\n");
+     fprintf(dependfileoutput,"%d\n",value_char_size);
+     fprintf(dependfileoutput,"Size_char1d\n");
+     fprintf(dependfileoutput,"%d\n",value_char_size1);
+     fprintf(dependfileoutput,"Size_char2d\n");
+     fprintf(dependfileoutput,"%d\n",value_char_size2);
+     fprintf(dependfileoutput,"Size_char3d\n");
+     fprintf(dependfileoutput,"%d\n",value_char_size3);
+     fprintf(dependfileoutput,"length_tmpvargridname\n");
+     fprintf(dependfileoutput,"%d\n",length_tmpvargridname);
+     fprintf(dependfileoutput,"length_ligne_Subloop\n");
+     fprintf(dependfileoutput,"%d\n",length_ligne_Subloop);
+     fprintf(dependfileoutput,"length_lvargridname_toamr\n");
+     fprintf(dependfileoutput,"%d\n",length_lvargridname_toamr);
+     fprintf(dependfileoutput,"length_toprint_toamr\n");
+     fprintf(dependfileoutput,"%d\n",length_toprint_utilagrif);
+     fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
+     fprintf(dependfileoutput,"%d\n",length_toprinttmp_utilchar);
+     fprintf(dependfileoutput,"length_ligne_writedecl\n");
+     fprintf(dependfileoutput,"%d\n",length_ligne_writedecl);
+     fprintf(dependfileoutput,"length_newname_toamr\n");
+     fprintf(dependfileoutput,"%d\n",length_newname_toamr);
+     fprintf(dependfileoutput,"length_newname_writedecl\n");
+     fprintf(dependfileoutput,"%d\n",length_newname_writedecl);
+     fprintf(dependfileoutput,"length_ligne_toamr\n");
+     fprintf(dependfileoutput,"%d\n",length_ligne_toamr);
+     fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
+     fprintf(dependfileoutput,"%d\n",length_tmpligne_writedecl);
+/*     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);
+     fprintf(dependfileoutput,"\n");
+     fprintf(dependfileoutput,"%d\n",);*/
+
+     fclose(dependfileoutput);
+  }
+}
+
+
+void Read_val_max()
+{
+  char nothing[LONG_C];
+  FILE *dependfileoutput;
+
+  if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
+  {
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_last);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_first);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_typevar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_nomvar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_dimchar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_modulename);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_commonname);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_vallengspec);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_nameinttypename);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_commoninfile);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_subroutinename);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_precision);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_IntentSpec);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_initialvalue);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_v_readedlistdimension);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_u_usemodule);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_u_charusemodule);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_u_cursubroutine);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_u_modulename);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_n_name);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_c_namevar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_c_namepointedvar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_o_nom);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_o_module);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_a_nomvar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_a_subroutine);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_a_module);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_t_usemodule);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_t_cursubroutine);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_curfilename);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_nomfileoutput);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_motparse);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_mainfile);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_nomdir);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_commondirout);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_commondirin);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_filetoparse);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_curbuf);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_toprintglob);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&value_char_size);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&value_char_size1);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&value_char_size2);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&value_char_size3);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_tmpvargridname);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_ligne_Subloop);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_lvargridname_toamr);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_toprint_utilagrif);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_toprinttmp_utilchar);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_ligne_writedecl);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_newname_toamr);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_newname_writedecl);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_ligne_toamr);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&length_tmpligne_writedecl);
+/*     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);
+     fscanf(dependfileoutput,"%s\n",nothing);
+     fscanf(dependfileoutput,"%d\n",&);*/
+
+     fclose(dependfileoutput);
+  }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.c	(revision 3437)
@@ -0,0 +1,12111 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse fortranparse
+#define yylex   fortranlex
+#define yyerror fortranerror
+#define yylval  fortranlval
+#define yychar  fortranchar
+#define yydebug fortrandebug
+#define yynerrs fortrannerrs
+
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_BINARY_OP = 258,
+     TOK_NEQV = 259,
+     TOK_EQV = 260,
+     TOK_XOR = 261,
+     TOK_OR = 262,
+     TOK_AND = 263,
+     TOK_NOT = 264,
+     TOK_NE = 265,
+     TOK_EQ = 266,
+     TOK_GE = 267,
+     TOK_LE = 268,
+     TOK_GT = 269,
+     TOK_LT = 270,
+     TOK_UNARY_OP = 271,
+     TOK_DSLASH = 272,
+     TOK_SLASH = 273,
+     TOK_DASTER = 274,
+     TOK_SEP = 275,
+     TOK_SEMICOLON = 276,
+     TOK_NEXTLINE = 277,
+     TOK_PARAMETER = 278,
+     TOK_RESULT = 279,
+     TOK_ONLY = 280,
+     TOK_INCLUDE = 281,
+     TOK_SUBROUTINE = 282,
+     TOK_PROGRAM = 283,
+     TOK_FUNCTION = 284,
+     TOK_OMP = 285,
+     TOK_DOLLAR = 286,
+     TOK_FORMAT = 287,
+     TOK_MAX = 288,
+     TOK_TANH = 289,
+     TOK_WHERE = 290,
+     TOK_ELSEWHERE = 291,
+     TOK_ENDWHERE = 292,
+     TOK_MAXVAL = 293,
+     TOK_TRIM = 294,
+     TOK_SUM = 295,
+     TOK_SQRT = 296,
+     TOK_CASE = 297,
+     TOK_SELECTCASE = 298,
+     TOK_FILE = 299,
+     TOK_END = 300,
+     TOK_ERR = 301,
+     TOK_DONOTTREAT = 302,
+     TOK_ENDDONOTTREAT = 303,
+     TOK_EXIST = 304,
+     TOK_MIN = 305,
+     TOK_FLOAT = 306,
+     TOK_EXP = 307,
+     TOK_COS = 308,
+     TOK_COSH = 309,
+     TOK_ACOS = 310,
+     TOK_NINT = 311,
+     TOK_CYCLE = 312,
+     TOK_SIN = 313,
+     TOK_SINH = 314,
+     TOK_ASIN = 315,
+     TOK_EQUIVALENCE = 316,
+     TOK_BACKSPACE = 317,
+     TOK_LOG = 318,
+     TOK_TAN = 319,
+     TOK_ATAN = 320,
+     TOK_RECURSIVE = 321,
+     TOK_ABS = 322,
+     TOK_MOD = 323,
+     TOK_SIGN = 324,
+     TOK_MINLOC = 325,
+     TOK_MAXLOC = 326,
+     TOK_EXIT = 327,
+     TOK_MINVAL = 328,
+     TOK_PUBLIC = 329,
+     TOK_PRIVATE = 330,
+     TOK_ALLOCATABLE = 331,
+     TOK_RETURN = 332,
+     TOK_THEN = 333,
+     TOK_ELSEIF = 334,
+     TOK_ELSE = 335,
+     TOK_ENDIF = 336,
+     TOK_PRINT = 337,
+     TOK_PLAINGOTO = 338,
+     TOK_CONSTRUCTID = 339,
+     TOK_LOGICALIF = 340,
+     TOK_PLAINDO = 341,
+     TOK_CONTAINS = 342,
+     TOK_ENDDO = 343,
+     TOK_MODULE = 344,
+     TOK_ENDMODULE = 345,
+     TOK_DOWHILE = 346,
+     TOK_ALLOCATE = 347,
+     TOK_OPEN = 348,
+     TOK_CLOSE = 349,
+     TOK_INQUIRE = 350,
+     TOK_WRITE = 351,
+     TOK_READ = 352,
+     TOK_REWIND = 353,
+     TOK_DEALLOCATE = 354,
+     TOK_NULLIFY = 355,
+     TOK_FIN = 356,
+     TOK_DEBUT = 357,
+     TOK_DIMENSION = 358,
+     TOK_ENDSELECT = 359,
+     TOK_EXTERNAL = 360,
+     TOK_INTENT = 361,
+     TOK_INTRINSIC = 362,
+     TOK_NAMELIST = 363,
+     TOK_CASEDEFAULT = 364,
+     TOK_OPTIONAL = 365,
+     TOK_POINTER = 366,
+     TOK_CONTINUE = 367,
+     TOK_SAVE = 368,
+     TOK_TARGET = 369,
+     TOK_QUOTE = 370,
+     TOK_IMPLICIT = 371,
+     TOK_NONE = 372,
+     TOK_CALL = 373,
+     TOK_STAT = 374,
+     TOK_POINT_TO = 375,
+     TOK_COMMON = 376,
+     TOK_GLOBAL = 377,
+     TOK_INTERFACE = 378,
+     TOK_ENDINTERFACE = 379,
+     TOK_LEFTAB = 380,
+     TOK_RIGHTAB = 381,
+     TOK_PAUSE = 382,
+     TOK_PROCEDURE = 383,
+     TOK_STOP = 384,
+     TOK_NAMEEQ = 385,
+     TOK_REAL8 = 386,
+     TOK_OUT = 387,
+     TOK_INOUT = 388,
+     TOK_IN = 389,
+     TOK_USE = 390,
+     TOK_TRUE = 391,
+     TOK_FALSE = 392,
+     TOK_LABEL = 393,
+     TOK_TYPE = 394,
+     TOK_TYPEPAR = 395,
+     TOK_ENDTYPE = 396,
+     TOK_REAL = 397,
+     TOK_INTEGER = 398,
+     TOK_LOGICAL = 399,
+     TOK_DOUBLEPRECISION = 400,
+     TOK_DOUBLEREAL = 401,
+     TOK_ENDSUBROUTINE = 402,
+     TOK_ENDFUNCTION = 403,
+     TOK_ENDPROGRAM = 404,
+     TOK_ENDUNIT = 405,
+     TOK_CHARACTER = 406,
+     TOK_CHAR_CONSTANT = 407,
+     TOK_CHAR_CUT = 408,
+     TOK_DATA = 409,
+     TOK_CHAR_INT = 410,
+     TOK_CHAR_MESSAGE = 411,
+     TOK_CSTREAL = 412,
+     TOK_CSTREALDP = 413,
+     TOK_CSTREALQP = 414,
+     TOK_SFREAL = 415,
+     TOK_COMPLEX = 416,
+     TOK_DOUBLECOMPLEX = 417,
+     TOK_NAME = 418,
+     TOK_NAME_CHAR = 419,
+     TOK_PROBTYPE = 420,
+     TOK_INTERPTYPE = 421,
+     TOK_VARTYPE = 422,
+     TOK_BC = 423,
+     TOK_OP = 424,
+     TOK_CSTINT = 425,
+     TOK_COMMENT = 426,
+     TOK_FILENAME = 427
+   };
+#endif
+/* Tokens.  */
+#define TOK_BINARY_OP 258
+#define TOK_NEQV 259
+#define TOK_EQV 260
+#define TOK_XOR 261
+#define TOK_OR 262
+#define TOK_AND 263
+#define TOK_NOT 264
+#define TOK_NE 265
+#define TOK_EQ 266
+#define TOK_GE 267
+#define TOK_LE 268
+#define TOK_GT 269
+#define TOK_LT 270
+#define TOK_UNARY_OP 271
+#define TOK_DSLASH 272
+#define TOK_SLASH 273
+#define TOK_DASTER 274
+#define TOK_SEP 275
+#define TOK_SEMICOLON 276
+#define TOK_NEXTLINE 277
+#define TOK_PARAMETER 278
+#define TOK_RESULT 279
+#define TOK_ONLY 280
+#define TOK_INCLUDE 281
+#define TOK_SUBROUTINE 282
+#define TOK_PROGRAM 283
+#define TOK_FUNCTION 284
+#define TOK_OMP 285
+#define TOK_DOLLAR 286
+#define TOK_FORMAT 287
+#define TOK_MAX 288
+#define TOK_TANH 289
+#define TOK_WHERE 290
+#define TOK_ELSEWHERE 291
+#define TOK_ENDWHERE 292
+#define TOK_MAXVAL 293
+#define TOK_TRIM 294
+#define TOK_SUM 295
+#define TOK_SQRT 296
+#define TOK_CASE 297
+#define TOK_SELECTCASE 298
+#define TOK_FILE 299
+#define TOK_END 300
+#define TOK_ERR 301
+#define TOK_DONOTTREAT 302
+#define TOK_ENDDONOTTREAT 303
+#define TOK_EXIST 304
+#define TOK_MIN 305
+#define TOK_FLOAT 306
+#define TOK_EXP 307
+#define TOK_COS 308
+#define TOK_COSH 309
+#define TOK_ACOS 310
+#define TOK_NINT 311
+#define TOK_CYCLE 312
+#define TOK_SIN 313
+#define TOK_SINH 314
+#define TOK_ASIN 315
+#define TOK_EQUIVALENCE 316
+#define TOK_BACKSPACE 317
+#define TOK_LOG 318
+#define TOK_TAN 319
+#define TOK_ATAN 320
+#define TOK_RECURSIVE 321
+#define TOK_ABS 322
+#define TOK_MOD 323
+#define TOK_SIGN 324
+#define TOK_MINLOC 325
+#define TOK_MAXLOC 326
+#define TOK_EXIT 327
+#define TOK_MINVAL 328
+#define TOK_PUBLIC 329
+#define TOK_PRIVATE 330
+#define TOK_ALLOCATABLE 331
+#define TOK_RETURN 332
+#define TOK_THEN 333
+#define TOK_ELSEIF 334
+#define TOK_ELSE 335
+#define TOK_ENDIF 336
+#define TOK_PRINT 337
+#define TOK_PLAINGOTO 338
+#define TOK_CONSTRUCTID 339
+#define TOK_LOGICALIF 340
+#define TOK_PLAINDO 341
+#define TOK_CONTAINS 342
+#define TOK_ENDDO 343
+#define TOK_MODULE 344
+#define TOK_ENDMODULE 345
+#define TOK_DOWHILE 346
+#define TOK_ALLOCATE 347
+#define TOK_OPEN 348
+#define TOK_CLOSE 349
+#define TOK_INQUIRE 350
+#define TOK_WRITE 351
+#define TOK_READ 352
+#define TOK_REWIND 353
+#define TOK_DEALLOCATE 354
+#define TOK_NULLIFY 355
+#define TOK_FIN 356
+#define TOK_DEBUT 357
+#define TOK_DIMENSION 358
+#define TOK_ENDSELECT 359
+#define TOK_EXTERNAL 360
+#define TOK_INTENT 361
+#define TOK_INTRINSIC 362
+#define TOK_NAMELIST 363
+#define TOK_CASEDEFAULT 364
+#define TOK_OPTIONAL 365
+#define TOK_POINTER 366
+#define TOK_CONTINUE 367
+#define TOK_SAVE 368
+#define TOK_TARGET 369
+#define TOK_QUOTE 370
+#define TOK_IMPLICIT 371
+#define TOK_NONE 372
+#define TOK_CALL 373
+#define TOK_STAT 374
+#define TOK_POINT_TO 375
+#define TOK_COMMON 376
+#define TOK_GLOBAL 377
+#define TOK_INTERFACE 378
+#define TOK_ENDINTERFACE 379
+#define TOK_LEFTAB 380
+#define TOK_RIGHTAB 381
+#define TOK_PAUSE 382
+#define TOK_PROCEDURE 383
+#define TOK_STOP 384
+#define TOK_NAMEEQ 385
+#define TOK_REAL8 386
+#define TOK_OUT 387
+#define TOK_INOUT 388
+#define TOK_IN 389
+#define TOK_USE 390
+#define TOK_TRUE 391
+#define TOK_FALSE 392
+#define TOK_LABEL 393
+#define TOK_TYPE 394
+#define TOK_TYPEPAR 395
+#define TOK_ENDTYPE 396
+#define TOK_REAL 397
+#define TOK_INTEGER 398
+#define TOK_LOGICAL 399
+#define TOK_DOUBLEPRECISION 400
+#define TOK_DOUBLEREAL 401
+#define TOK_ENDSUBROUTINE 402
+#define TOK_ENDFUNCTION 403
+#define TOK_ENDPROGRAM 404
+#define TOK_ENDUNIT 405
+#define TOK_CHARACTER 406
+#define TOK_CHAR_CONSTANT 407
+#define TOK_CHAR_CUT 408
+#define TOK_DATA 409
+#define TOK_CHAR_INT 410
+#define TOK_CHAR_MESSAGE 411
+#define TOK_CSTREAL 412
+#define TOK_CSTREALDP 413
+#define TOK_CSTREALQP 414
+#define TOK_SFREAL 415
+#define TOK_COMPLEX 416
+#define TOK_DOUBLECOMPLEX 417
+#define TOK_NAME 418
+#define TOK_NAME_CHAR 419
+#define TOK_PROBTYPE 420
+#define TOK_INTERPTYPE 421
+#define TOK_VARTYPE 422
+#define TOK_BC 423
+#define TOK_OP 424
+#define TOK_CSTINT 425
+#define TOK_COMMENT 426
+#define TOK_FILENAME 427
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 36 "fortran.y"
+
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+extern int line_num_fortran;
+extern int line_num_fortran_common;
+char *tmp;
+char c_selectorname[LONG_C];
+char ligne[LONG_C];
+char truename[LONGNOM];
+char identcopy[LONG_C];
+int c_selectorgiven=0;
+int incom;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+listdim *parcoursdim;
+int removeline=0;
+listvar *test;
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+#line 59 "fortran.y"
+{
+       char      nac[LONG_C];
+       char      na[LONGNOM];
+       listdim  *d;
+       listvar  *l;
+       listnom  *ln;
+       listcouple  *lc;
+       listname *lnn;
+       typedim   dim1;
+       variable *v;
+       }
+/* Line 193 of yacc.c.  */
+#line 483 "fortran.tab.c"
+	YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations.  */
+
+
+/* Line 216 of yacc.c.  */
+#line 496 "fortran.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   6070
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  190
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  184
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  555
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  982
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   427
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
+     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
+     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
+       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
+      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
+      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
+      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
+      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
+      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
+     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
+     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
+     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
+     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
+     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
+     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
+     171,   172,   173,   174,   175,   176,   177,   178
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint16 yyprhs[] =
+{
+       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
+      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
+      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
+      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
+     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
+     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
+     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
+     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
+     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
+     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
+     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
+     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
+     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
+     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
+     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
+     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
+     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
+     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
+     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
+     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
+     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
+     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
+     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
+     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
+     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
+     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
+     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
+     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
+     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
+     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
+     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
+     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
+     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
+     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
+    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
+    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
+    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
+    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
+    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
+    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
+    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
+    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
+    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
+    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
+    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
+    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
+    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
+    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
+    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
+    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
+    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
+    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
+    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
+    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
+    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
+    1659,  1660,  1665,  1667,  1671,  1675
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int16 yyrhs[] =
+{
+     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
+     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
+     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
+     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
+     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
+     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
+      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
+      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
+      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
+     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
+      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
+      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
+      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
+     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
+     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
+      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
+      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
+      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
+     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
+      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
+      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
+      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
+      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
+      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
+     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
+     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
+     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
+      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
+     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
+     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
+      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
+      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
+     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
+     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
+      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
+     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
+      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
+      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
+      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
+     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
+     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
+     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
+     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
+     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
+     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
+     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
+       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
+      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
+      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
+     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
+      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
+     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
+     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
+      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
+     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
+     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
+     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
+     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
+     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
+     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
+      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
+      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
+       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
+       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
+     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
+      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
+      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
+     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
+     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
+     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
+     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
+     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
+      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
+      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
+      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
+     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
+     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
+     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
+     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
+     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
+     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
+     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
+     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
+     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
+      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
+      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
+      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
+      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
+     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
+      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
+     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
+      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
+       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
+     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
+      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
+     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
+     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
+     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
+     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
+     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
+       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
+     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
+      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
+     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
+     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
+     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
+      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
+     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
+     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
+      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
+     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
+     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
+     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
+     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
+     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
+      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
+     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
+      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
+      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
+      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
+      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
+      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
+     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
+     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
+     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
+     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
+      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
+      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
+     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
+      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
+     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
+      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
+      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
+     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
+       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
+     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
+      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
+      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
+       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
+      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
+      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
+       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
+     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
+      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
+      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
+     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
+     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
+     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
+     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
+      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
+      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
+      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
+     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
+     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
+     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
+     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
+     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
+     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
+     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
+       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
+     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
+     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
+     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
+      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
+     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
+     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
+       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
+      -1,    91,   280,   180,    -1,   298,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
+     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
+     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
+     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
+     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
+     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
+     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
+     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
+     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
+     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
+     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
+     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
+     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
+    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
+    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
+    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
+    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
+    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
+    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
+    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
+    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
+    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
+    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
+    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
+    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
+    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
+    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
+    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
+    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
+    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
+    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
+    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
+    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
+    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
+    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
+    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
+    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
+    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
+    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
+    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
+    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
+    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
+    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
+    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
+    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
+    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
+    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
+    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
+    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
+    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
+    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
+    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
+    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
+    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
+    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
+    2627,  2628,  2630,  2631,  2639,  2641
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
+  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
+  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
+  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
+  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
+  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
+  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
+  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
+  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
+  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
+  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
+  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
+  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
+  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
+  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
+  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
+  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
+  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
+  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
+  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
+  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
+  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
+  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
+  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
+  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
+  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
+  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
+  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
+  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
+  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
+  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
+  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
+  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
+  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
+  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
+  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
+  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
+  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
+  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
+  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
+  "writedeclar", "before_include", "filename", "arglist", "arglist1",
+  "args", "arg", "spec", "opt_spec", "name_intrinsic",
+  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
+  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
+  "before_function", "before_parameter", "before_data", "data",
+  "datavallist", "save", "before_save", "varsave", "datanamelist",
+  "expr_data", "opt_signe", "namelist", "namelist_action",
+  "after_namelist", "interface", "before_dimension", "dimension",
+  "private", "public", "use_name_list", "common", "before_common",
+  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
+  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
+  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
+  "c_selector", "c_attribute", "before_character", "typespec", "typename",
+  "lengspec", "proper_lengspec", "selector", "proper_selector",
+  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
+  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
+  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
+  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "array_ele_substring_func_ref", "begin_array", "structure_component",
+  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
+  "simple_const", "string_constant", "opt_substring", "substring",
+  "optexpr", "opt_expr", "initial_value", "before_initial",
+  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
+  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
+  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
+  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
+  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
+  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
+  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
+  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
+  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
+  "out2", "other", "dospec", "label", "goto", "allocation_list",
+  "allocate_object", "array_element", "allocate_object_list",
+  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
+     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
+     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
+     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
+     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
+     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
+     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
+     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
+     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
+     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
+     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
+     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
+     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
+     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
+     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
+     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
+      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint16 yyr1[] =
+{
+       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
+     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
+     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
+     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
+     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
+     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
+     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
+     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
+     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
+     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
+     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
+     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
+     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
+     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
+     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
+     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
+     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
+     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
+     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
+     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
+     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
+     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
+     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
+     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
+     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
+     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
+     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
+     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
+     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
+     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
+     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
+     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
+     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
+     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
+     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
+     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
+     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
+     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
+     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
+     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
+     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
+     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
+     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
+     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
+     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
+     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
+     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
+     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
+     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
+     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
+     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
+     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
+     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
+     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
+     370,   370,   371,   371,   372,   373
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
+       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
+       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
+       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
+       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
+       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
+       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
+       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
+       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
+       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
+       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
+       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
+       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
+       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
+       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
+       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
+       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
+       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
+       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
+       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
+       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
+       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
+       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
+       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
+       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
+       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
+       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
+       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
+       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
+       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
+       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
+       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
+       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
+       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
+       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
+       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
+       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
+       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
+       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
+       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
+       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
+       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
+       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
+       0,     4,     1,     3,     3,     1
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint16 yydefact[] =
+{
+       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
+      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
+      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
+       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
+       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
+     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
+     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
+       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
+     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
+     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
+       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
+      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
+     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
+       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
+       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
+     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
+       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
+     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
+     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
+       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
+     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
+     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
+     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
+     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
+      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
+     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
+     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
+       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
+       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
+     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
+       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
+     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
+     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
+       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
+       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
+       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
+     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
+     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
+     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
+     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
+      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
+     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
+      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
+     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
+     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
+     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
+       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
+     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
+     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
+     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
+     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
+     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
+       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
+       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
+       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
+       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
+     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
+       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
+       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
+     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
+     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
+     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
+       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
+       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
+       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
+     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
+       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
+       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
+     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
+     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
+     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
+     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
+     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
+     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
+       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
+      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
+     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
+     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
+     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
+       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
+     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
+       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
+       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
+     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
+     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
+     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
+     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
+      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
+     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
+       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
+       0,   537
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int16 yydefgoto[] =
+{
+      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
+      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
+     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
+     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
+     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
+     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
+     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
+     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
+     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
+     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
+     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
+     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
+     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
+     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
+     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
+     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
+     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
+     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
+     677,   451,   143,   552
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -711
+static const yytype_int16 yypact[] =
+{
+    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
+     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
+       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
+    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
+     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
+     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
+     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
+    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
+     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
+    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
+    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
+    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
+     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
+     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
+     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
+    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
+     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
+    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
+    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
+    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
+    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
+    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
+     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
+    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
+    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
+     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
+     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
+     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
+     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
+    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
+     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
+     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
+      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
+    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
+    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
+    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
+    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
+    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
+    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
+     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
+    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
+    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
+    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
+    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
+    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
+    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
+     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
+     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
+    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
+     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
+    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
+    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
+    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
+    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
+    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
+      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
+      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
+     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
+    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
+     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
+    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
+    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
+    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
+     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
+     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
+     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
+    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
+    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
+    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
+    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
+    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
+    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
+    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
+     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
+    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
+     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
+    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
+    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
+     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
+    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
+     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
+     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
+      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
+    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
+    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
+    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
+    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
+    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
+    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
+    4731,  2530
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int16 yypgoto[] =
+{
+    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
+     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
+    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
+     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
+    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
+     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
+     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
+    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
+     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
+    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
+    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
+    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
+    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
+    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
+    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
+     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
+    -416,  -711,  -711,  -711
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -511
+static const yytype_int16 yytable[] =
+{
+     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
+     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
+     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
+     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
+     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
+     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
+     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
+     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
+     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
+     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
+     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
+     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
+      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
+     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
+     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
+     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
+     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
+     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
+     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
+    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
+     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
+     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
+     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
+     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
+     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
+     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
+     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
+     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
+     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
+     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
+     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
+     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
+     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
+     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
+     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
+     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
+     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
+     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
+     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
+     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
+     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
+     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
+     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
+     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
+     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
+     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
+     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
+     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
+     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
+     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
+     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
+     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
+     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
+     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
+     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
+     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
+     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
+     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
+     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
+     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
+     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
+     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
+     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
+     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
+    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
+     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
+     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
+     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
+     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
+     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
+     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
+     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
+     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
+     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
+     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
+     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
+     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
+     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
+     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
+    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
+    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
+     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
+     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
+    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
+     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
+     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
+     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
+     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
+     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
+       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
+       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
+       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
+       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
+     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
+       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
+       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
+       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
+     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
+     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
+     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
+     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
+       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
+     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
+     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
+       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
+     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
+     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
+     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
+       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
+      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
+    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
+       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
+       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
+     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
+       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
+       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
+     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
+     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
+       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
+       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
+       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
+       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
+     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
+     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
+     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
+       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
+     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
+     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
+       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
+    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
+     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
+     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
+     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
+    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
+     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
+       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
+     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
+       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
+       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
+     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
+     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
+       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
+      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
+      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
+       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
+       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
+       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
+      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
+       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
+     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
+     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
+     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
+       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
+       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
+     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
+       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
+       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
+       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
+     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
+     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
+       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
+     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
+       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
+     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
+     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
+       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
+     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
+     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
+       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
+       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
+     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
+       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
+     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
+       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
+     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
+     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
+     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
+     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
+     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
+       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
+      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
+     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
+       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
+       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
+       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
+     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
+     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
+       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
+       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
+       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
+       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
+       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
+     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
+     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
+      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
+      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
+      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
+       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
+       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
+       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
+      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
+      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
+     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
+      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
+     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
+     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
+     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
+       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
+       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
+       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
+       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
+     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
+     576
+};
+
+static const yytype_int16 yycheck[] =
+{
+      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
+     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
+     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
+       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
+     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
+      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
+      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
+     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
+     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
+      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
+       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
+       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
+     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
+     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
+      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
+     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
+     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
+     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
+      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
+     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
+     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
+     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
+     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
+     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
+     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
+     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
+     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
+     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
+     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
+     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
+     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
+     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
+     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
+     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
+     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
+     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
+     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
+     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
+     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
+     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
+     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
+     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
+       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
+      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
+     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
+     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
+     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
+     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
+     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
+     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
+     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
+     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
+     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
+      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
+      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
+      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
+      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
+     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
+      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
+      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
+     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
+      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
+     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
+     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
+      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
+       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
+     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
+     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
+     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
+       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
+     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
+     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
+      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
+      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
+     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
+     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
+     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
+     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
+     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
+       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
+      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
+     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
+     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
+      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
+     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
+     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
+     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
+     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
+     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
+      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
+      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
+      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
+      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
+      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
+      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
+     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
+      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
+      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
+      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
+     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
+     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
+      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
+     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
+     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
+     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
+     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
+      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
+      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
+      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
+     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
+      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
+      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
+       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
+      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
+     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
+     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
+     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
+      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
+      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
+      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
+      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
+      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
+      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
+      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
+      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
+      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
+      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
+      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
+     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
+     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
+     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
+      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
+      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
+      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
+      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
+      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
+     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
+      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
+      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
+      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
+      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
+      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
+      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
+      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
+      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
+     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
+      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
+      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
+      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
+      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
+      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
+      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
+      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
+      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
+      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
+     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
+     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
+      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
+      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
+     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
+      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
+      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
+      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
+     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
+     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
+      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
+     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
+      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
+      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
+      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
+      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
+      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
+      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
+     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
+     179
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint16 yystos[] =
+{
+       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
+     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
+      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
+      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
+      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
+     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
+     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
+     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
+     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
+     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
+     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
+     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
+     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
+     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
+      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
+      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
+      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
+     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
+     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
+     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
+     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
+     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
+     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
+      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
+     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
+     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
+     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
+     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
+       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
+      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
+     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
+     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
+      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
+     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
+     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
+     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
+     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
+     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
+     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
+      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
+     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
+     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
+       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
+     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
+     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
+      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
+      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
+     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
+     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
+     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
+     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
+     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
+     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
+     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
+     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
+     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
+     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
+     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
+     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
+     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
+     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
+     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
+     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
+     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
+       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
+     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
+     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
+     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
+     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
+     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
+     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
+     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
+     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
+       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
+       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
+     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
+     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
+     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
+     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
+     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
+     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
+     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
+      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
+      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
+       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
+     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
+     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
+     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
+     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
+     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
+     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
+     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
+     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
+     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
+     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
+     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
+     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
+       3,   280
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      fprintf (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
+    }
+}
+#endif /* YYERROR_VERBOSE */
+
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+  
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 8:
+#line 344 "fortran.y"
+    {yyerrok;yyclearin;;}
+    break;
+
+  case 13:
+#line 352 "fortran.y"
+    {
+                     if (inmoduledeclare == 0 )
+                     {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curinclude,
+                                              pos_end-pos_curinclude);
+                     }
+                  ;}
+    break;
+
+  case 18:
+#line 368 "fortran.y"
+    {
+            /* we should ignore the declaration until the keyword             */
+            /*    TOK_ENDDONOTTREAT                                           */
+            couldaddvariable = 0 ;
+            RemoveWordCUR_0(fortranout,-20,20);
+         ;}
+    break;
+
+  case 19:
+#line 375 "fortran.y"
+    {
+             couldaddvariable = 1 ;
+             RemoveWordCUR_0(fortranout,-24,24);
+          ;}
+    break;
+
+  case 22:
+#line 382 "fortran.y"
+    {pos_cur = setposcur();;}
+    break;
+
+  case 27:
+#line 394 "fortran.y"
+    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
+    break;
+
+  case 28:
+#line 397 "fortran.y"
+    {isrecursive = 0;;}
+    break;
+
+  case 29:
+#line 399 "fortran.y"
+    {isrecursive = 1;;}
+    break;
+
+  case 31:
+#line 403 "fortran.y"
+    {
+                      if ( couldaddvariable == 1)
+                      {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(1);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            writeheadnewsub_0(1);
+                      }
+                      }
+                   ;}
+    break;
+
+  case 32:
+#line 431 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
+                      /* Common case                                          */
+                      insubroutinedeclare = 1;
+                      /* in the second step we should write the head of       */
+                      /*    the subroutine sub_loop_<subroutinename>          */
+                      writeheadnewsub_0(1);
+                   ;}
+    break;
+
+  case 33:
+#line 449 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
+                         strcpy(DeclType,"");
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
+                            writeheadnewsub_0(2);
+                      }
+                   ;}
+    break;
+
+  case 34:
+#line 482 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                         strcpy(DeclType,"");
+                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
+                            writeheadnewsub_0(2);
+                      }
+                   ;}
+    break;
+
+  case 35:
+#line 516 "fortran.y"
+    {
+                      GlobalDeclaration = 0;
+                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
+                      strcpy(subroutinename,"");
+                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
+                      if ( inmoduledeclare == 0 )
+                      {
+                         /* To know if there are in the module declaration    */
+                         inmoduledeclare = 1;
+                         /* to know if a module has been met                  */
+                         inmodulemeet = 1;
+                         /* to know if we are after the keyword contains      */
+                         aftercontainsdeclare = 0 ;
+                      }
+                   ;}
+    break;
+
+  case 36:
+#line 533 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
+                      }
+                   ;}
+    break;
+
+  case 38:
+#line 542 "fortran.y"
+    {
+                      pos_curinclude = setposcur()-9;
+                   ;}
+    break;
+
+  case 39:
+#line 546 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 40:
+#line 550 "fortran.y"
+    {
+                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
+                   ;}
+    break;
+
+  case 41:
+#line 553 "fortran.y"
+    {
+                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
+                   ;}
+    break;
+
+  case 42:
+#line 557 "fortran.y"
+    {
+                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
+                   ;}
+    break;
+
+  case 45:
+#line 564 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
+                      }
+                   ;}
+    break;
+
+  case 46:
+#line 571 "fortran.y"
+    {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");
+                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
+                        strcpy(nameinttypename,nameinttypenameback);
+                         curlistvar=insertvar(NULL,curvar);
+                         (yyval.l)=settype("",curlistvar);
+                      }
+                   ;}
+    break;
+
+  case 47:
+#line 583 "fortran.y"
+    {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");                      
+                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
+                         strcpy(nameinttypename,nameinttypenameback);                         
+                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
+                      }
+                   ;}
+    break;
+
+  case 48:
+#line 594 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 49:
+#line 595 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
+    break;
+
+  case 50:
+#line 598 "fortran.y"
+    {
+                      if ( VarTypepar == 1 )
+                      {
+                         couldaddvariable = 1 ;
+                         VarTypepar = 0;
+                      }
+                   ;}
+    break;
+
+  case 51:
+#line 606 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         VarType = 1;
+                         couldaddvariable = 0 ;
+                      }
+                   ;}
+    break;
+
+  case 52:
+#line 614 "fortran.y"
+    {
+                      if ( VarType == 1 ) couldaddvariable = 1 ;
+                      VarType = 0;
+                      VarTypepar = 0;
+                   ;}
+    break;
+
+  case 54:
+#line 621 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if ( insubroutinedeclare == 0 )
+                         {
+                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                                                  }
+                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                         pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   ;}
+    break;
+
+  case 55:
+#line 636 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 )
+                     {
+                        if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   ;}
+    break;
+
+  case 57:
+#line 650 "fortran.y"
+    {
+                     pos_end = setposcur();
+                     RemoveWordSET_0(fortranout,pos_cursave,
+                                                pos_end-pos_cursave);
+                  ;}
+    break;
+
+  case 59:
+#line 657 "fortran.y"
+    {
+                   /* if the variable is a parameter we can suppose that is   */
+                   /*    value is the same on each grid. It is not useless to */
+                   /*    create a copy of it on each grid                     */
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_Globliste_1((yyvsp[(1) - (1)].l));
+                         /* if variableparamlists has been declared in a      */
+                         /*    subroutine                                     */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                         }
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curdimension,
+                                                pos_end-pos_curdimension);
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                   ;}
+    break;
+
+  case 60:
+#line 694 "fortran.y"
+    {
+      if (firstpass == 0)
+      {
+      if ((yyvsp[(1) - (1)].lnn))
+      {
+      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+      pos_end = setposcur();
+           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
+      writelistpublic((yyvsp[(1) - (1)].lnn));
+      }
+      }
+      ;}
+    break;
+
+  case 70:
+#line 716 "fortran.y"
+    {
+                      /* we should remove the data declaration                */
+                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
+                      {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curdata,
+                                              pos_end-pos_curdata);
+                      }
+                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
+                      {
+                      if (firstpass == 0)
+                      {
+                        ReWriteDataStatement_0(fortranout);
+                        pos_end = setposcur();
+                  }
+                      }
+                  ;}
+    break;
+
+  case 72:
+#line 736 "fortran.y"
+    {
+         PublicDeclare = 0 ;
+         PrivateDeclare = 0 ;
+      ;}
+    break;
+
+  case 110:
+#line 787 "fortran.y"
+    {
+                      /* if the variable is a parameter we can suppose that is*/
+                      /*    value is the same on each grid. It is not useless */
+                      /*    to create a copy of it on each grid               */
+                      if ( couldaddvariable == 1 )
+                      {
+                      pos_end = setposcur();
+                      /*if (insubroutinedeclare == 0)
+                        {   */
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                 pos_end-pos_cur_decl);
+                                         
+                       /* }
+                      else
+                       {*/
+                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                        pos_cur_decl = setposcur();
+                        
+                       /*}*/
+                      if ( firstpass == 0 &&
+                           GlobalDeclaration == 0 &&
+                           insubroutinedeclare == 0 )
+                      {
+
+                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
+                                                                ,curmodulename);
+                         tofich(fortranout,ligne,1);
+                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
+                         module_declar = associate(ligne);
+                         sprintf (ligne, " ");
+                         tofich (module_declar, ligne,1);
+                         GlobalDeclaration = 1 ;
+                         pos_cur_decl = setposcur();
+
+                      }
+                         (yyval.l) = (yyvsp[(1) - (2)].l);
+                         Add_Globliste_1((yyvsp[(1) - (2)].l));
+                                                  
+                         if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+                         else
+                         {
+                            if ( pointerdeclare == 1 )
+                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                         }
+
+                         /* if variables has been declared in a subroutine    */
+                         if ( insubroutinedeclare == 1 )
+                         { 
+                       /*    Add_SubroutineDeclaration_Var_1($1);*/
+                         }
+                         /* If there are a SAVE declarations in module's      */
+                         /*    subroutines we should remove it from the       */
+                         /*    subroutines declaration and add it in the      */
+                         /*    global declarations                            */
+                         if ( aftercontainsdeclare == 1 &&
+                              SaveDeclare == 1 && firstpass == 1 )
+                         {
+                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                         }
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                      GlobalDeclarationType = 0; 
+                   ;}
+    break;
+
+  case 111:
+#line 871 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      strcpy(nameinttypename,"");
+
+                   ;}
+    break;
+
+  case 112:
+#line 908 "fortran.y"
+    {
+                       functiondeclarationisdone = 1;
+                   ;}
+    break;
+
+  case 113:
+#line 914 "fortran.y"
+    {
+                      VariableIsParameter = 1;
+                      pos_curparameter = setposcur()-9;
+                   ;}
+    break;
+
+  case 114:
+#line 919 "fortran.y"
+    {
+                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                      Init_List_Data_Var();
+                   ;}
+    break;
+
+  case 115:
+#line 924 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+/*                      sprintf(ligne,"%s",$3);*/
+                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+                      if (firstpass == 1)
+                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
+                      }
+                   ;}
+    break;
+
+  case 116:
+#line 938 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+                      /*sprintf(ligne,"%s",$5);   */
+                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
+                      if (firstpass == 1)                      
+                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
+                      }
+                   ;}
+    break;
+
+  case 117:
+#line 952 "fortran.y"
+    {
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       if (firstpass == 1)
+                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+                       else
+                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+                   ;}
+    break;
+
+  case 118:
+#line 967 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
+                      }
+                   ;}
+    break;
+
+  case 119:
+#line 974 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
+                      }
+                   ;}
+    break;
+
+  case 124:
+#line 988 "fortran.y"
+    {
+                     pos_cursave = setposcur()-4;
+                  ;}
+    break;
+
+  case 126:
+#line 994 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
+                  ;}
+    break;
+
+  case 127:
+#line 999 "fortran.y"
+    {
+		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
+		;}
+    break;
+
+  case 128:
+#line 1003 "fortran.y"
+    {
+      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
+      exit(0);
+      ;}
+    break;
+
+  case 129:
+#line 1008 "fortran.y"
+    {
+      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
+      ;}
+    break;
+
+  case 130:
+#line 1013 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 131:
+#line 1015 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 132:
+#line 1017 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 133:
+#line 1019 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 134:
+#line 1021 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 135:
+#line 1024 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
+    break;
+
+  case 136:
+#line 1026 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 143:
+#line 1038 "fortran.y"
+    {
+	ininterfacedeclare = 1 ;
+	printf("INTEFACE entree\n");
+	;}
+    break;
+
+  case 144:
+#line 1043 "fortran.y"
+    {
+      ininterfacedeclare = 0;
+      ;}
+    break;
+
+  case 145:
+#line 1048 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curdimension = setposcur()-9;
+                   ;}
+    break;
+
+  case 146:
+#line 1054 "fortran.y"
+    {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar(NULL,curvar);
+            /*                                                                */
+            (yyval.l)=settype("",curlistvar);
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      ;}
+    break;
+
+  case 147:
+#line 1070 "fortran.y"
+    {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
+            /*                                                                */
+            (yyval.l)=curlistvar;
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      ;}
+    break;
+
+  case 150:
+#line 1090 "fortran.y"
+    {
+        (yyval.lnn)=(listname *)NULL;
+        ;}
+    break;
+
+  case 151:
+#line 1094 "fortran.y"
+    {
+          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
+         ;}
+    break;
+
+  case 152:
+#line 1099 "fortran.y"
+    {
+           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
+           ;}
+    break;
+
+  case 153:
+#line 1103 "fortran.y"
+    {
+          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
+          ;}
+    break;
+
+  case 154:
+#line 1108 "fortran.y"
+    {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcommon,
+                                                  pos_end-pos_curcommon);
+                   ;}
+    break;
+
+  case 155:
+#line 1114 "fortran.y"
+    {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
+                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   ;}
+    break;
+
+  case 156:
+#line 1125 "fortran.y"
+    {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
+                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   ;}
+    break;
+
+  case 157:
+#line 1137 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6;
+                   ;}
+    break;
+
+  case 158:
+#line 1142 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6-7;
+                   ;}
+    break;
+
+  case 159:
+#line 1148 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   ;}
+    break;
+
+  case 160:
+#line 1153 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   ;}
+    break;
+
+  case 161:
+#line 1157 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         positioninblock = positioninblock + 1 ;
+                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
+                         commondim = (yyvsp[(2) - (2)].d);
+                      }
+                   ;}
+    break;
+
+  case 162:
+#line 1167 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),"");
+                         positioninblock=0;
+                         strcpy(commonblockname,"");
+                      }
+                   ;}
+    break;
+
+  case 163:
+#line 1176 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
+                         positioninblock=0;
+                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
+                      }
+                   ;}
+    break;
+
+  case 166:
+#line 1189 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
+                   ;}
+    break;
+
+  case 167:
+#line 1193 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
+                   ;}
+    break;
+
+  case 168:
+#line 1198 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 )
+                     {
+                         curvar=(variable *) malloc(sizeof(variable));
+                         /*                                                   */
+                         Init_Variable(curvar);
+                         /*                                                   */
+                         curvar->v_VariableIsParameter=1;
+                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
+                         Save_Length((yyvsp[(1) - (3)].nac),4);
+                         strcpy(curvar->v_subroutinename,subroutinename);
+                         Save_Length(subroutinename,11);
+                         strcpy(curvar->v_modulename,curmodulename);
+                         Save_Length(curmodulename,6);
+                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+                         Save_Length((yyvsp[(3) - (3)].na),14);
+                         strcpy(curvar->v_commoninfile,mainfile);
+                         Save_Length(mainfile,10);
+                         (yyval.v)=curvar;
+                      }
+                   ;}
+    break;
+
+  case 172:
+#line 1226 "fortran.y"
+    {
+                       if ( insubroutinedeclare == 1 )
+                       {
+                          Add_ImplicitNoneSubroutine_1();
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_end-13,
+                                                             13);
+                       }
+                    ;}
+    break;
+
+  case 175:
+#line 1240 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         /*                                                   */
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
+                            GlobalDeclarationType == 0;
+                         }
+                         else
+                         {
+                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar(DeclType,curvar);
+                         /*                                                   */
+                         curlistvar=insertvar(NULL,curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         (yyval.l)=settype(DeclType,curlistvar);
+                      }
+                      strcpy(vallengspec,"");
+                   ;}
+    break;
+
+  case 176:
+#line 1273 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
+                         }
+                         else
+                         {
+                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
+                         /*                                                   */
+                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
+                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
+                         /*                                                   */
+                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         (yyval.l)=curlistvar;
+                      }
+                      strcpy(vallengspec,"");
+                   ;}
+    break;
+
+  case 177:
+#line 1307 "fortran.y"
+    {dimsgiven=0;;}
+    break;
+
+  case 178:
+#line 1310 "fortran.y"
+    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
+    break;
+
+  case 179:
+#line 1312 "fortran.y"
+    {
+                      strcpy(DeclType,"CHARACTER");
+                   ;}
+    break;
+
+  case 180:
+#line 1316 "fortran.y"
+    {
+                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
+                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
+                   ;}
+    break;
+
+  case 181:
+#line 1321 "fortran.y"
+    {
+                      strcpy(DeclType,"TYPE");
+                      GlobalDeclarationType = 1
+                   ;}
+    break;
+
+  case 182:
+#line 1327 "fortran.y"
+    {
+                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
+                      couldaddvariable = 0 ;
+                      pos_cur_decl = setposcur()-5;*/
+                   pos_cur_decl = setposcur()-5;
+                   ;}
+    break;
+
+  case 184:
+#line 1336 "fortran.y"
+    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 185:
+#line 1337 "fortran.y"
+    {c_star = 1;;}
+    break;
+
+  case 190:
+#line 1345 "fortran.y"
+    {
+                      pos_cur_decl = setposcur()-9;
+                   ;}
+    break;
+
+  case 191:
+#line 1349 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 192:
+#line 1352 "fortran.y"
+    {
+                      strcpy((yyval.nac),"INTEGER");
+                      pos_cur_decl = setposcur()-7;
+                   ;}
+    break;
+
+  case 193:
+#line 1356 "fortran.y"
+    {
+                      strcpy((yyval.nac),"REAL");
+                      pos_cur_decl = setposcur()-4;
+                   ;}
+    break;
+
+  case 194:
+#line 1361 "fortran.y"
+    {strcpy((yyval.nac),"COMPLEX");
+                   pos_cur_decl = setposcur()-7;;}
+    break;
+
+  case 195:
+#line 1364 "fortran.y"
+    {
+                      pos_cur_decl = setposcur()-16;
+                      strcpy((yyval.nac),"REAL");
+                      strcpy(nameinttypename,"8");
+                   ;}
+    break;
+
+  case 196:
+#line 1370 "fortran.y"
+    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
+    break;
+
+  case 197:
+#line 1372 "fortran.y"
+    {
+                      strcpy((yyval.nac),"LOGICAL");
+                      pos_cur_decl = setposcur()-7;
+                   ;}
+    break;
+
+  case 199:
+#line 1378 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 200:
+#line 1380 "fortran.y"
+    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 201:
+#line 1381 "fortran.y"
+    {strcpy((yyval.na),"*(*)");;}
+    break;
+
+  case 208:
+#line 1392 "fortran.y"
+    {
+                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+                      {
+                         strcpy(nameinttypename,"8");
+                         sprintf(NamePrecision,"");
+                      }
+                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
+                   ;}
+    break;
+
+  case 209:
+#line 1401 "fortran.y"
+    {
+                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 210:
+#line 1405 "fortran.y"
+    {
+                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 211:
+#line 1409 "fortran.y"
+    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
+                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 212:
+#line 1411 "fortran.y"
+    {strcpy(CharacterSize,"*");
+                    strcpy((yyval.na),"*");;}
+    break;
+
+  case 220:
+#line 1425 "fortran.y"
+    {
+                      VariableIsParameter = 1;
+                   ;}
+    break;
+
+  case 222:
+#line 1430 "fortran.y"
+    {Allocatabledeclare = 1;;}
+    break;
+
+  case 223:
+#line 1432 "fortran.y"
+    {
+                      dimsgiven=1;
+                      curdim=(yyvsp[(2) - (2)].d);
+                   ;}
+    break;
+
+  case 224:
+#line 1437 "fortran.y"
+    {ExternalDeclare = 1;;}
+    break;
+
+  case 225:
+#line 1439 "fortran.y"
+    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
+    break;
+
+  case 227:
+#line 1441 "fortran.y"
+    {optionaldeclare = 1 ;;}
+    break;
+
+  case 228:
+#line 1442 "fortran.y"
+    {pointerdeclare = 1 ;;}
+    break;
+
+  case 229:
+#line 1443 "fortran.y"
+    {
+/*                       if ( inmodulemeet == 1 )
+                       {*/
+                          SaveDeclare = 1 ;
+                     /*  }*/
+                    ;}
+    break;
+
+  case 230:
+#line 1450 "fortran.y"
+    {Targetdeclare = 1;;}
+    break;
+
+  case 231:
+#line 1452 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 232:
+#line 1453 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 233:
+#line 1454 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
+    break;
+
+  case 234:
+#line 1457 "fortran.y"
+    {PublicDeclare = 1;;}
+    break;
+
+  case 235:
+#line 1459 "fortran.y"
+    {PrivateDeclare = 1;;}
+    break;
+
+  case 236:
+#line 1461 "fortran.y"
+    {if ( created_dimensionlist == 1 )
+                       {
+                           (yyval.d)=(listdim *)NULL;
+                       }
+                   ;}
+    break;
+
+  case 237:
+#line 1467 "fortran.y"
+    {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
+    break;
+
+  case 238:
+#line 1470 "fortran.y"
+    {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
+    break;
+
+  case 239:
+#line 1473 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
+    break;
+
+  case 240:
+#line 1476 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"1");
+                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
+                      Save_Length((yyvsp[(1) - (1)].na),1);
+                   ;}
+    break;
+
+  case 241:
+#line 1481 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"");
+                      strcpy((yyval.dim1).last,"");
+                   ;}
+    break;
+
+  case 242:
+#line 1485 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
+                      Save_Length((yyvsp[(1) - (2)].na),2);
+                      strcpy((yyval.dim1).last,"");
+                   ;}
+    break;
+
+  case 243:
+#line 1490 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"");
+                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
+                      Save_Length((yyvsp[(2) - (2)].na),1);
+                   ;}
+    break;
+
+  case 244:
+#line 1496 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
+                      Save_Length((yyvsp[(1) - (3)].na),2);
+                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
+                      Save_Length((yyvsp[(3) - (3)].na),1);
+                   ;}
+    break;
+
+  case 245:
+#line 1503 "fortran.y"
+    {strcpy((yyval.na),"*");;}
+    break;
+
+  case 246:
+#line 1504 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 247:
+#line 1506 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 248:
+#line 1508 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 249:
+#line 1510 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 250:
+#line 1512 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 251:
+#line 1516 "fortran.y"
+    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 252:
+#line 1518 "fortran.y"
+    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 253:
+#line 1520 "fortran.y"
+    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 254:
+#line 1522 "fortran.y"
+    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 255:
+#line 1524 "fortran.y"
+    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 256:
+#line 1526 "fortran.y"
+    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 257:
+#line 1528 "fortran.y"
+    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 258:
+#line 1530 "fortran.y"
+    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 259:
+#line 1532 "fortran.y"
+    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 260:
+#line 1534 "fortran.y"
+    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 261:
+#line 1536 "fortran.y"
+    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 262:
+#line 1538 "fortran.y"
+    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 263:
+#line 1540 "fortran.y"
+    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 264:
+#line 1542 "fortran.y"
+    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 265:
+#line 1544 "fortran.y"
+    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 266:
+#line 1546 "fortran.y"
+    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 267:
+#line 1548 "fortran.y"
+    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 268:
+#line 1550 "fortran.y"
+    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 269:
+#line 1552 "fortran.y"
+    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 270:
+#line 1554 "fortran.y"
+    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 271:
+#line 1556 "fortran.y"
+    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 272:
+#line 1558 "fortran.y"
+    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 273:
+#line 1560 "fortran.y"
+    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 274:
+#line 1562 "fortran.y"
+    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 275:
+#line 1564 "fortran.y"
+    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 276:
+#line 1566 "fortran.y"
+    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 277:
+#line 1568 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 278:
+#line 1570 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
+    break;
+
+  case 279:
+#line 1573 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 280:
+#line 1575 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 281:
+#line 1577 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 282:
+#line 1579 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 283:
+#line 1581 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 284:
+#line 1583 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 285:
+#line 1585 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
+    break;
+
+  case 286:
+#line 1586 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
+    break;
+
+  case 287:
+#line 1589 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 288:
+#line 1591 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 289:
+#line 1593 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 290:
+#line 1595 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 291:
+#line 1597 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 292:
+#line 1599 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 293:
+#line 1601 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 294:
+#line 1603 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 295:
+#line 1605 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 296:
+#line 1607 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 297:
+#line 1609 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 298:
+#line 1611 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 299:
+#line 1613 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 300:
+#line 1615 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 301:
+#line 1617 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 302:
+#line 1619 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 303:
+#line 1621 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 304:
+#line 1623 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 305:
+#line 1625 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 306:
+#line 1627 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 307:
+#line 1629 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 308:
+#line 1631 "fortran.y"
+    {strcpy((yyval.na),"");;}
+    break;
+
+  case 309:
+#line 1633 "fortran.y"
+    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 310:
+#line 1635 "fortran.y"
+    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 311:
+#line 1637 "fortran.y"
+    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 312:
+#line 1640 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 313:
+#line 1642 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 314:
+#line 1645 "fortran.y"
+    {if ( couldaddvariable == 1 )
+						{
+						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
+						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
+						;}
+    break;
+
+  case 315:
+#line 1651 "fortran.y"
+    {if ( couldaddvariable == 1 ) {
+                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
+                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+                   ;}
+    break;
+
+  case 316:
+#line 1656 "fortran.y"
+    {if ( couldaddvariable == 1 ) {
+                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
+                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+                   };}
+    break;
+
+  case 317:
+#line 1661 "fortran.y"
+    {
+                      agrif_parentcall =0;
+                      if (!strcasecmp(identcopy,"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
+                      {
+                         inagrifcallargument = 1;
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                      }
+                   ;}
+    break;
+
+  case 318:
+#line 1674 "fortran.y"
+    {
+                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   ;}
+    break;
+
+  case 319:
+#line 1679 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 320:
+#line 1681 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 321:
+#line 1684 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 322:
+#line 1688 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
+                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+                         agrif_parentcall =0;
+                      }
+                   ;}
+    break;
+
+  case 323:
+#line 1698 "fortran.y"
+    {
+                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   ;}
+    break;
+
+  case 324:
+#line 1704 "fortran.y"
+    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 325:
+#line 1706 "fortran.y"
+    {strcpy((yyval.na)," ");;}
+    break;
+
+  case 326:
+#line 1708 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 327:
+#line 1710 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 328:
+#line 1712 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 329:
+#line 1714 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 330:
+#line 1715 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 331:
+#line 1718 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 332:
+#line 1720 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 333:
+#line 1723 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
+    break;
+
+  case 334:
+#line 1724 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 335:
+#line 1725 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 336:
+#line 1726 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
+    break;
+
+  case 337:
+#line 1727 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
+    break;
+
+  case 338:
+#line 1729 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 && afterpercent == 0)
+                       {
+                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
+                       {
+                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
+                          if ( inagrifcallargument == 1 )
+                          {
+                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
+                             {
+                                strcpy(sameagrifname,identcopy);
+                                sameagrifargument = 1;
+                             }
+                          }
+                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
+                          pointedvar=0;
+                          strcpy(truename,(yyvsp[(1) - (1)].nac));
+                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
+
+                          if ( VarIsNonGridDepend(truename) == 0 &&
+                               Variableshouldberemove(truename) == 0 )
+                          {                      
+                             if ( inagrifcallargument == 1 ||
+                                  varispointer_0(truename) == 1 )
+                             {
+                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
+                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
+                             {
+                              if (varistyped_0(truename) == 0)
+                                 {
+                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
+                                 }
+                                 }
+                             }
+                             printf("ici3\n");
+                             if ( inagrifcallargument != 1 ||
+                                  sameagrifargument ==1 )
+                                  {
+                                  printf("ici5 %s\n",truename);
+                                  Add_UsedInSubroutine_Var_1(truename);
+                          }
+                          }
+                          NotifyAgrifFunction_0(truename);
+                       }
+                       }
+                       else
+                       {
+                       afterpercent = 0;
+                    }
+                    ;}
+    break;
+
+  case 339:
+#line 1788 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
+    break;
+
+  case 340:
+#line 1789 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
+    break;
+
+  case 341:
+#line 1790 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 342:
+#line 1791 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 343:
+#line 1792 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 344:
+#line 1793 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 345:
+#line 1795 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 347:
+#line 1799 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 349:
+#line 1802 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 350:
+#line 1804 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 351:
+#line 1806 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 352:
+#line 1807 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 353:
+#line 1810 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 354:
+#line 1812 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 355:
+#line 1813 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 356:
+#line 1815 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 357:
+#line 1816 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 358:
+#line 1818 "fortran.y"
+    {   strcpy(InitialValueGiven," ");;}
+    break;
+
+  case 359:
+#line 1820 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
+                          strcpy(InitialValueGiven,"=");
+                       }
+                    ;}
+    break;
+
+  case 360:
+#line 1828 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
+                          strcpy(InitialValueGiven,"=>");
+                       }
+                    ;}
+    break;
+
+  case 361:
+#line 1836 "fortran.y"
+    {pos_curinit = setposcur();;}
+    break;
+
+  case 362:
+#line 1839 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 363:
+#line 1842 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuse_0((yyvsp[(2) - (2)].nac));
+                      }
+                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
+                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
+
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    ;}
+    break;
+
+  case 364:
+#line 1862 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      if (insubroutinedeclare == 1)
+                      {
+                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
+                      }
+                      if ( firstpass == 1 )
+                      {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            coupletmp = (yyvsp[(4) - (4)].lc);
+                            strcpy(ligne,"");
+                            while ( coupletmp )
+                            {
+                               strcat(ligne,coupletmp->c_namevar);
+                               strcat(ligne," => ");
+                               strcat(ligne,coupletmp->c_namepointedvar);
+                               coupletmp = coupletmp->suiv;
+                               if ( coupletmp ) strcat(ligne,",");
+                            }
+                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
+                         }
+                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
+                      }
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    ;}
+    break;
+
+  case 365:
+#line 1896 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuseonly_0((yyvsp[(2) - (6)].nac));
+                      }
+                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
+                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
+
+                       if ( inmoduledeclare == 0 )
+                       {
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_curuse,
+                                                pos_end-pos_curuse);
+                       }
+                       }
+                    ;}
+    break;
+
+  case 366:
+#line 1916 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if variables has been declared in a subroutine      */
+                       if (insubroutinedeclare == 1)
+                       {
+                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
+                       }
+                       if ( firstpass == 1 )
+                       {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                             coupletmp = (yyvsp[(6) - (6)].lc);
+                             strcpy(ligne,"");
+                             while ( coupletmp )
+                             {
+                                strcat(ligne,coupletmp->c_namevar);
+                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
+                                                           strcat(ligne," => ");
+                                strcat(ligne,coupletmp->c_namepointedvar);
+                                coupletmp = coupletmp->suiv;
+                                if ( coupletmp ) strcat(ligne,",");
+                             }
+                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
+                          }
+                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
+                       }
+                       if ( firstpass == 0 )
+                       {
+                          if ( inmoduledeclare == 0 )
+                          {
+
+                            pos_end = setposcur();
+                             RemoveWordSET_0(fortranout,pos_curuse,
+                                                   pos_end-pos_curuse);
+                       if (oldfortranout) 
+                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
+                        
+                          }
+                          else
+                          {
+
+                             /* if we are in the module declare and if the    */
+                             /* onlylist is a list of global variable         */
+                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
+                          }
+                       }
+                       }
+                    ;}
+    break;
+
+  case 367:
+#line 1967 "fortran.y"
+    {
+                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                     if (firstpass == 0 && oldfortranout) {
+                     pos_curuseold = setposcurname(oldfortranout);
+                     }
+                   ;}
+    break;
+
+  case 368:
+#line 1975 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 369:
+#line 1978 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
+                    ;}
+    break;
+
+  case 370:
+#line 1982 "fortran.y"
+    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
+                        }
+                    ;}
+    break;
+
+  case 371:
+#line 1992 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
+                       Save_Length((yyvsp[(1) - (3)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
+                       Save_Length((yyvsp[(3) - (3)].nac),22);
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                     ;}
+    break;
+
+  case 372:
+#line 2003 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
+                    ;}
+    break;
+
+  case 373:
+#line 2007 "fortran.y"
+    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
+                        }
+                    ;}
+    break;
+
+  case 374:
+#line 2017 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
+                       Save_Length((yyvsp[(1) - (3)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
+                       Save_Length((yyvsp[(3) - (3)].nac),22);
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                       pointedvar=1;
+                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
+                    ;}
+    break;
+
+  case 375:
+#line 2028 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
+                       Save_Length((yyvsp[(1) - (1)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,"");
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                     ;}
+    break;
+
+  case 377:
+#line 2039 "fortran.y"
+    {
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 378:
+#line 2045 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                         curmodulename);
+                                                         inallocate = 0;
+                     ;}
+    break;
+
+  case 380:
+#line 2052 "fortran.y"
+    {
+                       GlobalDeclaration = 0 ;
+                       if ( firstpass == 0 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                          if ( module_declar && insubroutinedeclare == 0 )
+                          {
+                              fclose(module_declar);
+                          }
+                       }
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       if ( inmodulemeet == 1 )
+                       {
+                         /* we are in a module                                */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            /* it is like an end subroutine <name>            */
+                            insubroutinedeclare = 0 ;
+                            /*                                                */
+                            pos_cur = setposcur();
+                            closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                         }
+                         else
+                         {
+                            /* it is like an end module <name>                */
+                            inmoduledeclare = 0 ;
+                            inmodulemeet = 0 ;
+                         }
+                       }
+                       else
+                       {
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+                          pos_cur = setposcur();                        
+                          closeandcallsubloopandincludeit_0(2);
+                            functiondeclarationisdone = 0;
+                          if ( firstpass == 0 )
+                          {
+                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                             else fprintf(paramout,"C\n");
+                             fclose(paramout);
+                           }
+                        }
+                      }
+                      strcpy(subroutinename,"");
+                    ;}
+    break;
+
+  case 381:
+#line 2102 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();                      
+                       closeandcallsubloopandincludeit_0(3);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 382:
+#line 2120 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+                                             
+                       closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 383:
+#line 2140 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+
+                       closeandcallsubloopandincludeit_0(0);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 384:
+#line 2159 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if we never meet the contains keyword               */
+                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
+                       if ( inmoduledeclare == 1 )
+                       {
+                          if ( aftercontainsdeclare == 0 )
+                          {
+                             Write_GlobalParameter_Declaration_0();
+                             Write_NotGridDepend_Declaration_0();
+                             Write_GlobalType_Declaration_0();
+                             if ( module_declar_type )
+                             {
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                             Write_Alloc_Subroutine_For_End_0();
+                          }
+                       }
+                                           
+                       inmoduledeclare = 0 ;
+                       inmodulemeet = 0 ;
+
+                      Write_Word_end_module_0();
+                      strcpy(curmodulename,"");
+                      aftercontainsdeclare = 1;
+                      if ( firstpass == 0 )
+                      {
+                         if ( module_declar && insubroutinedeclare == 0)
+                         {
+                           fclose(module_declar);
+                         }
+                         if ( module_declar_type && insubroutinedeclare == 0)
+                         {
+                          fclose(module_declar_type);
+                          module_declar_type = 0;
+                         }
+                      }
+                      GlobalDeclaration = 0 ;
+                      }
+                  ;}
+    break;
+
+  case 398:
+#line 2217 "fortran.y"
+    {
+                      if (inmoduledeclare == 1 )
+                      {
+                         Remove_Word_Contains_0();
+                         Write_GlobalParameter_Declaration_0();
+                         Write_GlobalType_Declaration_0();
+                             if ( module_declar_type)
+                             {                         
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                         Write_NotGridDepend_Declaration_0();
+                         Write_Alloc_Subroutine_0();
+                         inmoduledeclare = 0 ;
+                         aftercontainsdeclare = 1;
+                      }
+                      else
+                      {
+                      incontainssubroutine = 1;
+                      strcpy(previoussubroutinename,subroutinename);
+                       if ( couldaddvariable == 1 )
+                       {
+                          if ( firstpass == 1 ) List_ContainsSubroutine =
+                                                Addtolistnom(subroutinename,
+                                                     List_ContainsSubroutine,0);
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+
+                          closeandcallsubloop_contains_0();
+                            functiondeclarationisdone = 0;
+                         if ( firstpass == 0 )
+                         {
+                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                            else fprintf(paramout,"C\n");
+                            fclose(paramout);
+                         }
+                         }
+                         strcpy(subroutinename,"");
+                      }
+                   ;}
+    break;
+
+  case 399:
+#line 2261 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       functiondeclarationisdone = 0;
+                       }
+                    ;}
+    break;
+
+  case 400:
+#line 2271 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 401:
+#line 2280 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 402:
+#line 2289 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 414:
+#line 2311 "fortran.y"
+    {strcpy((yyval.nac),"");;}
+    break;
+
+  case 415:
+#line 2312 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 425:
+#line 2332 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 426:
+#line 2338 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 432:
+#line 2349 "fortran.y"
+    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
+    break;
+
+  case 433:
+#line 2351 "fortran.y"
+    {
+                  created_dimensionlist = 1;
+                  if  ( agrif_parentcall == 1 )
+                  {
+                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                      agrif_parentcall =0;
+                      fprintf(fortranout," = ");
+                  }
+              ;}
+    break;
+
+  case 434:
+#line 2361 "fortran.y"
+    {created_dimensionlist = 1;;}
+    break;
+
+  case 439:
+#line 2369 "fortran.y"
+    {
+                      inagrifcallargument = 0 ;
+                      incalldeclare=0;
+                      if ( oldfortranout &&
+                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
+                           firstpass == 0 &&
+                           callmpiinit == 1)
+                      {
+                      /*   pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
+                                                                   ,mpiinitvar);*/
+                      }
+                      if ( oldfortranout           &&
+                           callagrifinitgrids == 1 &&
+                           firstpass == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+
+                         strcpy(subofagrifinitgrids,subroutinename);
+                      }
+                      Instanciation_0(sameagrifname);
+                   ;}
+    break;
+
+  case 444:
+#line 2403 "fortran.y"
+    {
+                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
+                       {
+                          callmpiinit = 1;
+                       }
+                       else
+                       {
+                          callmpiinit = 0;
+                       }
+                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
+                       {
+                          callagrifinitgrids = 1;
+                          strcpy(meetagrifinitgrids,subroutinename);
+                       }
+                       else callagrifinitgrids = 0;
+                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
+                       {
+                          incalldeclare=1;
+                          inagrifcallargument = 1 ;
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                    ;}
+    break;
+
+  case 445:
+#line 2433 "fortran.y"
+    {pos_curcall=setposcur()-4;;}
+    break;
+
+  case 448:
+#line 2438 "fortran.y"
+    {
+                  if ( callmpiinit == 1 )
+                  {
+                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                     if ( firstpass == 1 )
+                     {
+                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
+/*                        curvar=createvar($1,NULL);
+                        curlistvar=insertvar(NULL,curvar);
+                        List_Subr outineArgument_Var = AddListvarToListvar
+                         (curlistvar,List_SubroutineAr gument_Var,1);*/
+                     }
+                  }
+               ;}
+    break;
+
+  case 520:
+#line 2562 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 521:
+#line 2563 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 522:
+#line 2564 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 523:
+#line 2567 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 524:
+#line 2569 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 525:
+#line 2571 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 526:
+#line 2573 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 527:
+#line 2575 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 528:
+#line 2577 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 529:
+#line 2578 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 530:
+#line 2579 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 531:
+#line 2582 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 532:
+#line 2584 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 533:
+#line 2586 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 534:
+#line 2588 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 535:
+#line 2590 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 536:
+#line 2594 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 537:
+#line 2597 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
+    break;
+
+  case 544:
+#line 2613 "fortran.y"
+    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
+    break;
+
+  case 547:
+#line 2618 "fortran.y"
+    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
+    break;
+
+  case 555:
+#line 2641 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 6522 "fortran.tab.c"
+      default: break;
+    }
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+#line 2643 "fortran.y"
+
+
+void processfortran(char *fichier_entree)
+{
+   extern FILE *fortranin;
+   extern FILE *fortranout;
+   char nomfile[LONG_C];
+   int c;
+   int confirmyes;
+
+/*   fortrandebug = 1;*/
+   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
+/******************************************************************************/
+/*  1-  Open input and output files                                           */
+/******************************************************************************/
+   strcpy(nomfile,commondirin);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   fortranin=fopen( nomfile,"r");
+   if (! fortranin)
+   {
+      printf("Error : File %s does not exist\n",nomfile);
+      exit(1);
+   }
+
+   strcpy(curfile,nomfile);
+   strcpy(nomfile,commondirout);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   strcpy(nomfileoutput,nomfile);
+   Save_Length(nomfileoutput,31);
+   if (firstpass == 1)
+   {
+      if (checkexistcommon == 1)
+      {
+         if (fopen(nomfile,"r"))
+         {
+            printf("Warning : file %s already exist\n",nomfile);
+            confirmyes = 0;
+            while (confirmyes==0)
+            {
+               printf("Override file %s ? [Y/N]\n",nomfile);
+               c=getchar();
+               getchar();
+               if (c==79 || c==110)
+               {
+                  printf("We stop\n");
+                  exit(1);
+               }
+               if (c==89 || c==121)
+               {
+                  confirmyes=1;
+               }
+            }
+         }
+      }
+   }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+   line_num_fortran_common=1;
+   line_num_fortran=1;
+   PublicDeclare = 0;
+   PrivateDeclare = 0;
+   ExternalDeclare = 0;
+   SaveDeclare = 0;
+   pointerdeclare = 0;
+   optionaldeclare = 0;
+   incalldeclare = 0;
+   VarType = 0;
+   VarTypepar = 0;
+   Allocatabledeclare = 0 ;
+   Targetdeclare = 0 ;
+   strcpy(NamePrecision," ");
+   VariableIsParameter =  0 ;
+   strcpy(NamePrecision,"");
+   c_star = 0 ;
+   functiondeclarationisdone = 0;
+   insubroutinedeclare = 0 ;
+   ininterfacedeclare = 0 ;   
+   strcpy(subroutinename," ");
+   isrecursive = 0;
+   strcpy(InitialValueGiven," ");
+   strcpy(EmptyChar," ");
+   inmoduledeclare = 0;
+   incontainssubroutine = 0;
+   module_declar_type = 0;
+   GlobalDeclarationType = 0;
+   colnum=0;
+   incom=0;
+   couldaddvariable=1;
+   afterpercent = 0;
+   aftercontainsdeclare = 1;
+   strcpy(nameinttypename,"");
+   /* Name of the file without format                                         */
+   tmp = strchr(fichier_entree, '.');
+   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
+   Save_Length(curfilename,30);
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+   if (firstpass == 0 )
+   {
+      fortranout=fopen(nomfileoutput,"w");
+
+/*      NewModule_Creation_0();*/
+   }
+
+   fortranparse();
+
+   if (firstpass == 0 )
+   {
+   NewModule_Creation_0();
+   }
+   
+   strcpy(curfile,mainfile);
+
+   if (firstpass == 0 )
+   {
+   fclose(fortranout);
+   }
+}
+
+#line 2 "fortran.yy.c"
+
+#line 4 "fortran.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer fortran_create_buffer
+#define yy_delete_buffer fortran_delete_buffer
+#define yy_flex_debug fortran_flex_debug
+#define yy_init_buffer fortran_init_buffer
+#define yy_flush_buffer fortran_flush_buffer
+#define yy_load_buffer_state fortran_load_buffer_state
+#define yy_switch_to_buffer fortran_switch_to_buffer
+#define yyin fortranin
+#define yyleng fortranleng
+#define yylex fortranlex
+#define yylineno fortranlineno
+#define yyout fortranout
+#define yyrestart fortranrestart
+#define yytext fortrantext
+#define yywrap fortranwrap
+#define yyalloc fortranalloc
+#define yyrealloc fortranrealloc
+#define yyfree fortranfree
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE fortranrestart(fortranin  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t fortranleng;
+
+extern FILE *fortranin, *fortranout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortrantext. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via fortranrestart()), so that the user can continue scanning by
+	 * just pointing fortranin at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when fortrantext is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t fortranleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow fortranwrap()'s to do buffer switches
+ * instead of setting up a fresh fortranin.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void fortranrestart (FILE *input_file  );
+void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
+void fortran_delete_buffer (YY_BUFFER_STATE b  );
+void fortran_flush_buffer (YY_BUFFER_STATE b  );
+void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortranpop_buffer_state (void );
+
+static void fortranensure_buffer_stack (void );
+static void fortran_load_buffer_state (void );
+static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortranalloc (yy_size_t  );
+void *fortranrealloc (void *,yy_size_t  );
+void fortranfree (void *  );
+
+#define yy_new_buffer fortran_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        fortranensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        fortranensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int fortranlineno;
+
+int fortranlineno = 1;
+
+extern char *fortrantext;
+#define yytext_ptr fortrantext
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up fortrantext.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	fortranleng = (size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 176
+#define YY_END_OF_BUFFER 177
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[1162] =
+    {   0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
+      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
+      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
+      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
+      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
+      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
+      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
+
+      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
+      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
+        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
+      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
+
+      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
+      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
+      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
+      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
+      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
+      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
+
+      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
+      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
+      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
+        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
+      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
+        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
+        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
+        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
+      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
+
+        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
+       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
+        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
+        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
+      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
+      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
+      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
+      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
+      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
+
+      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
+      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
+        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
+      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
+      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
+      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
+        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
+      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
+        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
+      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
+
+      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
+        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
+       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
+       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
+      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
+      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
+      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
+        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
+        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
+
+       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
+        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
+       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
+       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
+      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
+      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
+      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
+      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
+      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
+      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
+
+       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
+      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
+        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
+       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
+       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
+        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
+        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
+       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
+       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
+       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
+
+        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
+        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
+       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
+        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
+      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
+       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
+        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
+      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
+        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
+       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
+
+        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
+      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
+        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
+       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
+        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
+      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
+        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
+        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
+        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
+      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
+
+        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
+        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
+        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
+        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
+      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
+      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
+        0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
+       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
+       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
+       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
+       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
+
+       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
+       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
+       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[90] =
+    {   0,
+        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
+        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
+        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
+       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
+        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
+        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
+       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
+       10,    5,   10,    8,   12,    8,    8,    8,    4
+    } ;
+
+static yyconst flex_int16_t yy_base[1215] =
+    {   0,
+        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
+        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
+       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
+      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
+      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
+      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
+      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
+      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
+        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
+      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
+
+      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
+      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
+      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
+     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
+     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
+     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
+     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
+     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
+      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
+      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
+
+     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
+     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
+      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
+      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
+     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
+      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
+     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
+     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
+     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
+     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
+
+     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
+     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
+     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
+     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
+      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
+     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
+     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
+      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
+     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
+     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
+
+      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
+     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
+      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
+     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
+     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
+     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
+     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
+     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
+     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
+     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
+
+     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
+     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
+     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
+      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
+     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
+     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
+     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
+     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
+     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
+     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
+
+     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
+     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
+     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
+     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
+     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
+     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
+     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
+     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
+     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
+     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
+
+     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
+     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
+        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
+     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
+     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
+     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
+     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
+     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
+     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
+     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
+
+     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
+      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
+     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
+     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
+     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
+     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
+     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
+     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
+     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
+     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
+
+     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
+     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
+     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
+     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
+     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
+     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
+     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
+     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
+     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
+     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
+
+     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
+     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
+     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
+     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
+     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
+     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
+     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
+     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
+     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
+     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
+
+     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
+     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
+     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
+     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
+     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
+     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
+     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
+     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
+     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
+     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
+
+     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
+     9110, 9122, 9134, 9146
+    } ;
+
+static yyconst flex_int16_t yy_def[1215] =
+    {   0,
+     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
+        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
+     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
+     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
+       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
+     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
+     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
+
+     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
+     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
+     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
+
+       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
+     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
+      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
+     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
+
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
+     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
+     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
+     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
+     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
+      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
+
+     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
+       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
+       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
+       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
+      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
+     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
+       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
+     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
+      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
+     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+
+       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
+     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
+       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
+     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
+     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
+
+     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
+     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
+     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
+     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
+       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+
+       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
+     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
+     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
+     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
+     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
+       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
+
+     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
+     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
+       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
+       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
+       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
+     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
+       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
+     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
+     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
+
+     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
+       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
+     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
+     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
+     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
+     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
+     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
+     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
+     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
+       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
+
+     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
+     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
+     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
+     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
+     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
+     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
+        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161
+    } ;
+
+static yyconst flex_int16_t yy_nxt[9249] =
+    {   0,
+       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
+       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
+       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
+       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
+       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
+       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
+       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
+       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
+
+       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
+       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
+       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
+       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
+       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
+       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
+       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
+       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
+       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
+     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
+
+       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
+       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
+      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
+      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
+       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
+      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
+       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
+      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
+      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
+      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
+
+       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
+       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
+      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
+      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
+      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
+      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
+      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
+      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
+      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
+      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
+
+      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
+      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
+      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
+      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
+      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
+      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
+      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
+      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
+      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
+      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
+
+      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
+      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
+      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
+      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
+      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
+      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
+      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
+       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
+      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
+      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
+
+      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
+      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
+      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
+      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
+      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
+      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
+      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
+      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
+       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
+      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
+
+      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
+      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
+      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
+      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
+      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
+      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
+      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
+      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
+      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
+
+      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
+      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
+      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
+      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
+      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
+      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
+      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
+      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
+      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
+      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
+
+      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
+     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
+      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
+      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
+      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
+      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
+      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
+      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
+      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
+      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
+
+      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
+      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
+      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
+      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
+      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
+      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
+      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
+      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
+      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
+      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
+
+      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
+      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
+       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
+      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
+      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
+      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
+      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
+      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
+      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
+      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
+
+      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
+      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
+      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
+      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
+      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
+      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
+      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
+      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
+      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
+      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
+
+      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
+      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
+      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
+      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
+      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
+      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
+      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
+      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
+      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
+     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
+
+      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
+      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
+      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
+      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
+     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
+      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
+      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
+     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
+      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
+      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
+
+      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
+      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
+      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
+       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
+      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
+      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
+      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
+      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
+      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
+      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
+
+      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
+      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
+      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
+     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
+      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
+      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
+      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
+      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
+      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
+      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
+
+      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
+      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
+      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
+      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
+      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
+      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
+      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
+      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
+      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
+     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
+
+      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
+      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
+      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
+      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
+      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
+      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
+      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
+      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
+      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
+      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
+
+      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
+      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
+      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
+      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
+      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
+      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
+      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
+     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
+      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
+      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
+
+     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
+      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
+      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
+      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
+      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
+      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
+      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
+      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
+     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
+      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
+      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
+      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
+
+      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
+      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
+      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
+      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
+      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
+      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
+      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
+      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
+      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
+
+      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
+      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
+      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
+      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
+      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
+      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
+      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
+      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
+      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
+      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
+
+     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
+      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
+      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
+      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
+      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
+      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
+      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
+     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
+      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
+       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
+
+      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
+      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
+       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
+      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
+      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
+      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
+      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
+     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
+      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
+      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
+
+      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
+     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
+      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
+     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
+      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
+      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
+      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
+      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
+      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
+      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
+
+      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
+     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
+      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
+      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
+      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
+     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
+      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
+     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
+      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
+     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
+
+      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
+      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
+      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
+      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
+     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
+     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
+     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
+      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
+      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
+      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
+
+      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
+      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
+     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
+      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
+      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
+     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
+      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
+     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
+      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
+     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
+
+      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
+      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
+      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
+      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
+     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
+      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
+      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
+     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
+      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
+      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
+
+     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
+     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
+      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
+     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
+      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
+      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
+      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
+     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
+      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
+     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
+
+      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
+     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
+      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
+     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
+     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
+      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
+     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
+      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
+      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
+      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
+
+     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
+      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
+      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
+      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
+      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
+      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
+     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
+      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
+     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
+
+      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
+      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
+      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
+      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
+      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
+      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
+
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
+      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
+      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
+      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
+
+      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
+      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
+     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
+      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
+     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
+     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
+     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
+     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
+      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
+      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
+
+      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
+      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
+     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
+      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
+      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
+      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
+     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
+      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
+     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
+     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
+
+     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
+      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
+      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
+      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
+      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
+      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
+      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
+      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
+     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
+     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
+
+      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
+      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
+      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
+      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
+      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
+      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
+      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
+     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
+      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
+      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
+
+     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
+      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
+      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
+      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
+
+     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
+     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
+     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
+      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
+     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
+      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
+      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
+     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
+      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
+      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
+
+     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
+     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
+     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
+      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
+      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
+      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
+      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
+      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
+      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
+     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
+
+      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
+      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
+      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
+     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
+      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
+     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
+      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
+      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
+      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
+
+      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
+      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
+      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
+      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
+      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
+      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
+      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
+      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
+     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
+      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
+
+     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
+     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
+      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
+      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
+     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
+     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
+      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
+      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
+
+      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
+     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
+      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
+      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
+      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
+      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
+      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
+      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
+      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
+      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
+      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
+      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
+      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
+     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
+      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
+      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
+     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
+
+      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
+      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
+      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
+     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
+      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
+     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
+      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
+      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
+      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
+      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
+
+     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
+      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
+      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
+      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
+      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
+     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
+     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
+
+     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
+      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
+      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
+      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+
+      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
+      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
+     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
+     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
+      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
+      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
+     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
+      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
+      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
+
+     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
+      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
+      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
+     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
+      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
+      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
+      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
+     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
+
+     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
+      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
+      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
+      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
+      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
+     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
+     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
+      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
+     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
+
+      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
+      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
+      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
+      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
+     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
+     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
+      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
+      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
+      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
+
+     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
+     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
+     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
+      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
+      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
+     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
+      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
+      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
+      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
+      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
+
+      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
+      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
+      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
+      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
+     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
+      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
+     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
+      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
+     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
+      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
+
+      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
+     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
+      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
+      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
+      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
+     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
+      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
+     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
+     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
+
+      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
+     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
+     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
+      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
+      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
+     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
+      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
+      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
+     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
+
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
+     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
+      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
+      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+
+      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
+      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
+     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
+      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
+      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
+      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
+      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
+
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
+      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
+     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
+      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
+
+      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
+      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
+     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
+      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
+     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
+      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
+      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
+      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
+
+     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
+     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
+      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
+     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
+     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
+     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
+      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
+      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
+      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
+      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
+
+      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
+      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
+      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
+     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
+      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
+      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
+     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
+      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
+      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
+
+      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
+      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
+     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
+     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
+     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
+      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
+      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
+     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
+     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
+      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
+
+     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
+      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
+      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
+     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
+     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
+      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
+     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
+      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
+
+      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
+     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
+      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
+      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
+      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
+     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
+      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
+      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
+      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
+      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
+
+     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
+      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
+     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
+     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
+      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
+      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
+      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
+      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
+
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
+      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
+     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
+      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
+
+      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
+      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
+     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
+      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
+
+      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
+      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
+      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
+      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
+      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
+      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
+      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
+     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
+      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
+     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
+
+     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
+      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
+     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
+      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
+      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
+     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
+      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
+      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
+      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
+
+     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
+      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
+      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
+     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
+      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
+      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
+      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
+      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
+     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
+      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
+
+      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
+      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
+      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
+      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
+      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
+     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
+     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
+      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
+     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
+      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
+
+      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
+     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
+      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
+     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
+      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
+     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
+      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
+     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
+     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
+
+     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
+      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
+      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
+      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
+      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
+      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
+      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
+     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
+     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
+
+      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
+      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
+      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
+     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
+     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
+     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
+     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
+      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
+
+      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
+     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
+     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
+     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
+      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
+      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
+      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
+      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
+      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
+      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
+
+     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
+     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
+      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
+      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
+      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
+      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
+      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
+      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
+      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
+
+      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
+     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
+      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
+     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
+      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
+     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
+      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
+     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
+     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
+      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
+
+      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
+      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
+     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
+     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
+     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
+     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
+      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
+     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
+      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
+
+     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
+     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
+      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
+     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
+     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
+      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
+     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
+      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
+      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
+
+      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
+      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
+      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
+     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
+      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
+     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
+     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
+     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
+     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
+     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
+
+     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
+     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
+     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
+      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
+     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
+     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
+     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
+     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+
+     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
+     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
+     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
+       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
+       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
+       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
+       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
+
+       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
+       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
+      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
+      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
+      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
+      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
+      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
+     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
+
+      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
+      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
+      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
+      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
+      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
+     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
+     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
+      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
+      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
+
+     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
+      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
+      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
+       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
+      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
+      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
+      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
+      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
+      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
+
+      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
+      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
+     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
+      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
+      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
+       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
+      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
+       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
+      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
+       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
+
+       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
+      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
+      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
+      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
+      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
+      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
+      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
+      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
+
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
+      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
+      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
+      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
+      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
+      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+    } ;
+
+static yyconst flex_int16_t yy_chk[9249] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
+        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
+
+       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
+       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
+        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
+       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
+       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
+        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
+        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
+       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
+     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
+
+       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
+       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
+       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
+       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
+       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
+      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
+       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
+       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
+       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
+       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
+
+       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
+       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
+      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
+       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
+       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
+       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
+       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
+       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
+      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
+       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
+
+       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
+       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
+      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
+       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
+      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
+       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
+       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
+       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
+      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
+
+      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
+       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
+       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
+      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
+       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
+       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
+       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
+       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
+       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
+      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
+
+      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
+       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
+       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
+       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
+      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
+       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
+       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
+       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
+       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
+
+       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
+       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
+      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
+      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
+      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
+      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
+      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
+      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
+      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
+      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
+      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
+
+      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
+      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
+      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
+      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
+      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
+      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
+      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
+      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
+      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
+      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
+
+      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
+      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
+      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
+      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
+      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
+      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
+      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
+      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
+      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
+      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
+
+      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
+      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
+       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
+      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
+      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
+      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
+      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
+      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
+      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
+      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
+
+      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
+      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
+      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
+      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
+      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
+      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
+      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
+      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
+      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
+      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
+
+      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
+      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
+      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
+     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
+      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
+      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
+      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
+      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
+      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
+     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
+
+      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
+      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
+      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
+      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
+        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
+      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
+      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
+        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
+      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
+      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
+
+      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
+      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
+      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
+      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
+      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
+      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
+      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
+      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
+      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
+      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
+
+      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
+      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
+      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
+        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
+      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
+      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
+      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
+      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
+      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
+      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
+
+      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
+      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
+      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
+      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
+      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
+      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
+      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
+      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
+      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
+        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
+
+      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
+      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
+      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
+      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
+      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
+      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
+      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
+      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
+      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
+      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
+
+      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
+      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
+      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
+      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
+      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
+      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
+      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
+        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
+      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
+      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
+
+        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
+      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
+      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
+      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
+      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
+      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
+      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
+        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
+      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
+      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
+      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
+
+      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
+      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
+      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
+      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
+      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
+      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
+      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
+      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
+      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
+
+      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
+      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
+      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
+      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
+      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
+      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
+      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
+      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
+      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
+      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
+
+        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
+      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
+      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
+      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
+      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
+      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
+      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
+        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
+      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
+      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
+
+      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
+      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
+      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
+      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
+      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
+      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
+      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
+        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
+      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
+      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
+
+      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
+        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
+      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
+      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
+      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
+      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
+      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
+      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
+      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
+      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
+
+      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
+        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
+      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
+      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
+      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
+     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
+      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
+      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
+      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
+     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
+
+      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
+      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
+      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
+      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
+     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
+        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
+     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
+      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
+      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
+      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
+
+      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
+      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
+     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
+      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
+      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
+     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
+      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
+     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
+      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
+        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
+
+      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
+      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
+      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
+     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
+        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
+      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
+      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
+     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
+      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
+      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
+
+     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
+     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
+      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
+        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
+      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
+      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
+      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
+     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
+      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
+        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
+
+      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
+        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
+      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
+      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
+        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
+      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
+     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
+      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
+      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
+      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
+
+        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
+      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
+      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
+      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
+      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
+      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
+        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
+      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
+     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
+
+      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
+      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
+     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
+      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
+      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
+      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
+      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
+      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
+
+      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
+      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
+      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
+     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
+      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
+      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
+      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
+
+      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
+     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
+        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
+      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
+        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
+     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
+        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
+        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
+      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
+      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
+
+      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
+      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
+     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
+      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
+      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
+      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
+     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
+      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
+        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
+        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
+
+        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
+      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
+      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
+      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
+      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
+      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
+      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
+      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
+        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
+     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
+
+      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
+      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
+      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
+      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
+      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
+      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
+      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
+        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
+      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
+      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
+
+        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
+
+        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
+        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
+        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
+      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
+        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
+      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
+      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
+        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
+      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
+      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
+
+        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
+        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
+        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
+      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
+      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
+      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
+      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
+      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
+      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
+        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
+
+      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
+      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
+      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
+      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
+        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
+      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
+        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
+      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
+      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
+      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
+
+      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
+      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
+      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
+      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
+      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
+      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
+      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
+      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
+        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
+      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
+
+        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
+        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
+      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
+      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
+        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
+      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
+        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
+      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
+      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
+      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
+
+      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
+        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
+      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
+      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
+      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
+      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
+      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
+      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
+      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
+      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
+
+      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
+     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
+     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
+      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
+        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
+      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
+      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
+      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
+      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
+        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
+
+      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
+      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
+      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
+        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
+      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
+        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
+      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
+      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
+      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
+      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
+
+        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
+      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
+      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
+      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
+      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
+      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
+     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
+        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
+
+        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
+        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+
+      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
+      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
+        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
+        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
+      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
+      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
+      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
+        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
+      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
+      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
+
+        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
+      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
+      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
+        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
+      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
+        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
+      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
+      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
+      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
+        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
+
+        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
+      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
+      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
+      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
+      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
+        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
+        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
+      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
+      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
+        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
+
+      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
+        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
+      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
+      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
+      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
+        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
+        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
+      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
+      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
+      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
+
+        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
+        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
+        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
+      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
+      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
+        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
+      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
+      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
+      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
+      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
+
+      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
+      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
+      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
+      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
+        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
+      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
+        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
+      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
+        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
+      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
+
+      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
+        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
+      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
+      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
+      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
+        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
+      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
+        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
+      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
+        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
+
+      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
+        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
+        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
+      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
+        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
+      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
+      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
+        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
+      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
+
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
+        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
+      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
+      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
+        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
+      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
+      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
+        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
+      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
+        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
+
+      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
+        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
+        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
+      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
+        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
+      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
+        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
+      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
+      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
+      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
+
+        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
+        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
+      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
+        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
+        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
+        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
+      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
+      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
+      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
+      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
+
+      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
+      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
+      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
+        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
+      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
+      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
+      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
+        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
+      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
+      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
+
+      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
+      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
+        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
+        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
+        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
+      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
+      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
+        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
+        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
+      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
+
+        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
+      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
+      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
+      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
+        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
+        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
+      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
+      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
+        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
+      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
+
+      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
+        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
+      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
+      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
+      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
+        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
+      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
+      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
+      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
+      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
+
+        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
+      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
+      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
+        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
+      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
+        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
+      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
+        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
+      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
+      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
+        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
+      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
+
+      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
+      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
+      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
+      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
+      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
+      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
+      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
+        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
+      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
+        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
+
+        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
+      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
+        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
+      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
+      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
+        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
+      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
+      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
+      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
+      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
+
+        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
+      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
+      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
+        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
+      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
+      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
+      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
+      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
+        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
+      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
+
+      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
+      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
+      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
+      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
+      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
+        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
+        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
+      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
+        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
+      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
+
+      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
+        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
+      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
+      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
+        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
+      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
+        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
+      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
+        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
+        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
+
+        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
+      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
+      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
+      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
+      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
+      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
+      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
+      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
+        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
+        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
+
+      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
+      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
+      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
+        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
+        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
+        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
+        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
+      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
+        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
+      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
+
+      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
+        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
+        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
+        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
+      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
+      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
+      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
+      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
+      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
+      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
+
+      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
+        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
+      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
+      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
+      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
+      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
+      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
+      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
+      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
+      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
+
+     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
+        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
+     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
+        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
+     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
+        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
+     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
+     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
+     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
+     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
+
+     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
+     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
+     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
+        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
+        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
+        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
+        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
+     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
+        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
+     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
+
+        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
+     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
+     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
+        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
+        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
+     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
+        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
+     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
+     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
+     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
+
+     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
+     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
+     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
+        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
+     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
+     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
+        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
+        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
+        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
+        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
+
+        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
+     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
+     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
+     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
+        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
+        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
+     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
+     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
+     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
+     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
+
+     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
+     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
+        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
+        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
+     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
+     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
+     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+
+     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
+     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
+     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
+     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
+     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
+        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
+
+     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
+     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
+     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
+     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
+     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
+     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
+        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
+        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
+     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
+     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
+
+        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
+     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
+     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
+     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
+     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
+     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
+     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
+     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
+     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
+     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
+
+     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
+     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
+        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
+     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
+     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
+     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
+     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
+     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
+     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
+     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
+
+     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
+     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
+     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
+     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
+     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
+     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
+     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
+     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
+     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
+     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
+
+     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
+     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
+     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
+     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
+     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
+     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int fortran_flex_debug;
+int fortran_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *fortrantext;
+#line 1 "fortran.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+
+
+
+
+#line 41 "fortran.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * fortranin;
+#define MAX_INCLUDE_DEPTH 30
+#define tabsize 6
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_fortran=1;
+int line_num_fortran_common=1;
+int newlinef90 = 0;
+char *tmp;
+char tmpc;
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION \
+        {\
+           if (firstpass == 0) \
+           {\
+              strcat(curbuf,fortrantext); \
+              Save_Length(curbuf,38); \
+              strcpy(motparse,fortrantext);\
+              Save_Length(motparse,32); \
+              colnum = colnum + strlen(motparse);\
+              ECHO; \
+           }\
+           strcpy(motparse1,fortrantext);\
+/*           printf("fortrantext = %s\n",fortrantext);*/\
+        /*if ( firstpass == 1 ) 
+                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
+        }
+#line 2979 "fortran.yy.c"
+
+#define INITIAL 0
+#define parameter 1
+#define character 2
+#define donottreat 3
+#define fortran77style 4
+#define fortran90style 5
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int fortranlex_destroy (void );
+
+int fortranget_debug (void );
+
+void fortranset_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortranget_extra (void );
+
+void fortranset_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortranget_in (void );
+
+void fortranset_in  (FILE * in_str  );
+
+FILE *fortranget_out (void );
+
+void fortranset_out  (FILE * out_str  );
+
+yy_size_t fortranget_leng (void );
+
+char *fortranget_text (void );
+
+int fortranget_lineno (void );
+
+void fortranset_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int fortranwrap (void );
+#else
+extern int fortranwrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( fortranin ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(fortranin); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int fortranlex (void);
+
+#define YY_DECL int fortranlex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after fortrantext and fortranleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	if ( fortranleng > 0 ) \
+		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
+				(fortrantext[fortranleng - 1] == '\n'); \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 107 "fortran.lex"
+
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree) BEGIN(fortran90style)  ;
+
+#line 3174 "fortran.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! fortranin )
+			fortranin = stdin;
+
+		if ( ! fortranout )
+			fortranout = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			fortranensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				fortran_create_buffer(fortranin,YY_BUF_SIZE );
+		}
+
+		fortran_load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of fortrantext. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+		yy_current_state += YY_AT_BOL();
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 1162 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 9159 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 111 "fortran.lex"
+return TOK_DEBUT;
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 112 "fortran.lex"
+return TOK_FIN;
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 113 "fortran.lex"
+return TOK_OMP;
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 114 "fortran.lex"
+return TOK_DOLLAR;
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 116 "fortran.lex"
+{return TOK_REAL8;}
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 117 "fortran.lex"
+{return TOK_SUBROUTINE;}
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 118 "fortran.lex"
+{return TOK_PROGRAM;}
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 119 "fortran.lex"
+{inallocate = 1; return TOK_ALLOCATE;}
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 120 "fortran.lex"
+{return TOK_NULLIFY;}
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 121 "fortran.lex"
+{inallocate = 1; return TOK_DEALLOCATE;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 122 "fortran.lex"
+{return TOK_RESULT;}
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 123 "fortran.lex"
+{return TOK_FUNCTION;}
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 124 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 125 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 126 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 127 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 128 "fortran.lex"
+return TOK_INCLUDE;
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 129 "fortran.lex"
+{
+                            strcpy(yylval.na,fortrantext);
+                            tmpc = input();
+                            unput(tmpc);
+                            if ( (
+                               tmpc >= 'a' && tmpc <= 'z'
+                                  ) || (
+                               tmpc >= 'A' && tmpc <= 'Z'
+                               )  )
+                               {
+                                  return TOK_USE;
+                               }
+                               else
+                               {
+                                  return TOK_NAME;
+                               }
+                         }
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{return TOK_REWIND;}
+	YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+return TOK_IMPLICIT;
+	YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+return TOK_NONE;
+	YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+return TOK_CALL;
+	YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+return TOK_TRUE;
+	YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+return TOK_FALSE;
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{return TOK_POINT_TO;}
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_EQV;}
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_EQ;}
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_GT;}
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_GE;}
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LT;}
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LE;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NE;}
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NOT;}
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_OR;}
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_XOR;}
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_AND;}
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{return TOK_MODULE;}
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{return TOK_DOWHILE;}
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+return TOK_ENDMODULE;
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+return TOK_ENDDO;
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{return TOK_PLAINDO;}
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_REAL;}
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{return TOK_ALLOCATABLE;}
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+return TOK_CLOSE;
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+return TOK_INQUIRE;
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{return TOK_DIMENSION;}
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+return TOK_PAUSE;
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+return TOK_EQUIVALENCE;
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+return TOK_STOP;
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+return TOK_WHERE;
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+return TOK_ENDWHERE;
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+return TOK_ELSEWHERE;
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{return TOK_COMPLEX;}
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{return TOK_CONTAINS;}
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{return TOK_ONLY;}
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{return TOK_PARAMETER;}
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{return TOK_RECURSIVE;}
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{return TOK_COMMON;}
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{return TOK_GLOBAL;}
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{return TOK_EXTERNAL;}
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{return TOK_INTENT;}
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{return TOK_POINTER;}
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{return TOK_OPTIONAL;}
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{return TOK_SAVE;}
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{return TOK_TYPE;}
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{return TOK_TYPEPAR;}
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{return TOK_ENDTYPE;}
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+return TOK_OPEN;
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+return TOK_RETURN;
+	YY_BREAK
+case 76:
+/* rule 76 can match eol */
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+return TOK_EXIT;
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+return TOK_PRINT;
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{return TOK_PROCEDURE;}
+	YY_BREAK
+case 79:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{return TOK_READ;}
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{return TOK_NAMELIST;}
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{return TOK_WRITE;}
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{return TOK_TARGET;}
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{return TOK_PUBLIC;}
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{return TOK_PRIVATE;}
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_IN;}
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DATA;}
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+return TOK_CONTINUE;
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{return TOK_PLAINGOTO;}
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{return TOK_INTRINSIC;}
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{return TOK_THEN;}
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{return TOK_ELSEIF;}
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{return TOK_ELSE;}
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{return TOK_ENDIF;}
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{return TOK_LOGICALIF;}
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{return TOK_SUM;}
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{return TOK_MAX;}
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{return TOK_TANH;}
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{return TOK_MAXVAL;}
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{return TOK_TRIM;}
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{return TOK_SQRT;}
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{return TOK_SELECTCASE;}
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{return TOK_CASE;}
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{return TOK_CASEDEFAULT;}
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{return TOK_ENDSELECT;}
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{return TOK_FILE;}
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{return TOK_END;}
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{return TOK_ERR;}
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{return TOK_EXIST;}
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{return TOK_MIN;}
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{return TOK_NINT;}
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{return TOK_FLOAT;}
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{return TOK_EXP;}
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{return TOK_COS;}
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{return TOK_COSH;}
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{return TOK_ACOS;}
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{return TOK_SIN;}
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{return TOK_SINH;}
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{return TOK_ASIN;}
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 248 "fortran.lex"
+{return TOK_LOG;}
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 249 "fortran.lex"
+{return TOK_TAN;}
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 250 "fortran.lex"
+{return TOK_ATAN;}
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 251 "fortran.lex"
+{return TOK_CYCLE;}
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 252 "fortran.lex"
+{return TOK_ABS;}
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 253 "fortran.lex"
+{return TOK_MOD;}
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 254 "fortran.lex"
+{return TOK_SIGN;}
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 255 "fortran.lex"
+{return TOK_MINLOC;}
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 256 "fortran.lex"
+{return TOK_MAXLOC;}
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 257 "fortran.lex"
+{return TOK_MINVAL;}
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 258 "fortran.lex"
+{return TOK_BACKSPACE;}
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 259 "fortran.lex"
+{return TOK_LEFTAB;}
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 260 "fortran.lex"
+{return TOK_RIGHTAB;}
+	YY_BREAK
+case 134:
+/* rule 134 can match eol */
+YY_RULE_SETUP
+#line 261 "fortran.lex"
+{return TOK_FORMAT;}
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 262 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 263 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 264 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 265 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
+	YY_BREAK
+case 139:
+/* rule 139 can match eol */
+YY_RULE_SETUP
+#line 266 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 267 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 268 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 269 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
+	YY_BREAK
+case 143:
+YY_RULE_SETUP
+#line 270 "fortran.lex"
+{printf("debug interfacer\n");BEGIN(donottreat);}
+	YY_BREAK
+case 144:
+/* rule 144 can match eol */
+YY_RULE_SETUP
+#line 271 "fortran.lex"
+{
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+	YY_BREAK
+case 145:
+YY_RULE_SETUP
+#line 278 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NAME;}
+	YY_BREAK
+case 146:
+YY_RULE_SETUP
+#line 279 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
+	YY_BREAK
+case 147:
+YY_RULE_SETUP
+#line 280 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
+	YY_BREAK
+case 148:
+YY_RULE_SETUP
+#line 281 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
+	YY_BREAK
+case 149:
+/* rule 149 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortrantext again */
+YY_RULE_SETUP
+#line 282 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
+	YY_BREAK
+case 150:
+YY_RULE_SETUP
+#line 283 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
+	YY_BREAK
+case 151:
+YY_RULE_SETUP
+#line 284 "fortran.lex"
+{}
+	YY_BREAK
+case 152:
+YY_RULE_SETUP
+#line 285 "fortran.lex"
+{return TOK_QUOTE;}
+	YY_BREAK
+case 153:
+YY_RULE_SETUP
+#line 286 "fortran.lex"
+{}
+	YY_BREAK
+case 154:
+YY_RULE_SETUP
+#line 287 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
+	YY_BREAK
+case 155:
+YY_RULE_SETUP
+#line 288 "fortran.lex"
+{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
+	YY_BREAK
+case 156:
+YY_RULE_SETUP
+#line 289 "fortran.lex"
+{return TOK_SEMICOLON;}
+	YY_BREAK
+case 157:
+YY_RULE_SETUP
+#line 290 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 158:
+YY_RULE_SETUP
+#line 291 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 159:
+YY_RULE_SETUP
+#line 292 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 160:
+YY_RULE_SETUP
+#line 293 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 161:
+/* rule 161 can match eol */
+YY_RULE_SETUP
+#line 294 "fortran.lex"
+{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
+	YY_BREAK
+case 162:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortrantext again */
+YY_RULE_SETUP
+#line 295 "fortran.lex"
+
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 296 "fortran.lex"
+{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
+	YY_BREAK
+case 164:
+YY_RULE_SETUP
+#line 297 "fortran.lex"
+
+	YY_BREAK
+case 165:
+YY_RULE_SETUP
+#line 298 "fortran.lex"
+{colnum=colnum-1+tabsize;}
+	YY_BREAK
+case 166:
+YY_RULE_SETUP
+#line 299 "fortran.lex"
+;
+	YY_BREAK
+case 167:
+/* rule 167 can match eol */
+YY_RULE_SETUP
+#line 300 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
+	YY_BREAK
+case 168:
+/* rule 168 can match eol */
+YY_RULE_SETUP
+#line 301 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;colnum=0;}
+	YY_BREAK
+case 169:
+/* rule 169 can match eol */
+YY_RULE_SETUP
+#line 302 "fortran.lex"
+{
+                           convert2lower(motparse1);
+                           if ( strncasecmp(motparse1,"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }
+	YY_BREAK
+case 170:
+/* rule 170 can match eol */
+YY_RULE_SETUP
+#line 317 "fortran.lex"
+{
+                           convert2lower(&motparse1[1]);
+                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }                            
+	YY_BREAK
+case 171:
+/* rule 171 can match eol */
+YY_RULE_SETUP
+#line 332 "fortran.lex"
+{
+						BEGIN(donottreat);
+						}
+	YY_BREAK
+case 172:
+/* rule 172 can match eol */
+YY_RULE_SETUP
+#line 335 "fortran.lex"
+{
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+	YY_BREAK
+case 173:
+/* rule 173 can match eol */
+YY_RULE_SETUP
+#line 342 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;}
+	YY_BREAK
+case 174:
+/* rule 174 can match eol */
+YY_RULE_SETUP
+#line 343 "fortran.lex"
+{
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+	YY_BREAK
+case 175:
+YY_RULE_SETUP
+#line 348 "fortran.lex"
+{
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+	YY_BREAK
+case 176:
+YY_RULE_SETUP
+#line 353 "fortran.lex"
+ECHO;
+	YY_BREAK
+#line 4224 "fortran.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(parameter):
+case YY_STATE_EOF(character):
+case YY_STATE_EOF(donottreat):
+case YY_STATE_EOF(fortran77style):
+case YY_STATE_EOF(fortran90style):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed fortranin at a new source and called
+			 * fortranlex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( fortranwrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * fortrantext, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of fortranlex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			fortranrestart(fortranin  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+	yy_current_state += YY_AT_BOL();
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 1162 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 1162 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 1161);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up fortrantext */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					fortranrestart(fortranin );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( fortranwrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void fortranrestart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        fortranensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            fortran_create_buffer(fortranin,YY_BUF_SIZE );
+	}
+
+	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		fortranpop_buffer_state();
+	 *		fortranpush_buffer_state(new_buffer);
+     */
+	fortranensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	fortran_load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (fortranwrap()) processing, but the only time this flag
+	 * is looked at is after fortranwrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void fortran_load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	fortran_init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with fortran_create_buffer()
+ * 
+ */
+    void fortran_delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		fortranfree((void *) b->yy_ch_buf  );
+
+	fortranfree((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a fortranrestart() or at EOF.
+ */
+    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	fortran_flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then fortran_init_buffer was _probably_
+     * called from fortranrestart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void fortran_flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		fortran_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	fortranensure_buffer_stack();
+
+	/* This block is copied from fortran_switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from fortran_switch_to_buffer. */
+	fortran_load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void fortranpop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	fortran_delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		fortran_load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void fortranensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	fortran_switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to fortranlex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       fortran_scan_bytes() instead.
+ */
+YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
+{
+    
+	return fortran_scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) fortranalloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = fortran_scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortrantext. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		fortrantext[fortranleng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		fortranleng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int fortranget_lineno  (void)
+{
+        
+    return fortranlineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *fortranget_in  (void)
+{
+        return fortranin;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *fortranget_out  (void)
+{
+        return fortranout;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t fortranget_leng  (void)
+{
+        return fortranleng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *fortranget_text  (void)
+{
+        return fortrantext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void fortranset_lineno (int  line_number )
+{
+    
+    fortranlineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see fortran_switch_to_buffer
+ */
+void fortranset_in (FILE *  in_str )
+{
+        fortranin = in_str ;
+}
+
+void fortranset_out (FILE *  out_str )
+{
+        fortranout = out_str ;
+}
+
+int fortranget_debug  (void)
+{
+        return fortran_flex_debug;
+}
+
+void fortranset_debug (int  bdebug )
+{
+        fortran_flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from fortranlex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    fortranin = stdin;
+    fortranout = stdout;
+#else
+    fortranin = (FILE *) 0;
+    fortranout = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * fortranlex_init()
+     */
+    return 0;
+}
+
+/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
+int fortranlex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		fortran_delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		fortranpop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	fortranfree((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * fortranlex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *fortranalloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *fortranrealloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void fortranfree (void * ptr )
+{
+	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 353 "fortran.lex"
+
+
+
+fortranerror(char *s)
+{
+   if (!strcasecmp(curfile,mainfile))
+   {
+      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
+   }
+   else
+   {
+      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
+   }
+/*   exit(0);*/
+}
+
+int fortranwrap()
+{
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.lex	(revision 3437)
@@ -0,0 +1,370 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%x parameter
+%s character
+%x donottreat
+%s fortran77style
+%s fortran90style
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+#define tabsize 6
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_fortran=1;
+int line_num_fortran_common=1;
+int newlinef90 = 0;
+char *tmp;
+char tmpc;
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION \
+        {\
+           if (firstpass == 0) \
+           {\
+              strcat(curbuf,yytext); \
+              Save_Length(curbuf,38); \
+              strcpy(motparse,yytext);\
+              Save_Length(motparse,32); \
+              colnum = colnum + strlen(motparse);\
+              ECHO; \
+           }\
+           strcpy(motparse1,yytext);\
+/*           printf("yytext = %s\n",yytext);*/\
+        /*if ( firstpass == 1 ) 
+                      printf("yytext = %s %d\n",yytext,strlen(yytext));*/\
+        }
+%}
+AGRIFDEB "Agrif_debut"
+AGRIFFIN "Agrif_fin"
+REAL8 "real*8"[ \t]*"(a-h,o-z)"
+NOTTREAT Agrif_do_not_treat
+ENDNOTTREAT Agrif_end_do_not_treat
+
+NIMPORTEQUOI .
+SLASH "/"
+DSLASH "/"[ \t]*"/"
+NAME [a-zA-Z\_][a-zA-Z0-9\_]*
+DIGIT [0-9]+
+INT {DIGIT}
+EXPONENT e[-+]?{DIGIT}
+DEXPONENT d[-+]?{DIGIT}
+QEXPONENT q[-+]?{DIGIT}
+REAL (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){EXPONENT}?)|{DIGIT}\.{EXPONENT}
+REALDP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){DEXPONENT}?)|{DIGIT}\.{DEXPONENT}
+REALQP (({DIGIT}\.[0-9]+|[0-9]*\.{DIGIT}){QEXPONENT}?)|{DIGIT}\.{QEXPONENT}
+ENDFUNCTION end[ \t]*function
+DOUBLEPRECISION double[ \t]*precision
+DOUBLECOMPLEX double[ \t]*complex
+
+COMMENTAIRESFORTRAN77 ^([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
+COMMENTAIRESFORTRAN77_2 \n([Cc*](([ \t]*\n)|([^AaHhOo\n]{NIMPORTEQUOI}*\n)))
+COMMENTAIRESFORTRAN90 ^([ \t]*!{NIMPORTEQUOI}*\n)
+COMMENTAIRESFORTRAN90_2 (!{NIMPORTEQUOI}*)
+NEXTLINEF90 "&"{NIMPORTEQUOI}*[\n]*
+NEXTLINEF77 [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
+%%
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree) BEGIN(fortran90style)  ;
+
+^C${AGRIFDEB}            return TOK_DEBUT;
+^C${AGRIFFIN}            return TOK_FIN;
+^C$OMP[ \t]*{NIMPORTEQUOI}* return TOK_OMP;
+^C$[ \t]*{NIMPORTEQUOI}* return TOK_DOLLAR;
+
+{REAL8}                 {return TOK_REAL8;}
+subroutine              {return TOK_SUBROUTINE;}
+program                 {return TOK_PROGRAM;}
+allocate                {inallocate = 1; return TOK_ALLOCATE;}
+nullify			{return TOK_NULLIFY;}
+deallocate              {inallocate = 1; return TOK_DEALLOCATE;}
+result                  {return TOK_RESULT;}
+function                {return TOK_FUNCTION;}
+end[ \t]*subroutine     {strcpy(yylval.na,yytext);return TOK_ENDSUBROUTINE;}
+end[ \t]*program        {strcpy(yylval.na,yytext);return TOK_ENDPROGRAM;}
+end[ \t]*function       {strcpy(yylval.na,yytext);return TOK_ENDFUNCTION;}
+end                     {strcpy(yylval.na,yytext);return TOK_ENDUNIT;}
+include                  return TOK_INCLUDE;
+^[ \t]*use[ ]+           {
+                            strcpy(yylval.na,yytext);
+                            tmpc = input();
+                            unput(tmpc);
+                            if ( (
+                               tmpc >= 'a' && tmpc <= 'z'
+                                  ) || (
+                               tmpc >= 'A' && tmpc <= 'Z'
+                               )  )
+                               {
+                                  return TOK_USE;
+                               }
+                               else
+                               {
+                                  return TOK_NAME;
+                               }
+                         }
+rewind                  {return TOK_REWIND;}
+implicit                 return TOK_IMPLICIT;
+none                     return TOK_NONE;
+call                     return TOK_CALL;
+.true.                   return TOK_TRUE;
+.false.                  return TOK_FALSE;
+\=\>                    {return TOK_POINT_TO;}
+\*\*                    {strcpy(yylval.na,yytext);return TOK_DASTER;}
+\.[ \t]*eqv\.            {strcpy(yylval.na,yytext);return TOK_EQV;}
+\.[ \t]*eq\.            {strcpy(yylval.na,yytext);return TOK_EQ;}
+\.[ \t]*gt\.            {strcpy(yylval.na,yytext);return TOK_GT;}
+\.[ \t]*ge\.            {strcpy(yylval.na,yytext);return TOK_GE;}
+\.[ \t]*lt\.            {strcpy(yylval.na,yytext);return TOK_LT;}
+\.[ \t]*le\.            {strcpy(yylval.na,yytext);return TOK_LE;}
+\.[ \t]*neqv\.          {strcpy(yylval.na,yytext);return TOK_NEQV;}
+\.[ \t]*ne\.            {strcpy(yylval.na,yytext);return TOK_NE;}
+\.[ \t]*not\.           {strcpy(yylval.na,yytext);return TOK_NOT;}
+\.[ \t]*or\.            {strcpy(yylval.na,yytext);return TOK_OR;}
+\.[ \t]*xor\.           {strcpy(yylval.na,yytext);return TOK_XOR;}
+\.[ \t]*and\.           {strcpy(yylval.na,yytext);return TOK_AND;}
+module                  {return TOK_MODULE;}
+do[ 0-9\t]*while           {return TOK_DOWHILE;}
+end[ \t]*module          return TOK_ENDMODULE;
+end[ \t]*do              return TOK_ENDDO;
+do                      {return TOK_PLAINDO;}
+real                    {strcpy(yylval.na,yytext);return TOK_REAL;}
+integer                 {strcpy(yylval.na,yytext);return TOK_INTEGER;}
+logical                 {strcpy(yylval.na,yytext);return TOK_LOGICAL;}
+character               {strcpy(yylval.na,yytext);return TOK_CHARACTER;}
+allocatable             {return TOK_ALLOCATABLE;}
+close                    return TOK_CLOSE;
+inquire                  return TOK_INQUIRE;
+dimension               {return TOK_DIMENSION;}
+pause                    return TOK_PAUSE;
+equivalence              return TOK_EQUIVALENCE;
+stop                     return TOK_STOP;
+where                    return TOK_WHERE;
+end[ \t]*where           return TOK_ENDWHERE;
+else[ \t]*where          return TOK_ELSEWHERE;
+complex                 {return TOK_COMPLEX;}
+^[ \t]*contains         {return TOK_CONTAINS;}
+only                    {return TOK_ONLY;}
+parameter               {return TOK_PARAMETER;}
+recursive               {return TOK_RECURSIVE;}
+common                  {return TOK_COMMON;}
+^[ \t]*global[ \t]+     {return TOK_GLOBAL;}
+external                {return TOK_EXTERNAL;}
+intent                  {return TOK_INTENT;}
+pointer                 {return TOK_POINTER;}
+optional                {return TOK_OPTIONAL;}
+save                    {return TOK_SAVE;}
+^[ \t]*type[ \t\,]+       {return TOK_TYPE;}
+^[ \t]*type[ \t]*\(     {return TOK_TYPEPAR;}
+stat                    {if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,yytext);return TOK_NAME;}}
+end[ \t]*type           {return TOK_ENDTYPE;}
+open                     return TOK_OPEN;
+return                   return TOK_RETURN;
+exit[^(]                 return TOK_EXIT;
+print                    return TOK_PRINT;
+module[ \t]*procedure   {return TOK_PROCEDURE;}
+read                    {return TOK_READ;}
+namelist                {return TOK_NAMELIST;}
+write                   {return TOK_WRITE;}
+target                  {return TOK_TARGET;}
+public                  {return TOK_PUBLIC;}
+private                 {return TOK_PRIVATE;}
+in                      {strcpy(yylval.nac,yytext);return TOK_IN;}
+^[ \t]*data[ \t]+       {strcpy(yylval.na,yytext);return TOK_DATA;}
+continue                 return TOK_CONTINUE;
+go[ \t]*to              {return TOK_PLAINGOTO;}
+out                     {strcpy(yylval.nac,yytext);return TOK_OUT;}
+inout                   {strcpy(yylval.nac,yytext);return TOK_INOUT;}
+intrinsic               {return TOK_INTRINSIC;}
+then                    {return TOK_THEN;}
+else[ \t]*if            {return TOK_ELSEIF;}
+else                    {return TOK_ELSE;}
+end[ \t]*if             {return TOK_ENDIF;}
+if[ \t]*\(              {return TOK_LOGICALIF;}
+sum[ \t]*\(             {return TOK_SUM;}
+max[ \t]*\(             {return TOK_MAX;}
+tanh                    {return TOK_TANH;}
+maxval                  {return TOK_MAXVAL;}
+trim                    {return TOK_TRIM;}
+sqrt\(                  {return TOK_SQRT;}
+select[ \t]*case        {return TOK_SELECTCASE;}
+^[ \t]*case[ \t]*\(     {return TOK_CASE;}
+^[ \t]*case[ \t]*default       {return TOK_CASEDEFAULT;}
+end[ \t]*select         {return TOK_ENDSELECT;}
+file[ \t]*\=            {return TOK_FILE;}
+end[ \t]*\=             {return TOK_END;}
+err[ \t]*\=             {return TOK_ERR;}
+exist[ \t]*\=           {return TOK_EXIST;}
+min[ \t]*\(             {return TOK_MIN;}
+nint                    {return TOK_NINT;}
+float                   {return TOK_FLOAT;}
+exp                     {return TOK_EXP;}
+cos                     {return TOK_COS;}
+cosh                    {return TOK_COSH;}
+acos                    {return TOK_ACOS;}
+sin                     {return TOK_SIN;}
+sinh                    {return TOK_SINH;}
+asin                    {return TOK_ASIN;}
+log                     {return TOK_LOG;}
+tan                     {return TOK_TAN;}
+atan                    {return TOK_ATAN;}
+cycle                   {return TOK_CYCLE;}
+abs\(                   {return TOK_ABS;}
+mod                     {return TOK_MOD;}
+sign                    {return TOK_SIGN;}
+minloc                  {return TOK_MINLOC;}
+maxloc                  {return TOK_MAXLOC;}
+minval                  {return TOK_MINVAL;}
+backspace               {return TOK_BACKSPACE;}
+\({SLASH}               {return TOK_LEFTAB;}
+{SLASH}\)               {return TOK_RIGHTAB;}
+format[ \t]*\(({NIMPORTEQUOI}|{NEXTLINEF90}|{NEXTLINEF77})*\)  {return TOK_FORMAT;}
+{DOUBLEPRECISION}       {strcpy(yylval.na,yytext);return TOK_DOUBLEPRECISION;}
+{DOUBLECOMPLEX}         {strcpy(yylval.na,yytext);return TOK_DOUBLECOMPLEX;}
+{SLASH}                 {strcpy(yylval.na,yytext);return TOK_SLASH;}
+DSLASH                  {strcpy(yylval.na,yytext);return TOK_DSLASH;}
+(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CUT;}
+(\')[^\n']*(\')         {strcpy(yylval.na,yytext);return TOK_CHAR_CONSTANT;}
+(\")[^\n"]*(\")         {strcpy(yylval.na,yytext);return TOK_CHAR_MESSAGE;}
+({NAME}{REAL})          {strcpy(yylval.na,yytext);return TOK_CHAR_INT;}
+^[ \t]*interface        {printf("debug interfacer\n");BEGIN(donottreat);}
+<donottreat>^[ \t]*end[ \t]*interface[ \t]*\n {
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+{NAME}                  {strcpy(yylval.na,yytext);return TOK_NAME;}
+{REAL}                  {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
+{REALDP}                {strcpy(yylval.na,yytext);return TOK_CSTREALDP;}
+{REALQP}                {strcpy(yylval.na,yytext);return TOK_CSTREALQP;}
+({DIGIT}\.)/[^{NAME}|"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {strcpy(yylval.na,yytext);return TOK_CSTREAL;}
+{INT}                   {strcpy(yylval.na,yytext);return TOK_CSTINT;}
+\$ {}
+\'|\"                   {return TOK_QUOTE;}
+\.                      {}
+\(|\)|:|\[|\]|\+|\-|\* {strcpy(yylval.na,yytext);return (int) *yytext;}
+\%                     {afterpercent = 1; strcpy(yylval.na,yytext);return (int) *yytext;}
+\;                      {return TOK_SEMICOLON;}
+\,                      {return (int) *yytext;}
+\=                      {return (int) *yytext;}
+\<                      {return (int) *yytext;}
+\>                      {return (int) *yytext;}
+\n                      {colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *yytext;}
+^[ ]*$
+^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+ {if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
+[ ]+
+[\t]+                   {colnum=colnum-1+tabsize;}
+[ \t]+ ;
+{NEXTLINEF90}           {line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
+{NEXTLINEF77}           {line_num_fortran++;line_num_fortran_common++;colnum=0;}
+<fortran77style>{COMMENTAIRESFORTRAN77} {
+                           convert2lower(motparse1);
+                           if ( strncasecmp(motparse1,"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }
+<fortran77style>{COMMENTAIRESFORTRAN77_2} {
+                           convert2lower(&motparse1[1]);
+                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }                            
+^"!$AGRIF_DO_NOT_TREAT"[ \t]*\n {
+						BEGIN(donottreat);
+						}
+<donottreat>^"!$AGRIF_END_DO_NOT_TREAT"[ \t]*\n {
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+<donottreat>.*\n        {line_num_fortran++;line_num_fortran_common++;}
+{COMMENTAIRESFORTRAN90}   {
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+{COMMENTAIRESFORTRAN90_2} {
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+%%
+
+fortranerror(char *s)
+{
+   if (!strcasecmp(curfile,mainfile))
+   {
+      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,yytext);
+   }
+   else
+   {
+      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,yytext,curbuf);
+   }
+/*   exit(0);*/
+}
+
+int fortranwrap()
+{
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.tab.c	(revision 3437)
@@ -0,0 +1,6863 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse fortranparse
+#define yylex   fortranlex
+#define yyerror fortranerror
+#define yylval  fortranlval
+#define yychar  fortranchar
+#define yydebug fortrandebug
+#define yynerrs fortrannerrs
+
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_BINARY_OP = 258,
+     TOK_NEQV = 259,
+     TOK_EQV = 260,
+     TOK_XOR = 261,
+     TOK_OR = 262,
+     TOK_AND = 263,
+     TOK_NOT = 264,
+     TOK_NE = 265,
+     TOK_EQ = 266,
+     TOK_GE = 267,
+     TOK_LE = 268,
+     TOK_GT = 269,
+     TOK_LT = 270,
+     TOK_UNARY_OP = 271,
+     TOK_DSLASH = 272,
+     TOK_SLASH = 273,
+     TOK_DASTER = 274,
+     TOK_SEP = 275,
+     TOK_SEMICOLON = 276,
+     TOK_NEXTLINE = 277,
+     TOK_PARAMETER = 278,
+     TOK_RESULT = 279,
+     TOK_ONLY = 280,
+     TOK_INCLUDE = 281,
+     TOK_SUBROUTINE = 282,
+     TOK_PROGRAM = 283,
+     TOK_FUNCTION = 284,
+     TOK_OMP = 285,
+     TOK_DOLLAR = 286,
+     TOK_FORMAT = 287,
+     TOK_MAX = 288,
+     TOK_TANH = 289,
+     TOK_WHERE = 290,
+     TOK_ELSEWHERE = 291,
+     TOK_ENDWHERE = 292,
+     TOK_MAXVAL = 293,
+     TOK_TRIM = 294,
+     TOK_SUM = 295,
+     TOK_SQRT = 296,
+     TOK_CASE = 297,
+     TOK_SELECTCASE = 298,
+     TOK_FILE = 299,
+     TOK_END = 300,
+     TOK_ERR = 301,
+     TOK_DONOTTREAT = 302,
+     TOK_ENDDONOTTREAT = 303,
+     TOK_EXIST = 304,
+     TOK_MIN = 305,
+     TOK_FLOAT = 306,
+     TOK_EXP = 307,
+     TOK_COS = 308,
+     TOK_COSH = 309,
+     TOK_ACOS = 310,
+     TOK_NINT = 311,
+     TOK_CYCLE = 312,
+     TOK_SIN = 313,
+     TOK_SINH = 314,
+     TOK_ASIN = 315,
+     TOK_EQUIVALENCE = 316,
+     TOK_BACKSPACE = 317,
+     TOK_LOG = 318,
+     TOK_TAN = 319,
+     TOK_ATAN = 320,
+     TOK_RECURSIVE = 321,
+     TOK_ABS = 322,
+     TOK_MOD = 323,
+     TOK_SIGN = 324,
+     TOK_MINLOC = 325,
+     TOK_MAXLOC = 326,
+     TOK_EXIT = 327,
+     TOK_MINVAL = 328,
+     TOK_PUBLIC = 329,
+     TOK_PRIVATE = 330,
+     TOK_ALLOCATABLE = 331,
+     TOK_RETURN = 332,
+     TOK_THEN = 333,
+     TOK_ELSEIF = 334,
+     TOK_ELSE = 335,
+     TOK_ENDIF = 336,
+     TOK_PRINT = 337,
+     TOK_PLAINGOTO = 338,
+     TOK_CONSTRUCTID = 339,
+     TOK_LOGICALIF = 340,
+     TOK_PLAINDO = 341,
+     TOK_CONTAINS = 342,
+     TOK_ENDDO = 343,
+     TOK_MODULE = 344,
+     TOK_ENDMODULE = 345,
+     TOK_DOWHILE = 346,
+     TOK_ALLOCATE = 347,
+     TOK_OPEN = 348,
+     TOK_CLOSE = 349,
+     TOK_INQUIRE = 350,
+     TOK_WRITE = 351,
+     TOK_READ = 352,
+     TOK_REWIND = 353,
+     TOK_DEALLOCATE = 354,
+     TOK_NULLIFY = 355,
+     TOK_FIN = 356,
+     TOK_DEBUT = 357,
+     TOK_DIMENSION = 358,
+     TOK_ENDSELECT = 359,
+     TOK_EXTERNAL = 360,
+     TOK_INTENT = 361,
+     TOK_INTRINSIC = 362,
+     TOK_NAMELIST = 363,
+     TOK_CASEDEFAULT = 364,
+     TOK_OPTIONAL = 365,
+     TOK_POINTER = 366,
+     TOK_CONTINUE = 367,
+     TOK_SAVE = 368,
+     TOK_TARGET = 369,
+     TOK_QUOTE = 370,
+     TOK_IMPLICIT = 371,
+     TOK_NONE = 372,
+     TOK_CALL = 373,
+     TOK_STAT = 374,
+     TOK_POINT_TO = 375,
+     TOK_COMMON = 376,
+     TOK_GLOBAL = 377,
+     TOK_INTERFACE = 378,
+     TOK_ENDINTERFACE = 379,
+     TOK_LEFTAB = 380,
+     TOK_RIGHTAB = 381,
+     TOK_PAUSE = 382,
+     TOK_PROCEDURE = 383,
+     TOK_STOP = 384,
+     TOK_NAMEEQ = 385,
+     TOK_REAL8 = 386,
+     TOK_OUT = 387,
+     TOK_INOUT = 388,
+     TOK_IN = 389,
+     TOK_USE = 390,
+     TOK_TRUE = 391,
+     TOK_FALSE = 392,
+     TOK_LABEL = 393,
+     TOK_TYPE = 394,
+     TOK_TYPEPAR = 395,
+     TOK_ENDTYPE = 396,
+     TOK_REAL = 397,
+     TOK_INTEGER = 398,
+     TOK_LOGICAL = 399,
+     TOK_DOUBLEPRECISION = 400,
+     TOK_DOUBLEREAL = 401,
+     TOK_ENDSUBROUTINE = 402,
+     TOK_ENDFUNCTION = 403,
+     TOK_ENDPROGRAM = 404,
+     TOK_ENDUNIT = 405,
+     TOK_CHARACTER = 406,
+     TOK_CHAR_CONSTANT = 407,
+     TOK_CHAR_CUT = 408,
+     TOK_DATA = 409,
+     TOK_CHAR_INT = 410,
+     TOK_CHAR_MESSAGE = 411,
+     TOK_CSTREAL = 412,
+     TOK_CSTREALDP = 413,
+     TOK_CSTREALQP = 414,
+     TOK_SFREAL = 415,
+     TOK_COMPLEX = 416,
+     TOK_DOUBLECOMPLEX = 417,
+     TOK_NAME = 418,
+     TOK_NAME_CHAR = 419,
+     TOK_PROBTYPE = 420,
+     TOK_INTERPTYPE = 421,
+     TOK_VARTYPE = 422,
+     TOK_BC = 423,
+     TOK_OP = 424,
+     TOK_CSTINT = 425,
+     TOK_COMMENT = 426,
+     TOK_FILENAME = 427
+   };
+#endif
+/* Tokens.  */
+#define TOK_BINARY_OP 258
+#define TOK_NEQV 259
+#define TOK_EQV 260
+#define TOK_XOR 261
+#define TOK_OR 262
+#define TOK_AND 263
+#define TOK_NOT 264
+#define TOK_NE 265
+#define TOK_EQ 266
+#define TOK_GE 267
+#define TOK_LE 268
+#define TOK_GT 269
+#define TOK_LT 270
+#define TOK_UNARY_OP 271
+#define TOK_DSLASH 272
+#define TOK_SLASH 273
+#define TOK_DASTER 274
+#define TOK_SEP 275
+#define TOK_SEMICOLON 276
+#define TOK_NEXTLINE 277
+#define TOK_PARAMETER 278
+#define TOK_RESULT 279
+#define TOK_ONLY 280
+#define TOK_INCLUDE 281
+#define TOK_SUBROUTINE 282
+#define TOK_PROGRAM 283
+#define TOK_FUNCTION 284
+#define TOK_OMP 285
+#define TOK_DOLLAR 286
+#define TOK_FORMAT 287
+#define TOK_MAX 288
+#define TOK_TANH 289
+#define TOK_WHERE 290
+#define TOK_ELSEWHERE 291
+#define TOK_ENDWHERE 292
+#define TOK_MAXVAL 293
+#define TOK_TRIM 294
+#define TOK_SUM 295
+#define TOK_SQRT 296
+#define TOK_CASE 297
+#define TOK_SELECTCASE 298
+#define TOK_FILE 299
+#define TOK_END 300
+#define TOK_ERR 301
+#define TOK_DONOTTREAT 302
+#define TOK_ENDDONOTTREAT 303
+#define TOK_EXIST 304
+#define TOK_MIN 305
+#define TOK_FLOAT 306
+#define TOK_EXP 307
+#define TOK_COS 308
+#define TOK_COSH 309
+#define TOK_ACOS 310
+#define TOK_NINT 311
+#define TOK_CYCLE 312
+#define TOK_SIN 313
+#define TOK_SINH 314
+#define TOK_ASIN 315
+#define TOK_EQUIVALENCE 316
+#define TOK_BACKSPACE 317
+#define TOK_LOG 318
+#define TOK_TAN 319
+#define TOK_ATAN 320
+#define TOK_RECURSIVE 321
+#define TOK_ABS 322
+#define TOK_MOD 323
+#define TOK_SIGN 324
+#define TOK_MINLOC 325
+#define TOK_MAXLOC 326
+#define TOK_EXIT 327
+#define TOK_MINVAL 328
+#define TOK_PUBLIC 329
+#define TOK_PRIVATE 330
+#define TOK_ALLOCATABLE 331
+#define TOK_RETURN 332
+#define TOK_THEN 333
+#define TOK_ELSEIF 334
+#define TOK_ELSE 335
+#define TOK_ENDIF 336
+#define TOK_PRINT 337
+#define TOK_PLAINGOTO 338
+#define TOK_CONSTRUCTID 339
+#define TOK_LOGICALIF 340
+#define TOK_PLAINDO 341
+#define TOK_CONTAINS 342
+#define TOK_ENDDO 343
+#define TOK_MODULE 344
+#define TOK_ENDMODULE 345
+#define TOK_DOWHILE 346
+#define TOK_ALLOCATE 347
+#define TOK_OPEN 348
+#define TOK_CLOSE 349
+#define TOK_INQUIRE 350
+#define TOK_WRITE 351
+#define TOK_READ 352
+#define TOK_REWIND 353
+#define TOK_DEALLOCATE 354
+#define TOK_NULLIFY 355
+#define TOK_FIN 356
+#define TOK_DEBUT 357
+#define TOK_DIMENSION 358
+#define TOK_ENDSELECT 359
+#define TOK_EXTERNAL 360
+#define TOK_INTENT 361
+#define TOK_INTRINSIC 362
+#define TOK_NAMELIST 363
+#define TOK_CASEDEFAULT 364
+#define TOK_OPTIONAL 365
+#define TOK_POINTER 366
+#define TOK_CONTINUE 367
+#define TOK_SAVE 368
+#define TOK_TARGET 369
+#define TOK_QUOTE 370
+#define TOK_IMPLICIT 371
+#define TOK_NONE 372
+#define TOK_CALL 373
+#define TOK_STAT 374
+#define TOK_POINT_TO 375
+#define TOK_COMMON 376
+#define TOK_GLOBAL 377
+#define TOK_INTERFACE 378
+#define TOK_ENDINTERFACE 379
+#define TOK_LEFTAB 380
+#define TOK_RIGHTAB 381
+#define TOK_PAUSE 382
+#define TOK_PROCEDURE 383
+#define TOK_STOP 384
+#define TOK_NAMEEQ 385
+#define TOK_REAL8 386
+#define TOK_OUT 387
+#define TOK_INOUT 388
+#define TOK_IN 389
+#define TOK_USE 390
+#define TOK_TRUE 391
+#define TOK_FALSE 392
+#define TOK_LABEL 393
+#define TOK_TYPE 394
+#define TOK_TYPEPAR 395
+#define TOK_ENDTYPE 396
+#define TOK_REAL 397
+#define TOK_INTEGER 398
+#define TOK_LOGICAL 399
+#define TOK_DOUBLEPRECISION 400
+#define TOK_DOUBLEREAL 401
+#define TOK_ENDSUBROUTINE 402
+#define TOK_ENDFUNCTION 403
+#define TOK_ENDPROGRAM 404
+#define TOK_ENDUNIT 405
+#define TOK_CHARACTER 406
+#define TOK_CHAR_CONSTANT 407
+#define TOK_CHAR_CUT 408
+#define TOK_DATA 409
+#define TOK_CHAR_INT 410
+#define TOK_CHAR_MESSAGE 411
+#define TOK_CSTREAL 412
+#define TOK_CSTREALDP 413
+#define TOK_CSTREALQP 414
+#define TOK_SFREAL 415
+#define TOK_COMPLEX 416
+#define TOK_DOUBLECOMPLEX 417
+#define TOK_NAME 418
+#define TOK_NAME_CHAR 419
+#define TOK_PROBTYPE 420
+#define TOK_INTERPTYPE 421
+#define TOK_VARTYPE 422
+#define TOK_BC 423
+#define TOK_OP 424
+#define TOK_CSTINT 425
+#define TOK_COMMENT 426
+#define TOK_FILENAME 427
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 36 "fortran.y"
+
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+extern int line_num_fortran;
+extern int line_num_fortran_common;
+char *tmp;
+char c_selectorname[LONG_C];
+char ligne[LONG_C];
+char truename[LONGNOM];
+char identcopy[LONG_C];
+int c_selectorgiven=0;
+int incom;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+listdim *parcoursdim;
+int removeline=0;
+listvar *test;
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+#line 59 "fortran.y"
+{
+       char      nac[LONG_C];
+       char      na[LONGNOM];
+       listdim  *d;
+       listvar  *l;
+       listnom  *ln;
+       listcouple  *lc;
+       listname *lnn;
+       typedim   dim1;
+       variable *v;
+       }
+/* Line 193 of yacc.c.  */
+#line 483 "fortran.tab.c"
+	YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations.  */
+
+
+/* Line 216 of yacc.c.  */
+#line 496 "fortran.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   6070
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  190
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  184
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  555
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  982
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   427
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     187,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,   183,     2,     2,     2,   189,     2,     2,
+     179,   180,    23,    21,     3,    22,     2,   188,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
+     185,     5,   186,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,   181,     2,   182,     2,   184,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
+       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
+      18,    19,    20,    24,    25,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
+      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
+      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
+      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
+      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
+     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
+     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
+     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
+     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
+     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
+     161,   162,   163,   164,   165,   166,   167,   168,   169,   170,
+     171,   172,   173,   174,   175,   176,   177,   178
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint16 yyprhs[] =
+{
+       0,     0,     3,     4,     7,    10,    13,    15,    19,    23,
+      25,    29,    32,    35,    39,    43,    46,    49,    52,    54,
+      56,    58,    60,    61,    62,    65,    66,    68,    69,    70,
+      72,    73,    78,    81,    88,    93,    96,    98,    99,   101,
+     103,   104,   107,   111,   112,   115,   119,   121,   125,   127,
+     129,   132,   137,   140,   143,   148,   151,   153,   155,   157,
+     159,   161,   163,   165,   167,   169,   171,   176,   180,   184,
+     187,   191,   192,   194,   196,   198,   200,   202,   204,   206,
+     208,   210,   212,   214,   216,   218,   220,   222,   224,   226,
+     228,   230,   232,   234,   236,   238,   240,   242,   244,   248,
+     252,   258,   260,   264,   268,   271,   276,   278,   282,   283,
+     286,   289,   293,   295,   297,   299,   304,   311,   316,   318,
+     322,   325,   329,   335,   339,   341,   342,   345,   347,   352,
+     356,   359,   363,   367,   371,   375,   376,   378,   381,   384,
+     388,   394,   398,   399,   402,   405,   407,   413,   419,   422,
+     426,   429,   433,   435,   439,   442,   446,   452,   454,   457,
+     459,   463,   466,   468,   472,   473,   475,   477,   481,   485,
+     488,   490,   494,   497,   500,   501,   508,   516,   517,   520,
+     523,   527,   531,   533,   534,   537,   542,   546,   550,   555,
+     558,   560,   562,   564,   566,   568,   570,   572,   574,   575,
+     578,   580,   584,   585,   588,   592,   594,   598,   601,   605,
+     607,   609,   611,   613,   614,   618,   619,   622,   627,   629,
+     633,   635,   637,   639,   642,   644,   649,   651,   653,   655,
+     657,   659,   661,   663,   665,   667,   669,   670,   674,   676,
+     680,   682,   684,   687,   690,   694,   696,   698,   700,   704,
+     706,   708,   712,   716,   721,   726,   730,   735,   740,   744,
+     749,   754,   759,   764,   769,   774,   779,   784,   789,   794,
+     799,   804,   809,   813,   818,   823,   828,   833,   835,   839,
+     841,   843,   845,   848,   851,   854,   856,   858,   861,   864,
+     867,   870,   873,   876,   879,   882,   885,   888,   891,   895,
+     898,   902,   905,   908,   911,   914,   917,   920,   923,   924,
+     926,   929,   932,   935,   937,   939,   941,   943,   944,   946,
+     949,   954,   960,   965,   969,   973,   975,   978,   980,   984,
+     986,   988,   992,   998,  1003,  1007,  1010,  1013,  1015,  1017,
+    1019,  1021,  1023,  1025,  1027,  1029,  1032,  1035,  1037,  1040,
+    1042,  1044,  1045,  1047,  1053,  1054,  1056,  1058,  1060,  1061,
+    1065,  1069,  1070,  1076,  1079,  1084,  1091,  1098,  1100,  1102,
+    1104,  1108,  1112,  1114,  1118,  1122,  1124,  1126,  1132,  1138,
+    1143,  1145,  1148,  1151,  1154,  1157,  1159,  1162,  1168,  1170,
+    1172,  1175,  1181,  1183,  1186,  1190,  1195,  1197,  1199,  1201,
+    1203,  1205,  1207,  1209,  1211,  1215,  1219,  1223,  1226,  1229,
+    1230,  1236,  1244,  1245,  1248,  1250,  1252,  1253,  1255,  1257,
+    1259,  1261,  1264,  1266,  1268,  1270,  1276,  1282,  1285,  1288,
+    1291,  1294,  1296,  1297,  1302,  1309,  1311,  1315,  1318,  1321,
+    1324,  1325,  1329,  1330,  1332,  1335,  1337,  1339,  1343,  1345,
+    1348,  1350,  1352,  1355,  1358,  1361,  1365,  1368,  1370,  1371,
+    1373,  1376,  1379,  1380,  1383,  1387,  1391,  1395,  1399,  1401,
+    1405,  1407,  1409,  1413,  1415,  1417,  1419,  1423,  1426,  1431,
+    1436,  1439,  1442,  1444,  1446,  1448,  1450,  1452,  1454,  1456,
+    1458,  1460,  1464,  1466,  1468,  1472,  1476,  1480,  1484,  1487,
+    1491,  1494,  1497,  1500,  1503,  1507,  1509,  1511,  1513,  1515,
+    1519,  1520,  1522,  1525,  1530,  1533,  1536,  1542,  1543,  1545,
+    1548,  1550,  1552,  1554,  1558,  1562,  1566,  1570,  1574,  1578,
+    1580,  1582,  1584,  1588,  1594,  1600,  1606,  1612,  1620,  1622,
+    1631,  1634,  1636,  1638,  1642,  1644,  1646,  1648,  1653,  1655,
+    1659,  1660,  1665,  1667,  1671,  1675
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int16 yyrhs[] =
+{
+     191,     0,    -1,    -1,   191,   192,    -1,   187,   198,    -1,
+     199,   193,    -1,   177,    -1,   197,   200,   205,    -1,     1,
+     205,   201,    -1,   194,    -1,   193,    27,   194,    -1,   203,
+     196,    -1,   212,   196,    -1,   206,   207,   196,    -1,   315,
+     200,   205,    -1,   195,   196,    -1,   298,     4,    -1,   198,
+     200,    -1,    53,    -1,    54,    -1,    36,    -1,    37,    -1,
+      -1,    -1,   144,   201,    -1,    -1,   177,    -1,    -1,    -1,
+      72,    -1,    -1,   202,    33,   204,   208,    -1,    34,   204,
+      -1,   202,    35,   204,   208,    30,   209,    -1,   202,    35,
+     204,   208,    -1,    95,   169,    -1,   169,    -1,    -1,    32,
+      -1,   158,    -1,    -1,   179,   180,    -1,   179,   210,   180,
+      -1,    -1,   179,   180,    -1,   179,   210,   180,    -1,   211,
+      -1,   210,     3,   211,    -1,   169,    -1,    23,    -1,   257,
+     222,    -1,   145,   213,   221,   324,    -1,   147,   324,    -1,
+     117,   216,    -1,   224,   179,   249,   180,    -1,   224,   249,
+      -1,   243,    -1,   228,    -1,   253,    -1,   239,    -1,   241,
+      -1,   240,    -1,   308,    -1,   251,    -1,   237,    -1,   234,
+      -1,    68,   179,   280,   180,    -1,   111,   221,   242,    -1,
+     113,   221,   215,    -1,    67,   217,    -1,   225,   226,   187,
+      -1,    -1,   275,    -1,    46,    -1,    40,    -1,    44,    -1,
+      56,    -1,    79,    -1,    45,    -1,    47,    -1,    62,    -1,
+      57,    -1,    58,    -1,    59,    -1,    60,    -1,    61,    -1,
+      64,    -1,    65,    -1,    66,    -1,    69,    -1,    70,    -1,
+      71,    -1,    74,    -1,    75,    -1,    76,    -1,    77,    -1,
+     169,    -1,   214,    -1,   215,     3,   214,    -1,   179,   220,
+     180,    -1,   216,     3,   179,   220,   180,    -1,   218,    -1,
+     217,     3,   218,    -1,   179,   219,   180,    -1,   298,   276,
+      -1,   219,     3,   298,   276,    -1,   280,    -1,   220,     3,
+     280,    -1,    -1,     4,     4,    -1,   255,   256,    -1,   223,
+     204,   208,    -1,    35,    -1,    29,    -1,   160,    -1,   169,
+      24,   227,    24,    -1,   226,   248,   169,    24,   227,    24,
+      -1,   231,    24,   227,    24,    -1,   232,    -1,   232,     3,
+     227,    -1,   229,   230,    -1,   229,   247,   230,    -1,   228,
+     248,   247,   248,   230,    -1,   228,     3,   230,    -1,   119,
+      -1,    -1,   169,   276,    -1,   169,    -1,   169,   179,   280,
+     180,    -1,   231,     3,   231,    -1,   233,   299,    -1,   232,
+      21,   232,    -1,   232,    22,   232,    -1,   232,    23,   232,
+      -1,   232,   188,   232,    -1,    -1,   284,    -1,   235,   236,
+      -1,   114,   298,    -1,   114,   247,   298,    -1,   235,   248,
+     247,   248,   298,    -1,   235,     3,   298,    -1,    -1,   129,
+     324,    -1,   130,   324,    -1,   109,    -1,   238,   248,   169,
+     276,   264,    -1,   239,     3,   169,   276,   264,    -1,    81,
+     187,    -1,    81,   221,   242,    -1,    80,   187,    -1,    80,
+     221,   242,    -1,   169,    -1,   242,     3,   169,    -1,   244,
+     245,    -1,   244,   247,   245,    -1,   243,   248,   247,   248,
+     245,    -1,   127,    -1,   128,   127,    -1,   246,    -1,   245,
+       3,   246,    -1,   169,   276,    -1,    20,    -1,    24,   169,
+      24,    -1,    -1,     3,    -1,   250,    -1,   249,     3,   250,
+      -1,   169,     5,   280,    -1,   134,   252,    -1,   169,    -1,
+     252,     3,   169,    -1,   122,   123,    -1,   122,   137,    -1,
+      -1,   271,   254,   169,   276,   264,   305,    -1,   255,     3,
+     254,   169,   276,   264,   305,    -1,    -1,   262,   266,    -1,
+     261,   259,    -1,   263,    23,   176,    -1,   258,   268,   180,
+      -1,   146,    -1,    -1,    23,   176,    -1,    23,   179,   260,
+     180,    -1,   179,   260,   180,    -1,   169,   269,   270,    -1,
+     169,     5,   269,   270,    -1,   269,   270,    -1,   157,    -1,
+     263,    -1,   149,    -1,   148,    -1,   167,    -1,   151,    -1,
+     168,    -1,   150,    -1,    -1,    23,   265,    -1,   280,    -1,
+     179,    23,   180,    -1,    -1,    23,   267,    -1,   179,   268,
+     180,    -1,   280,    -1,   179,    23,   180,    -1,   169,   269,
+      -1,   169,     5,   269,    -1,   169,    -1,   176,    -1,   280,
+      -1,    23,    -1,    -1,     3,   169,   269,    -1,    -1,     4,
+       4,    -1,     3,   272,     4,     4,    -1,   273,    -1,   272,
+       3,   273,    -1,    29,    -1,   275,    -1,    82,    -1,   109,
+     276,    -1,   111,    -1,   112,   179,   274,   180,    -1,   113,
+      -1,   116,    -1,   117,    -1,   119,    -1,   120,    -1,   140,
+      -1,   138,    -1,   139,    -1,    80,    -1,    81,    -1,    -1,
+     179,   277,   180,    -1,   278,    -1,   277,     3,   278,    -1,
+     279,    -1,     4,    -1,   280,     4,    -1,     4,   280,    -1,
+     280,     4,   279,    -1,    23,    -1,   280,    -1,   283,    -1,
+     179,   280,   180,    -1,   307,    -1,   281,    -1,    46,   282,
+     180,    -1,    39,   282,   180,    -1,    40,   179,   282,   180,
+      -1,    44,   179,   282,   180,    -1,    56,   282,   180,    -1,
+      79,   179,   282,   180,    -1,    45,   179,   280,   180,    -1,
+      47,   280,   180,    -1,   148,   179,   282,   180,    -1,    62,
+     179,   280,   180,    -1,    57,   179,   280,   180,    -1,    58,
+     179,   280,   180,    -1,    59,   179,   280,   180,    -1,    60,
+     179,   280,   180,    -1,    61,   179,   280,   180,    -1,    64,
+     179,   280,   180,    -1,    65,   179,   280,   180,    -1,    66,
+     179,   280,   180,    -1,    69,   179,   280,   180,    -1,    70,
+     179,   280,   180,    -1,    71,   179,   280,   180,    -1,    73,
+     280,   180,    -1,    74,   179,   282,   180,    -1,    75,   179,
+     282,   180,    -1,    76,   179,   282,   180,    -1,    77,   179,
+     282,   180,    -1,   280,    -1,   282,     3,   280,    -1,   288,
+      -1,   299,    -1,   293,    -1,   280,   285,    -1,   284,   280,
+      -1,    12,   280,    -1,    21,    -1,    22,    -1,    21,   280,
+      -1,    22,   280,    -1,    23,   280,    -1,    25,   280,    -1,
+      14,   280,    -1,     8,   280,    -1,    17,   280,    -1,   186,
+     280,    -1,    18,   280,    -1,   185,   280,    -1,    15,   280,
+      -1,   186,     5,   280,    -1,    16,   280,    -1,   185,     5,
+     280,    -1,    13,   280,    -1,     7,   280,    -1,     9,   280,
+      -1,    10,   280,    -1,    11,   280,    -1,    24,   286,    -1,
+       5,   287,    -1,    -1,   280,    -1,     5,   280,    -1,    24,
+     280,    -1,     5,   280,    -1,   280,    -1,   298,    -1,   292,
+      -1,   290,    -1,    -1,   291,    -1,   291,   302,    -1,   292,
+     179,   294,   180,    -1,   292,   179,   294,   180,   302,    -1,
+     298,   179,   294,   180,    -1,   288,   189,   288,    -1,   131,
+     360,   132,    -1,   289,    -1,   289,   295,    -1,   296,    -1,
+     295,     3,   296,    -1,   280,    -1,   297,    -1,   280,     4,
+     280,    -1,   280,     4,   280,     4,   280,    -1,     4,   280,
+       4,   280,    -1,     4,     4,   280,    -1,     4,   280,    -1,
+     280,     4,    -1,     4,    -1,   169,    -1,   142,    -1,   143,
+      -1,   176,    -1,   163,    -1,   164,    -1,   165,    -1,   299,
+     169,    -1,   300,   301,    -1,   158,    -1,   300,   158,    -1,
+     162,    -1,   159,    -1,    -1,   302,    -1,   179,   303,     4,
+     303,   180,    -1,    -1,   280,    -1,   187,    -1,   280,    -1,
+      -1,   306,     5,   280,    -1,   306,   126,   280,    -1,    -1,
+     179,   283,     3,   283,   180,    -1,   309,   310,    -1,   309,
+     310,     3,   311,    -1,   309,   310,     3,    31,     4,   187,
+      -1,   309,   310,     3,    31,     4,   313,    -1,   141,    -1,
+     169,    -1,   312,    -1,   311,     3,   312,    -1,   169,   126,
+     169,    -1,   314,    -1,   313,     3,   314,    -1,   169,   126,
+     169,    -1,   169,    -1,   328,    -1,    98,   179,   366,   370,
+     180,    -1,   105,   179,   369,   370,   180,    -1,   106,   179,
+     371,   180,    -1,   317,    -1,   318,   324,    -1,   316,   324,
+      -1,   319,   324,    -1,    96,   324,    -1,   321,    -1,   372,
+     328,    -1,    41,   179,   280,   180,   304,    -1,    42,    -1,
+      43,    -1,   372,    84,    -1,    85,   179,   280,   180,    84,
+      -1,    86,    -1,    87,   324,    -1,    48,   320,   180,    -1,
+      49,   179,   280,   180,    -1,   115,    -1,   110,    -1,    93,
+      -1,   153,    -1,   156,    -1,   155,    -1,   154,    -1,   280,
+      -1,   320,     3,   280,    -1,   320,     4,   280,    -1,   326,
+     323,   322,    -1,   327,   280,    -1,    94,   325,    -1,    -1,
+     373,     5,   280,     3,   280,    -1,   373,     5,   280,     3,
+     280,     3,   280,    -1,    -1,   176,   248,    -1,   187,    -1,
+     169,    -1,    -1,   169,    -1,    92,    -1,    97,    -1,   118,
+      -1,   330,   332,    -1,   365,    -1,   341,    -1,   333,    -1,
+      98,   179,   366,   370,   180,    -1,   105,   179,   369,   370,
+     180,    -1,    78,   303,    -1,    83,   304,    -1,    63,   304,
+      -1,   340,   304,    -1,   331,    -1,    -1,   298,   329,   276,
+     276,    -1,   330,   189,   298,   329,   276,   276,    -1,   176,
+      -1,   331,     3,   176,    -1,     5,   280,    -1,   126,   280,
+      -1,   336,   334,    -1,    -1,   179,   335,   180,    -1,    -1,
+     338,    -1,   337,   169,    -1,   124,    -1,   339,    -1,   338,
+       3,   339,    -1,   280,    -1,    23,   364,    -1,   133,    -1,
+     135,    -1,   349,   345,    -1,   351,   343,    -1,   352,   345,
+      -1,   352,   345,   360,    -1,   104,   346,    -1,    38,    -1,
+      -1,   356,    -1,   345,   342,    -1,   350,   344,    -1,    -1,
+       3,   356,    -1,   179,   347,   180,    -1,   179,   353,   180,
+      -1,   179,   298,   180,    -1,   179,   176,   180,    -1,   176,
+      -1,   179,   283,   180,    -1,   169,    -1,   348,    -1,   347,
+       3,   348,    -1,   353,    -1,    23,    -1,    25,    -1,   298,
+     280,   276,    -1,   298,   280,    -1,   298,   280,   189,   330,
+      -1,   298,   179,   297,   180,    -1,   298,    23,    -1,   298,
+      25,    -1,    99,    -1,   100,    -1,   354,    -1,    23,    -1,
+     103,    -1,   101,    -1,    88,    -1,   102,    -1,   354,    -1,
+     179,   353,   180,    -1,   288,    -1,   299,    -1,   353,   355,
+     353,    -1,   353,    23,   353,    -1,   353,    24,   353,    -1,
+     353,    25,   353,    -1,   355,   353,    -1,   353,    20,   353,
+      -1,    50,   280,    -1,    55,   280,    -1,    52,   280,    -1,
+      51,   280,    -1,   169,     5,   280,    -1,   281,    -1,    21,
+      -1,    22,    -1,   358,    -1,   356,     3,   358,    -1,    -1,
+     288,    -1,   357,   359,    -1,   179,   356,   180,   359,    -1,
+     281,   359,    -1,   299,   359,    -1,   179,   356,     3,   363,
+     180,    -1,    -1,   285,    -1,   359,   285,    -1,   283,    -1,
+     362,    -1,   361,    -1,   283,     3,   280,    -1,   283,     3,
+     362,    -1,   362,     3,   280,    -1,   362,     3,   362,    -1,
+     361,     3,   280,    -1,   361,     3,   362,    -1,   283,    -1,
+     281,    -1,   307,    -1,   179,   280,   180,    -1,   179,   283,
+       3,   363,   180,    -1,   179,   362,     3,   363,   180,    -1,
+     179,   361,     3,   363,   180,    -1,   169,     5,   280,     3,
+     280,    -1,   169,     5,   280,     3,   280,     3,   280,    -1,
+     176,    -1,    89,   179,   280,     3,   280,   180,     3,   280,
+      -1,    89,   364,    -1,   367,    -1,   330,    -1,   366,     3,
+     367,    -1,   298,    -1,   292,    -1,   368,    -1,   298,   179,
+     295,   180,    -1,   367,    -1,   369,     3,   367,    -1,    -1,
+       3,   125,     5,   298,    -1,   298,    -1,   371,     3,   298,
+      -1,    91,   280,   180,    -1,   298,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   336,   336,   337,   339,   340,   341,   342,   343,   346,
+     347,   349,   350,   351,   360,   361,   363,   365,   367,   374,
+     379,   380,   382,   384,   385,   387,   388,   394,   397,   398,
+     401,   402,   430,   448,   481,   515,   532,   539,   541,   545,
+     550,   553,   556,   561,   562,   563,   571,   582,   594,   595,
+     597,   605,   613,   619,   620,   635,   648,   649,   655,   656,
+     693,   706,   707,   708,   709,   710,   711,   712,   713,   714,
+     715,   734,   735,   741,   742,   743,   744,   745,   746,   747,
+     748,   749,   750,   751,   752,   753,   754,   755,   756,   757,
+     758,   759,   760,   761,   762,   763,   764,   766,   767,   769,
+     770,   772,   773,   775,   777,   778,   780,   781,   783,   784,
+     786,   870,   907,   913,   918,   923,   937,   951,   966,   973,
+     982,   983,   984,   985,   987,   992,   993,   998,  1002,  1007,
+    1012,  1014,  1016,  1018,  1020,  1024,  1025,  1028,  1030,  1031,
+    1032,  1033,  1035,  1037,  1042,  1047,  1053,  1069,  1086,  1087,
+    1089,  1093,  1098,  1102,  1107,  1113,  1124,  1136,  1141,  1147,
+    1152,  1156,  1166,  1175,  1185,  1186,  1188,  1192,  1197,  1220,
+    1222,  1223,  1225,  1235,  1237,  1239,  1272,  1307,  1309,  1311,
+    1315,  1320,  1326,  1334,  1335,  1337,  1338,  1340,  1341,  1342,
+    1344,  1349,  1351,  1356,  1360,  1363,  1369,  1371,  1377,  1378,
+    1380,  1381,  1383,  1384,  1385,  1387,  1388,  1390,  1391,  1400,
+    1404,  1409,  1411,  1414,  1415,  1417,  1418,  1419,  1421,  1422,
+    1424,  1428,  1429,  1431,  1436,  1438,  1440,  1441,  1442,  1443,
+    1449,  1452,  1453,  1454,  1456,  1458,  1461,  1466,  1470,  1472,
+    1476,  1481,  1485,  1490,  1495,  1503,  1504,  1506,  1507,  1509,
+    1511,  1515,  1517,  1519,  1521,  1523,  1525,  1527,  1529,  1531,
+    1533,  1535,  1537,  1539,  1541,  1543,  1545,  1547,  1549,  1551,
+    1553,  1555,  1557,  1559,  1561,  1563,  1565,  1568,  1569,  1573,
+    1574,  1576,  1578,  1580,  1582,  1585,  1586,  1588,  1590,  1592,
+    1594,  1596,  1598,  1600,  1602,  1604,  1606,  1608,  1610,  1612,
+    1614,  1616,  1618,  1620,  1622,  1624,  1626,  1628,  1631,  1632,
+    1634,  1636,  1639,  1641,  1645,  1650,  1655,  1661,  1673,  1678,
+    1680,  1683,  1687,  1697,  1703,  1706,  1707,  1710,  1711,  1714,
+    1715,  1717,  1719,  1722,  1724,  1725,  1726,  1727,  1729,  1787,
+    1789,  1790,  1791,  1792,  1793,  1794,  1796,  1798,  1800,  1801,
+    1803,  1806,  1807,  1809,  1812,  1813,  1815,  1816,  1818,  1819,
+    1827,  1836,  1838,  1841,  1861,  1895,  1915,  1966,  1974,  1977,
+    1981,  1991,  2002,  2006,  2016,  2028,  2037,  2038,  2044,  2050,
+    2051,  2101,  2119,  2139,  2158,  2203,  2204,  2205,  2206,  2207,
+    2208,  2209,  2210,  2211,  2212,  2213,  2214,  2215,  2216,  2260,
+    2270,  2279,  2288,  2297,  2298,  2299,  2301,  2302,  2303,  2305,
+    2306,  2307,  2308,  2309,  2311,  2312,  2314,  2315,  2317,  2319,
+    2326,  2327,  2328,  2329,  2330,  2331,  2337,  2343,  2344,  2345,
+    2346,  2347,  2349,  2350,  2360,  2362,  2363,  2365,  2366,  2368,
+    2396,  2397,  2399,  2400,  2402,  2432,  2434,  2435,  2438,  2452,
+    2455,  2456,  2459,  2460,  2461,  2462,  2463,  2464,  2476,  2477,
+    2479,  2480,  2485,  2486,  2488,  2489,  2491,  2492,  2493,  2494,
+    2495,  2497,  2498,  2500,  2501,  2502,  2503,  2504,  2505,  2506,
+    2507,  2508,  2510,  2511,  2513,  2514,  2517,  2518,  2519,  2522,
+    2525,  2526,  2528,  2529,  2530,  2531,  2532,  2533,  2534,  2535,
+    2536,  2537,  2538,  2539,  2540,  2541,  2543,  2544,  2546,  2547,
+    2549,  2550,  2552,  2553,  2554,  2555,  2556,  2558,  2559,  2560,
+    2562,  2563,  2564,  2566,  2568,  2570,  2572,  2574,  2576,  2578,
+    2579,  2581,  2583,  2585,  2587,  2589,  2593,  2596,  2603,  2605,
+    2606,  2608,  2609,  2610,  2612,  2614,  2615,  2617,  2624,  2625,
+    2627,  2628,  2630,  2631,  2639,  2641
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_BINARY_OP",
+  "TOK_NEQV", "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT",
+  "TOK_NE", "TOK_EQ", "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT",
+  "TOK_UNARY_OP", "TOK_DSLASH", "'+'", "'-'", "'*'", "TOK_SLASH",
+  "TOK_DASTER", "TOK_SEP", "TOK_SEMICOLON", "TOK_NEXTLINE",
+  "TOK_PARAMETER", "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE",
+  "TOK_SUBROUTINE", "TOK_PROGRAM", "TOK_FUNCTION", "TOK_OMP", "TOK_DOLLAR",
+  "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE", "TOK_ELSEWHERE",
+  "TOK_ENDWHERE", "TOK_MAXVAL", "TOK_TRIM", "TOK_SUM", "TOK_SQRT",
+  "TOK_CASE", "TOK_SELECTCASE", "TOK_FILE", "TOK_END", "TOK_ERR",
+  "TOK_DONOTTREAT", "TOK_ENDDONOTTREAT", "TOK_EXIST", "TOK_MIN",
+  "TOK_FLOAT", "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT",
+  "TOK_CYCLE", "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE",
+  "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE",
+  "TOK_ABS", "TOK_MOD", "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT",
+  "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE",
+  "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF",
+  "TOK_PRINT", "TOK_PLAINGOTO", "TOK_CONSTRUCTID", "TOK_LOGICALIF",
+  "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", "TOK_MODULE",
+  "TOK_ENDMODULE", "TOK_DOWHILE", "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE",
+  "TOK_INQUIRE", "TOK_WRITE", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE",
+  "TOK_NULLIFY", "TOK_FIN", "TOK_DEBUT", "TOK_DIMENSION", "TOK_ENDSELECT",
+  "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST",
+  "TOK_CASEDEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE",
+  "TOK_SAVE", "TOK_TARGET", "TOK_QUOTE", "TOK_IMPLICIT", "TOK_NONE",
+  "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL",
+  "TOK_INTERFACE", "TOK_ENDINTERFACE", "TOK_LEFTAB", "TOK_RIGHTAB",
+  "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_NAMEEQ", "TOK_REAL8",
+  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
+  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_DOUBLEREAL",
+  "TOK_ENDSUBROUTINE", "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT",
+  "TOK_CHARACTER", "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA",
+  "TOK_CHAR_INT", "TOK_CHAR_MESSAGE", "TOK_CSTREAL", "TOK_CSTREALDP",
+  "TOK_CSTREALQP", "TOK_SFREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX",
+  "TOK_NAME", "TOK_NAME_CHAR", "TOK_PROBTYPE", "TOK_INTERPTYPE",
+  "TOK_VARTYPE", "TOK_BC", "TOK_OP", "TOK_CSTINT", "TOK_COMMENT",
+  "TOK_FILENAME", "'('", "')'", "'['", "']'", "'!'", "'_'", "'<'", "'>'",
+  "'\\n'", "'/'", "'%'", "$accept", "input", "line", "suite_line_list",
+  "suite_line", "instr", "fin_line", "keyword", "position", "thislabel",
+  "cmnt", "nulcurbuf", "opt_recursive", "entry", "name_routine",
+  "writedeclar", "before_include", "filename", "arglist", "arglist1",
+  "args", "arg", "spec", "opt_spec", "name_intrinsic",
+  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
+  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
+  "before_function", "before_parameter", "before_data", "data",
+  "datavallist", "save", "before_save", "varsave", "datanamelist",
+  "expr_data", "opt_signe", "namelist", "namelist_action",
+  "after_namelist", "interface", "before_dimension", "dimension",
+  "private", "public", "use_name_list", "common", "before_common",
+  "var_common_list", "var_common", "comblock", "opt_comma", "paramlist",
+  "paramitem", "module_proc_stmt", "proc_name_list", "implicit",
+  "opt_retour", "dcl", "nodimsgiven", "type", "before_typepar",
+  "c_selector", "c_attribute", "before_character", "typespec", "typename",
+  "lengspec", "proper_lengspec", "selector", "proper_selector",
+  "attribute", "clause", "opt_clause", "options", "attr_spec_list",
+  "attr_spec", "intent_spec", "access_spec", "dims", "dimlist", "dim",
+  "ubound", "expr", "predefinedfunction", "minmaxlist", "uexpr", "signe",
+  "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "array_ele_substring_func_ref", "begin_array", "structure_component",
+  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
+  "simple_const", "string_constant", "opt_substring", "substring",
+  "optexpr", "opt_expr", "initial_value", "before_initial",
+  "complex_const", "use_stat", "word_use", "module_name", "rename_list",
+  "rename_name", "only_list", "only_name", "exec", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "caselist",
+  "boucledo", "do_arg", "opt_int", "opt_name", "optname", "worddo",
+  "wordwhile", "iffable", "before_dims", "ident_dims", "int_list",
+  "after_ident_dims", "call", "opt_call", "opt_callarglist", "keywordcall",
+  "before_call", "callarglist", "callarg", "stop", "io", "option_inlist",
+  "option_read", "opt_inlist", "ioctl", "after_rewind", "ctllist",
+  "ioclause", "iofctl", "infmt", "read", "write", "fexpr", "unpar_fexpr",
+  "addop", "inlist", "opt_lhs", "inelt", "opt_operation", "outlist",
+  "out2", "other", "dospec", "label", "goto", "allocation_list",
+  "allocate_object", "array_element", "allocate_object_list",
+  "opt_stat_spec", "pointer_name_list", "logif", "do_var", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,   271,
+     272,    43,    45,    42,   273,   274,   275,   276,   277,   278,
+     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
+     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
+     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
+     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
+     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
+     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
+     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
+     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
+     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
+     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
+     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
+     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
+     409,   410,   411,   412,   413,   414,   415,   416,   417,   418,
+     419,   420,   421,   422,   423,   424,   425,   426,   427,    40,
+      41,    91,    93,    33,    95,    60,    62,    10,    47,    37
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint16 yyr1[] =
+{
+       0,   190,   191,   191,   192,   192,   192,   192,   192,   193,
+     193,   194,   194,   194,   194,   194,   195,   196,   197,   197,
+     197,   197,   198,   199,   199,   200,   200,   201,   202,   202,
+     203,   203,   203,   203,   203,   203,   204,   205,   206,   207,
+     208,   208,   208,   209,   209,   209,   210,   210,   211,   211,
+     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
+     212,   212,   212,   212,   212,   212,   212,   212,   212,   212,
+     212,   213,   213,   214,   214,   214,   214,   214,   214,   214,
+     214,   214,   214,   214,   214,   214,   214,   214,   214,   214,
+     214,   214,   214,   214,   214,   214,   214,   215,   215,   216,
+     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
+     222,   222,   223,   224,   225,   226,   226,   226,   227,   227,
+     228,   228,   228,   228,   229,   230,   230,   231,   231,   231,
+     232,   232,   232,   232,   232,   233,   233,   234,   235,   235,
+     235,   235,   236,   237,   237,   238,   239,   239,   240,   240,
+     241,   241,   242,   242,   243,   243,   243,   244,   244,   245,
+     245,   246,   247,   247,   248,   248,   249,   249,   250,   251,
+     252,   252,   253,   253,   254,   255,   255,   256,   257,   257,
+     257,   257,   258,   259,   259,   259,   259,   260,   260,   260,
+     261,   262,   263,   263,   263,   263,   263,   263,   264,   264,
+     265,   265,   266,   266,   266,   267,   267,   268,   268,   268,
+     268,   269,   269,   270,   270,   271,   271,   271,   272,   272,
+     273,   273,   273,   273,   273,   273,   273,   273,   273,   273,
+     273,   274,   274,   274,   275,   275,   276,   276,   277,   277,
+     278,   278,   278,   278,   278,   279,   279,   280,   280,   280,
+     280,   281,   281,   281,   281,   281,   281,   281,   281,   281,
+     281,   281,   281,   281,   281,   281,   281,   281,   281,   281,
+     281,   281,   281,   281,   281,   281,   281,   282,   282,   283,
+     283,   283,   283,   283,   283,   284,   284,   285,   285,   285,
+     285,   285,   285,   285,   285,   285,   285,   285,   285,   285,
+     285,   285,   285,   285,   285,   285,   285,   285,   286,   286,
+     286,   286,   287,   287,   288,   288,   288,   289,   290,   290,
+     290,   290,   291,   292,   293,   294,   294,   295,   295,   296,
+     296,   297,   297,   297,   297,   297,   297,   297,   298,   299,
+     299,   299,   299,   299,   299,   299,   299,   300,   300,   300,
+     300,   301,   301,   302,   303,   303,   304,   304,   305,   305,
+     305,   306,   307,   308,   308,   308,   308,   309,   310,   311,
+     311,   312,   313,   313,   314,   314,   315,   315,   315,   315,
+     315,   315,   315,   315,   315,   315,   315,   315,   315,   315,
+     315,   315,   315,   315,   315,   315,   315,   315,   315,   316,
+     317,   318,   319,   320,   320,   320,   321,   321,   321,   322,
+     322,   322,   323,   323,   324,   324,   325,   325,   326,   327,
+     328,   328,   328,   328,   328,   328,   328,   328,   328,   328,
+     328,   328,   329,   330,   330,   331,   331,   332,   332,   333,
+     334,   334,   335,   335,   336,   337,   338,   338,   339,   339,
+     340,   340,   341,   341,   341,   341,   341,   341,   342,   342,
+     343,   343,   344,   344,   345,   345,   346,   346,   346,   346,
+     346,   347,   347,   348,   348,   348,   348,   348,   348,   348,
+     348,   348,   349,   349,   350,   350,   351,   351,   351,   352,
+     353,   353,   354,   354,   354,   354,   354,   354,   354,   354,
+     354,   354,   354,   354,   354,   354,   355,   355,   356,   356,
+     357,   357,   358,   358,   358,   358,   358,   359,   359,   359,
+     360,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   362,   362,   362,   362,   362,   363,   363,   364,   365,
+     365,   366,   366,   366,   367,   367,   367,   368,   369,   369,
+     370,   370,   371,   371,   372,   373
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     2,     2,     1,     3,     3,     1,
+       3,     2,     2,     3,     3,     2,     2,     2,     1,     1,
+       1,     1,     0,     0,     2,     0,     1,     0,     0,     1,
+       0,     4,     2,     6,     4,     2,     1,     0,     1,     1,
+       0,     2,     3,     0,     2,     3,     1,     3,     1,     1,
+       2,     4,     2,     2,     4,     2,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     4,     3,     3,     2,
+       3,     0,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     3,     3,
+       5,     1,     3,     3,     2,     4,     1,     3,     0,     2,
+       2,     3,     1,     1,     1,     4,     6,     4,     1,     3,
+       2,     3,     5,     3,     1,     0,     2,     1,     4,     3,
+       2,     3,     3,     3,     3,     0,     1,     2,     2,     3,
+       5,     3,     0,     2,     2,     1,     5,     5,     2,     3,
+       2,     3,     1,     3,     2,     3,     5,     1,     2,     1,
+       3,     2,     1,     3,     0,     1,     1,     3,     3,     2,
+       1,     3,     2,     2,     0,     6,     7,     0,     2,     2,
+       3,     3,     1,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     1,     0,     2,
+       1,     3,     0,     2,     3,     1,     3,     2,     3,     1,
+       1,     1,     1,     0,     3,     0,     2,     4,     1,     3,
+       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
+       1,     1,     2,     2,     3,     1,     1,     1,     3,     1,
+       1,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
+       4,     4,     3,     4,     4,     4,     4,     1,     3,     1,
+       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
+       4,     5,     4,     3,     3,     1,     2,     1,     3,     1,
+       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
+       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     3,
+       3,     0,     5,     2,     4,     6,     6,     1,     1,     1,
+       3,     3,     1,     3,     3,     1,     1,     5,     5,     4,
+       1,     2,     2,     2,     2,     1,     2,     5,     1,     1,
+       2,     5,     1,     2,     3,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     3,     3,     3,     2,     2,     0,
+       5,     7,     0,     2,     1,     1,     0,     1,     1,     1,
+       1,     2,     1,     1,     1,     5,     5,     2,     2,     2,
+       2,     1,     0,     4,     6,     1,     3,     2,     2,     2,
+       0,     3,     0,     1,     2,     1,     1,     3,     1,     2,
+       1,     1,     2,     2,     2,     3,     2,     1,     0,     1,
+       2,     2,     0,     2,     3,     3,     3,     3,     1,     3,
+       1,     1,     3,     1,     1,     1,     3,     2,     4,     4,
+       2,     2,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     3,     1,     1,     3,     3,     3,     3,     2,     3,
+       2,     2,     2,     2,     3,     1,     1,     1,     1,     3,
+       0,     1,     2,     4,     2,     2,     5,     0,     1,     2,
+       1,     1,     1,     3,     3,     3,     3,     3,     3,     1,
+       1,     1,     3,     5,     5,     5,     5,     7,     1,     8,
+       2,     1,     1,     3,     1,     1,     1,     4,     1,     3,
+       0,     4,     1,     3,     3,     1
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint16 yydefact[] =
+{
+       2,     0,     1,    37,    20,    21,    18,    19,    27,     6,
+      22,     3,    25,    30,    27,    24,     4,    26,    37,   113,
+      38,     0,   457,     0,   388,   389,     0,     0,     0,     0,
+       0,    29,   354,   108,   108,     0,     0,   392,     0,   488,
+       0,     0,   418,   398,   416,     0,     0,   419,     0,   482,
+     483,   487,   489,   486,     0,     0,     0,   145,   397,   108,
+     108,     0,   396,     0,   420,   124,     0,   445,   157,     0,
+       0,     0,   450,     0,   451,   367,    71,   182,     0,   193,
+     192,   197,   195,   399,   402,   401,   400,   190,   114,   194,
+     196,   338,   435,     5,     9,    22,     0,    22,     0,    22,
+       0,     0,    57,   125,    65,   142,    64,   164,    59,    61,
+      60,    56,     0,    63,    58,   215,     0,   183,   202,   191,
+     432,    62,     0,    25,     0,   380,     0,     0,   385,   412,
+       0,   376,     0,   431,   424,   440,     0,     0,   423,     0,
+       0,     0,   422,     0,     8,     7,    36,    32,     0,     0,
+     285,   286,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   339,   340,
+       0,   347,   350,   349,   342,   343,   344,   341,     0,   403,
+     250,   247,     0,   279,   316,   318,   315,   281,   314,   280,
+     351,   249,     0,     0,   356,   357,   429,     0,    69,   101,
+       0,   355,   427,     0,   150,     0,   148,     0,   428,     0,
+     415,   414,   393,   538,     0,   540,     0,   417,   408,    35,
+     384,     0,   470,   468,     0,   456,     0,     0,     0,     0,
+     162,     0,     0,   138,     0,    53,   172,   173,   158,   143,
+     144,   170,   169,   234,   235,   108,    72,    52,    30,    15,
+      25,     0,     0,    11,    39,    22,    12,     0,     0,    55,
+     166,   127,   164,     0,   125,     0,   236,   120,   125,   165,
+     137,     0,   165,     0,     0,     0,   236,   154,   159,     0,
+       0,     0,   112,    50,     0,   177,   174,   209,   210,     0,
+       0,     0,   179,     0,     0,   178,     0,    16,   236,   368,
+     363,    37,   382,   381,   383,   164,   409,   407,     0,     0,
+       0,   421,     0,   442,   439,   444,   430,     0,   452,   506,
+     507,   485,     0,     0,     0,     0,   338,     0,   505,   492,
+     493,   453,   458,   462,     0,   484,     0,   454,   390,     0,
+       0,   432,   386,     0,   284,   277,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   530,   520,   249,     0,   522,   521,     0,
+       0,   247,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   308,     0,     0,
+       0,   282,   283,     0,   354,   319,   317,   317,   345,   348,
+     346,   352,     0,     0,   394,     0,     0,   236,     0,     0,
+     109,   152,   151,   149,     0,     0,   554,     0,   545,   432,
+     542,   550,   541,   546,   341,   247,   314,   544,   548,   550,
+     552,     0,    67,    74,    75,    78,    73,    79,    76,    81,
+      82,    83,    84,    85,    80,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    77,    96,    97,    68,     0,
+     139,     0,   106,     0,     0,     0,    10,    17,    40,    40,
+      13,     0,     0,     0,   135,     0,    70,     0,     0,   135,
+     123,   164,     0,   126,   121,   141,   164,   236,   236,   164,
+     161,     0,   155,   220,   222,   236,   224,     0,   226,   227,
+     228,   229,   230,     0,   218,   221,   216,    40,   174,   110,
+       0,     0,   212,   207,   211,   181,   184,     0,   338,     0,
+     213,     0,   203,   205,     0,   180,   236,     0,    14,   413,
+     555,   406,     0,   437,   438,   432,   436,     0,   448,     0,
+     443,   446,   474,   475,     0,   314,     0,   471,   473,   490,
+     500,   503,   502,   501,     0,   473,   510,   517,   511,   517,
+     460,   459,   517,   508,   510,   461,     0,     0,     0,     0,
+       0,   498,   455,     0,     0,     0,     0,   252,     0,     0,
+       0,   251,   258,   255,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   272,     0,     0,     0,
+       0,     0,     0,   247,     0,     0,     0,   324,     0,     0,
+       0,   248,     0,     0,   313,   307,   302,   292,   303,   304,
+     305,   301,   291,   297,   299,   293,   295,   287,   288,   289,
+       0,     0,   309,   306,   290,     0,   296,     0,   294,   323,
+       0,   325,     0,     0,   404,   405,   395,     0,   103,   104,
+     102,    66,     0,     0,     0,   317,     0,     0,   467,   469,
+     466,     0,     0,     0,   379,     0,   163,     0,    99,     0,
+     171,    51,     0,    31,    34,   168,    54,   167,     0,   118,
+       0,   136,     0,     0,   127,   129,     0,   125,   241,   245,
+       0,   238,   240,   246,     0,   198,   198,     0,   160,   223,
+       0,     0,     0,   111,     0,   236,   208,     0,     0,   213,
+     186,     0,   189,     0,   204,   433,     0,     0,   364,   369,
+       0,   236,   449,   441,     0,     0,   480,   481,   317,   236,
+       0,   464,   465,   504,   465,     0,   518,   514,   515,   510,
+     512,   463,   499,   495,   496,   497,   494,   550,   550,   387,
+     278,   253,   254,   257,   261,   262,   263,   264,   265,   260,
+     266,   267,   268,   269,   270,   271,   273,   274,   275,   276,
+     256,   248,     0,     0,     0,   523,   524,   527,   528,   525,
+     526,   259,   247,   312,   310,   311,   300,   298,   354,   337,
+     329,   326,   327,   330,   320,   322,   236,   153,   391,     0,
+       0,     0,   543,   377,   549,   378,   553,    98,   107,     0,
+      49,    48,    41,     0,    46,    43,   115,   135,   135,   135,
+     135,   135,   130,   128,   135,   117,   122,   243,     0,   237,
+     242,   140,     0,   146,   147,   156,   232,   233,   231,     0,
+     219,   217,   236,   198,   185,   213,   187,     0,   206,     0,
+       0,     0,     0,   236,   447,   491,     0,     0,     0,   476,
+     472,   473,   510,   517,   519,   509,     0,     0,   338,     0,
+       0,     0,   362,     0,     0,   335,   336,     0,   321,   105,
+       0,   547,     0,   100,     0,    42,     0,    33,   119,   131,
+     132,   133,   134,     0,   239,   244,   246,     0,   199,   200,
+     225,   198,   358,   188,   214,   375,   365,   366,   372,   371,
+     370,     0,   434,   479,   478,     0,   513,   425,   426,     0,
+     533,   535,   534,   353,   334,     0,   331,   328,     0,   551,
+      47,    44,     0,   116,     0,   358,   175,     0,     0,     0,
+     410,   516,     0,   333,     0,   539,    45,   201,   176,     0,
+       0,   374,   373,     0,     0,   332,   359,   360,   411,   536,
+       0,   537
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int16 yydefgoto[] =
+{
+      -1,     1,    11,    93,    94,    95,   259,    12,   260,    13,
+      18,    15,    96,    97,   147,    14,    98,   265,   693,   907,
+     833,   834,    99,   255,   477,   478,   245,   208,   209,   426,
+     481,   215,   293,   294,   100,   101,   272,   698,   102,   103,
+     277,   273,   699,   700,   104,   105,   280,   106,   107,   108,
+     109,   110,   432,   111,   112,   287,   288,   242,   275,   269,
+     270,   113,   252,   114,   530,   295,   529,   115,   116,   302,
+     539,   117,   118,   119,   853,   918,   305,   542,   299,   540,
+     732,   296,   523,   524,   859,   525,   503,   710,   711,   712,
+     355,   190,   356,   191,   192,   411,   653,   635,   193,   661,
+     194,   195,   196,   197,   663,   811,   812,   813,   198,   199,
+     200,   420,   415,   212,   206,   956,   957,   201,   121,   122,
+     310,   738,   739,   927,   928,   123,   124,   125,   126,   127,
+     202,   128,   551,   316,   222,   228,   129,   130,   131,   308,
+     132,   133,   321,   134,   324,   559,   135,   136,   560,   561,
+     137,   138,   580,   341,   585,   328,   235,   566,   567,   139,
+     343,   140,   141,   344,   569,   346,   581,   582,   583,   757,
+     386,   387,   388,   889,   225,   142,   441,   442,   443,   449,
+     677,   451,   143,   552
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -711
+static const yytype_int16 yypact[] =
+{
+    -711,   923,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,   -98,  5724,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,   -51,  -711,   -47,  -711,  -711,  4731,    54,  2666,    70,
+     115,  -711,  4731,    34,    40,  2666,   117,  -711,   -63,  -711,
+       7,  4731,  -711,  -711,   -39,    66,   -63,  -711,   137,  -711,
+    -711,  -711,  -711,  -711,   184,   141,   170,  -711,  -711,   199,
+     199,   155,  -711,   175,  -711,  -711,    37,  -711,  -711,    92,
+     -63,   -63,  -711,   129,  -711,  -711,   116,  -711,   -63,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,   217,  -711,  -711,    31,  -711,    96,  -711,
+     -64,   187,    97,   156,  -711,   149,  -711,   384,   390,  -711,
+    -711,   395,   165,  -711,  -711,    91,   -15,    80,   125,   372,
+     416,  -711,   253,   -98,   -63,  -711,   -63,   -63,  -711,   247,
+    4731,  -711,    24,   434,  -711,   267,   278,  2666,  -711,   270,
+    5575,   270,  -711,  2341,  -711,  -711,  -711,  -711,  4731,  4731,
+    -711,  -711,  4731,   276,   279,   280,  4731,  4731,  4731,   285,
+     291,   292,   296,   299,   301,   309,   310,   313,   316,   317,
+     318,  4731,   319,   325,   328,   329,   330,  4859,  -711,  -711,
+     331,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  4731,  2530,
+    -711,  -711,  4731,   304,  -711,   334,   342,  -711,   343,   354,
+     -33,  -711,    43,  4731,  -711,  2530,  -711,   356,   528,  -711,
+    4731,  2530,  -711,   534,  -711,   376,  -711,   376,  -711,  4731,
+    -711,  -711,  -711,  -711,  4731,  -711,  1494,  -711,  -711,  -711,
+    -711,   356,  -711,  -711,  4987,  -711,   356,   356,   376,  2588,
+    -711,   377,   356,  -711,  4731,   544,  -711,  -711,  -711,  -711,
+    -711,  -711,   546,  -711,  -711,   199,  -711,  -711,  5724,  -711,
+     -98,   -51,   -51,  -711,  -711,  -711,  -711,   557,   394,   561,
+    -711,    21,    33,   144,   397,   139,   388,  -711,   397,   356,
+    -711,   139,  -711,   399,   402,   139,   388,   571,  -711,   407,
+     733,   575,  -711,  -711,   -51,   572,  -711,  3067,  -711,   401,
+     215,  3963,  -711,  5115,   -15,  -711,   425,  -711,   388,  -711,
+     601,  -711,  -711,  -711,  -711,   384,   356,  2530,  4731,  4731,
+     356,  -711,   429,  4091,  -711,  -711,  -711,  5430,  -711,  -711,
+    -711,  -711,  4731,  4731,  4731,  4731,   610,  5430,  -711,   304,
+     354,  -711,  1098,   616,   588,   618,  5621,  4859,  -711,   441,
+     443,  -711,  -711,  1515,   670,  2530,    27,  4731,  4731,  4731,
+      36,  1550,    45,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
+    4731,  4731,  4731,  4731,  4731,  1572,  4731,  4731,  4731,  4731,
+    4731,  4859,  2530,  1594,   782,  -711,   500,   630,   631,  4731,
+    1615,   633,  3451,  4731,  4731,  4731,  4731,  4731,  4731,  4731,
+    4731,  4731,  4731,  4731,  4731,  4731,  4731,  3195,  4731,  3579,
+    3707,  -711,   128,   356,  4731,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  4731,  4731,  -711,  1637,    48,   388,    70,  1697,
+    -711,  -711,   641,   641,  1819,  1173,  -711,   304,   -24,    -1,
+     457,   647,  -711,  -711,   471,   472,   151,    -1,  -711,   650,
+    -711,    62,   641,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   651,   634,
+    -711,    71,  2530,   476,   488,   -63,  -711,  -711,   480,   480,
+    -711,  4731,    72,   394,   314,  4731,  -711,   491,   495,   314,
+    -711,   384,  2538,  -711,  -711,  -711,   384,   388,   388,   384,
+    -711,   407,   571,  -711,  -711,   388,  -711,   486,  -711,  -711,
+    -711,  -711,  -711,   358,  -711,  -711,  -711,   480,  -711,  -711,
+     497,  4219,  -711,  -711,  2530,  -711,  -711,  3963,  3323,   487,
+     665,  4347,  -711,  2530,   489,  -711,   388,    23,  -711,  -711,
+    -711,  -711,   667,  2530,  2530,  -711,  -711,   498,  2530,   493,
+     672,  -711,  -711,  -711,  5621,  3835,    75,  -711,   119,  -711,
+    2530,  2530,  2530,  2530,  4731,   530,  5850,  2530,   304,  1840,
+    -711,   674,  2530,  -711,  5850,  -711,  5621,  5621,  5621,  5621,
+    5621,   654,  -711,   356,   356,  2666,  4731,  -711,    84,    85,
+    1879,  -711,  -711,  -711,  1900,  1921,  1942,  1963,  2006,  2027,
+    2145,  2209,  2230,  2251,  2272,  2293,  -711,    86,    88,    89,
+      90,    98,  2327,   678,   687,   693,  4859,  -711,  4859,  4859,
+      99,  -711,  4731,  4731,  2530,  -711,   710,   710,   569,   569,
+     670,   814,   814,   814,   814,   814,   814,   133,   133,   128,
+    4731,  4731,  2530,  -711,   128,  4731,   814,  4731,   814,   304,
+     695,  2811,   517,   520,  2530,  2530,  -711,   356,  -711,  -711,
+    -711,  -711,   532,   619,  4731,  2811,   -49,   526,  -711,  -711,
+    -711,   -49,   527,   356,  -711,  2588,  -711,  4731,  -711,  4731,
+    -711,  -711,    67,  -711,   681,  2530,  -711,  -711,   689,    50,
+     716,  -711,  2348,   691,   538,  -711,   705,   397,  4731,  -711,
+     105,  -711,  -711,  1384,   356,   707,   707,   407,  -711,  -711,
+     287,   733,   732,  -711,   568,   388,  -711,   558,  4219,   665,
+    -711,   570,  -711,   560,  -711,  -711,   738,   617,   741,  -711,
+    4731,   388,  -711,  -711,  4091,   536,  -711,  -711,  2811,   519,
+    5430,  -711,  -711,  2530,   727,   106,  -711,  2530,  2530,  5850,
+    2530,   674,   574,   654,   654,   654,   406,   647,   650,  -711,
+    2530,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  5243,  5243,  5243,  2530,  -711,  2530,  -711,  2530,
+    -711,  -711,   573,   814,   814,   128,   814,   814,  4731,  2939,
+    1406,   745,  -711,  -711,   334,  -711,   388,  -711,  -711,  2475,
+     107,   744,  -711,  -711,  -711,  -711,  -711,  -711,  2530,   109,
+    -711,  -711,  -711,   110,  -711,   577,  -711,   314,   314,   314,
+     314,   314,   354,  -711,   314,  -711,  -711,  2530,  2538,  -711,
+    4475,  -711,  5371,  -711,  -711,   571,  -711,  -711,  -711,   579,
+    -711,  -711,   388,   707,  -711,   665,  -711,  4219,  -711,   -50,
+     581,   582,  1196,   388,  -711,  -711,  1362,   580,   356,  -711,
+    -711,   588,  5891,  2530,  -711,  -711,   583,   584,   747,   585,
+     590,   591,  -711,   592,  4731,  1428,  4731,  2811,  -711,  -711,
+     754,  -711,   356,  -711,    26,  -711,    93,  -711,  -711,    29,
+      29,   586,   113,   737,  -711,  -711,  2530,  4603,  -711,  2530,
+    -711,   707,    64,  -711,  -711,   649,  -711,   770,  -711,  -711,
+    -711,  4731,  -711,  -711,   457,   596,  2530,  -711,  -711,  4731,
+    -711,  -711,  -711,  -711,  2530,  4731,  1471,  -711,  4731,  -711,
+    -711,  -711,   111,  -711,   597,    64,  -711,   162,   609,   611,
+    1282,  -711,  1305,  2530,  4731,  2530,  -711,  -711,  -711,  4731,
+    4731,  -711,  -711,  4731,  4731,  2530,  2530,  2530,  2530,  1328,
+    4731,  2530
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int16 yypgoto[] =
+{
+    -711,  -711,  -711,  -711,   523,  -711,    30,  -711,   774,  -711,
+     -66,   772,  -711,  -711,    65,     6,  -711,  -711,  -430,  -711,
+    -118,  -110,  -711,  -711,   123,  -711,  -711,  -711,   373,  -711,
+     120,     1,  -711,  -711,  -711,  -711,  -711,  -480,  -711,  -711,
+    -264,   312,  -439,  -711,  -711,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,   -68,  -711,  -711,  -276,   300,   -35,   -85,   548,
+     324,  -711,  -711,  -711,   274,  -711,  -711,  -711,  -711,  -711,
+     281,  -711,  -711,  -711,  -699,  -711,  -711,  -711,   515,  -290,
+    -666,  -711,  -711,   100,  -711,   749,  -104,  -711,   -25,   -17,
+     -26,  -136,    56,  -176,  -432,  -497,  -711,  -711,  -103,  -711,
+    -711,  -711,  -204,  -711,   404,   159,   -57,    95,    -5,   -70,
+    -711,  -711,  -197,  -398,   -30,  -108,  -711,  -166,  -711,  -711,
+    -711,  -711,   -23,  -711,  -105,  -711,  -711,  -711,  -711,  -711,
+    -711,  -711,  -711,  -711,   -28,  -711,  -711,  -711,   708,   302,
+    -208,  -711,  -711,  -711,  -711,  -711,  -711,  -711,  -711,   118,
+    -711,  -711,  -711,  -711,  -711,   277,  -711,  -711,   114,  -711,
+    -711,  -711,  -711,  -306,   720,  -263,  -226,  -711,  -673,  -554,
+     514,   482,  -326,  -710,   308,  -711,   273,  -202,  -711,   275,
+    -416,  -711,  -711,  -711
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -511
+static const yytype_int16 yytable[] =
+{
+     189,   384,   205,   421,   338,   218,   211,   533,   120,   205,
+     500,   385,   391,   512,   504,   226,   660,   854,   230,   706,
+     281,   568,   283,   440,   145,   758,   285,   438,   760,   318,
+     596,   575,   438,   682,   448,   217,   282,   339,   213,   596,
+     591,   383,   249,   250,   213,   494,   422,   423,   596,   830,
+     257,   667,   840,   837,   736,   625,   243,   311,   445,   694,
+     238,   239,   701,   866,   261,   683,   262,   701,   278,  -361,
+     340,   838,   839,   840,   687,   493,   821,   289,   750,    17,
+     756,   590,   756,   890,   891,   756,   885,   596,   596,   596,
+     830,   596,   596,   596,   290,   291,   312,   723,   313,   314,
+     274,   596,   596,   300,   317,   267,   220,   326,   848,   882,
+     897,   205,   687,   904,   904,   268,   830,  -164,   146,   925,
+      91,  -164,   353,   354,   221,   419,   292,   263,   437,   266,
+     227,   361,   148,   437,   838,   839,   840,   926,   351,   586,
+     329,   330,   587,   588,   589,   375,   414,   498,   303,   433,
+     319,   382,   279,   408,   297,   416,   406,   407,   408,   240,
+     246,   298,   390,   241,   922,  -315,   412,   969,   499,  -164,
+     452,   384,   935,  -164,   247,   240,   240,   425,   675,   241,
+     241,   385,   510,   223,   429,   240,   224,   497,  -314,   241,
+    -361,   338,   737,   434,   487,   831,   253,   254,   435,   923,
+     495,   338,   427,   213,   546,   623,   577,   597,   382,   885,
+     338,   383,   360,   320,   362,   385,   601,   841,   482,   248,
+     496,   214,   955,   424,   339,   603,   439,   216,   668,   446,
+     549,   447,   450,   203,   339,   229,   831,   480,   841,   578,
+     501,   726,   684,   339,   258,   383,   506,   832,   729,   207,
+     509,   688,   696,   120,   264,   751,   485,   340,   745,   301,
+     884,   884,   831,   884,   771,   772,   786,   340,   787,   788,
+     789,   534,   579,   951,   505,   534,   340,   543,   790,   801,
+     762,   763,   764,   765,   766,   849,   883,   901,   970,   903,
+     905,   966,   553,   554,   210,   490,   219,   558,   251,   752,
+     796,   841,   798,   800,   304,   590,   570,   571,   572,   573,
+     659,   550,   590,   409,   410,   555,   231,   548,   409,   410,
+     236,   382,   565,   669,    91,   276,   488,   489,   590,   936,
+     417,   680,   565,   600,   286,   150,   151,   604,   605,   606,
+     607,   608,   609,   610,   611,   612,   613,   614,   615,   237,
+     755,   886,   887,   232,   244,   622,   271,   908,   761,   527,
+     233,   721,   722,   234,   913,   391,   634,   636,   637,   638,
+     639,   640,   641,   642,   643,   644,   645,   646,   647,   648,
+     649,   652,   654,   656,   658,   440,   756,   282,   211,   438,
+     438,   536,   448,   284,   537,   306,   664,   665,   282,   909,
+     910,   911,   912,   715,   716,   701,   701,   701,   701,   701,
+     893,   719,   701,   598,   599,  -164,   707,   342,   347,  -164,
+     307,   714,   309,   315,   717,   856,   857,   858,   338,   587,
+     588,   589,   617,   618,   619,   620,   621,   322,   865,   884,
+     577,   855,   735,   846,   881,   630,   323,   325,   577,   327,
+     338,   338,   338,   338,   338,   357,   802,   691,   358,   359,
+     385,   339,   385,   385,   363,   695,   796,   798,   800,   702,
+     364,   365,   438,   578,   822,   366,   713,   438,   367,   824,
+     368,   578,   590,   339,   339,   339,   339,   339,   369,   370,
+     437,   437,   371,   413,   340,   372,   373,   374,   376,   590,
+     590,   590,   590,   590,   377,   534,   579,   378,   379,   380,
+     389,   534,   534,   414,   579,   390,   340,   340,   340,   340,
+     340,   416,   417,   418,   392,    91,   393,   394,   395,   396,
+     397,   428,   398,   399,   400,   401,   402,   403,   430,   749,
+     404,   405,   406,   407,   408,   431,   479,   483,   753,   484,
+     586,   329,   330,   587,   588,   589,   586,   329,   330,   587,
+     588,   589,   491,   267,   493,   769,   276,   502,   507,   205,
+     770,   508,   391,   437,   511,   528,   286,   924,   437,   526,
+     397,   535,   398,   399,   400,   401,   402,   403,   439,   447,
+     404,   405,   406,   407,   408,   329,   330,   587,   588,   589,
+     795,   545,   797,   799,   547,   556,   382,   803,   586,   329,
+     330,   587,   588,   589,   338,   574,   802,   898,   590,   584,
+     593,   863,   594,   577,   804,   805,   385,   385,   385,   806,
+     842,   807,   627,   628,   629,   810,   632,   873,  -490,  -490,
+    -490,  -490,  -490,  -490,   672,   879,   320,   339,   819,   810,
+     676,   678,   679,   681,   685,   689,   578,   690,   686,   692,
+     703,   828,   816,   482,   704,   720,   725,   730,   731,   734,
+     934,   447,   740,   743,   223,   744,   447,   759,   826,   589,
+     340,   792,   847,   398,   399,   400,   401,   402,   403,   579,
+     793,   404,   405,   406,   407,   408,   794,   814,   502,   808,
+     815,   817,   534,   818,   409,   410,   823,   825,   878,   851,
+     754,   835,   899,   836,   872,   844,   875,   495,   558,   395,
+     396,   397,   876,   398,   399,   400,   401,   402,   403,   845,
+     852,   404,   405,   406,   407,   408,   861,   862,   864,   867,
+     868,   391,   869,   870,   871,   565,   577,  -491,   897,   902,
+     929,   737,   939,   892,   409,   410,   906,   948,   921,   920,
+     933,   953,   513,   937,   938,   940,   795,   797,   799,   932,
+     941,   942,   943,   959,   841,   958,   961,   967,   971,   578,
+     925,   486,   211,   895,    16,   626,   144,  -247,   952,  -247,
+    -247,  -247,  -247,  -247,   950,  -247,  -247,  -247,  -247,  -247,
+    -247,   670,   724,  -247,  -247,  -247,  -247,  -247,   827,   829,
+     705,   718,   579,   253,   254,   514,   492,   697,   727,   544,
+     662,   860,   713,   914,   916,   256,   919,  -511,  -511,  -511,
+    -511,  -511,  -511,   915,   820,   404,   405,   406,   407,   408,
+     947,   534,   515,   877,   516,   517,   518,   968,   930,   519,
+     520,   352,   521,   522,   972,   409,   410,   741,   178,   179,
+     345,   592,   874,   624,   880,   742,   767,     0,   944,   768,
+     946,   810,     0,   351,   181,   182,     0,     0,   183,   184,
+     185,   186,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   390,   187,     0,     0,   409,   410,   949,     0,     0,
+       0,     0,     0,     0,     0,   960,     0,     0,     0,     0,
+       0,     0,     0,   962,     0,     0,     0,     0,     0,   963,
+       0,     0,   965,     2,     3,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   975,     0,
+       0,     0,     0,   976,   977,     0,     0,   978,   979,     0,
+     -23,     0,   -23,     0,   981,   -23,   -23,   -23,   -23,     4,
+       5,   -23,     0,     0,   -23,   -23,   -23,  -247,  -247,     0,
+       0,   -23,   -23,     0,     0,     0,     6,     7,     0,     0,
+       0,     0,     0,     0,     0,     0,   -23,     0,     0,     0,
+     -23,   -23,     0,     0,     0,   -23,     0,     0,     0,   409,
+     410,   -23,     0,   -23,   -23,     0,   -23,     0,   -23,   -23,
+     -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,   -23,   -23,
+     -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,   -23,
+       0,     0,   -23,   -23,   -23,     0,   -23,   -23,   -23,     0,
+     -23,   -23,   -23,     0,     0,   -23,     0,   -23,     0,     0,
+     -23,   -23,   -23,   -23,     0,     0,   -23,   -23,   -23,     0,
+       0,     0,     0,     0,   -23,     0,     0,     8,   -23,   -23,
+     -23,   -23,   -23,   -23,   -23,     0,   -23,   -23,   -23,   -23,
+     -23,     0,     0,   -23,     0,     0,     0,     0,     0,     0,
+     -23,   -23,   -23,     0,     0,     0,     0,     0,     0,   -23,
+       9,  -510,     0,  -510,     0,  -510,  -510,  -510,  -510,  -510,
+      10,  -510,  -510,  -510,  -510,  -510,  -510,     0,     0,  -510,
+    -510,  -510,  -510,  -510,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
+       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
+       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
+     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
+       0,   171,   172,   173,   174,   175,   674,   176,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,   931,
+       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
+     407,   408,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     178,   179,     0,     0,     0,     0,   180,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
+     183,   184,   185,   186,     0,     0,     0,    91,     0,     0,
+       0,     0,     0,     0,   187,     0,     0,   576,     0,     0,
+       0,     0,     0,  -510,  -510,   973,     0,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   974,     0,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,   980,     0,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,   409,   410,
+       0,     0,     0,     0,     0,     0,   896,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,   409,   410,   404,   405,   406,   407,   408,   850,   392,
+       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
+     401,   402,   403,     0,     0,   404,   405,   406,   407,   408,
+     896,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,     0,     0,   404,   405,   406,
+     407,   408,   945,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   964,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+     409,   410,   404,   405,   406,   407,   408,     0,     0,   392,
+       0,   393,   394,   395,   396,   397,     0,   398,   399,   400,
+     401,   402,   403,   409,   410,   404,   405,   406,   407,   408,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,   631,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,   409,
+     410,   404,   405,   406,   407,   408,     0,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,   409,   410,   404,   405,   406,   407,   408,     0,  -250,
+       0,  -250,  -250,  -250,  -250,  -250,     0,  -250,  -250,  -250,
+    -250,  -250,  -250,   409,   410,  -250,  -250,  -250,  -250,  -250,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,   409,   410,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   436,     0,     0,     0,     0,   409,
+     410,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   595,     0,     0,     0,     0,
+     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,     0,
+     602,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   616,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,  -250,     0,     0,     0,     0,  -250,
+    -250,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   631,     0,     0,     0,     0,
+     409,   410,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   666,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   671,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   673,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,   418,
+       0,   392,     0,   393,   394,   395,   396,   397,     0,   398,
+     399,   400,   401,   402,   403,   409,   410,   404,   405,   406,
+     407,   408,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,     0,     0,     0,     0,     0,     0,   773,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     774,     0,     0,     0,     0,   409,   410,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   775,     0,     0,     0,     0,   409,   410,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   776,     0,     0,     0,     0,   409,   410,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   777,     0,     0,     0,     0,   409,   410,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   778,     0,     0,     0,
+       0,   409,   410,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   779,     0,     0,
+       0,     0,   409,   410,   392,     0,   393,   394,   395,   396,
+     397,     0,   398,   399,   400,   401,   402,   403,     0,     0,
+     404,   405,   406,   407,   408,   392,     0,   393,   394,   395,
+     396,   397,     0,   398,   399,   400,   401,   402,   403,     0,
+       0,   404,   405,   406,   407,   408,   392,     0,   393,   394,
+     395,   396,   397,     0,   398,   399,   400,   401,   402,   403,
+       0,     0,   404,   405,   406,   407,   408,   392,     0,   393,
+     394,   395,   396,   397,     0,   398,   399,   400,   401,   402,
+     403,     0,     0,   404,   405,   406,   407,   408,   392,     0,
+     393,   394,   395,   396,   397,     0,   398,   399,   400,   401,
+     402,   403,     0,     0,   404,   405,   406,   407,   408,     0,
+       0,     0,     0,     0,     0,   780,     0,     0,     0,     0,
+     409,   410,   392,     0,   393,   394,   395,   396,   397,     0,
+     398,   399,   400,   401,   402,   403,     0,     0,   404,   405,
+     406,   407,   408,   392,     0,   393,   394,   395,   396,   397,
+       0,   398,   399,   400,   401,   402,   403,     0,     0,   404,
+     405,   406,   407,   408,     0,     0,     0,     0,     0,    22,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   781,
+       0,     0,     0,     0,   409,   410,     0,     0,     0,     0,
+       0,     0,     0,     0,    28,     0,     0,     0,     0,     0,
+     782,     0,     0,     0,     0,   409,   410,     0,     0,    32,
+       0,     0,     0,     0,    35,   348,     0,     0,     0,    39,
+      40,   783,     0,     0,     0,     0,   409,   410,     0,   349,
+      49,    50,    51,    52,    53,    54,   350,     0,     0,     0,
+       0,     0,   784,     0,     0,     0,     0,   409,   410,    64,
+       0,     0,     0,     0,     0,    67,     0,     0,     0,     0,
+       0,     0,     0,   785,    72,     0,    74,     0,   409,   410,
+     392,     0,   393,   394,   395,   396,   397,     0,   398,   399,
+     400,   401,   402,   403,     0,     0,   404,   405,   406,   407,
+     408,     0,     0,     0,     0,     0,     0,   791,     0,     0,
+      91,     0,   409,   410,     0,     0,     0,    92,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   843,     0,
+       0,     0,     0,   409,   410,   392,     0,   393,   394,   395,
+     396,   397,   708,   398,   399,   400,   401,   402,   403,     0,
+     149,   404,   405,   406,   407,   408,     0,     0,     0,   150,
+     151,   709,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   152,   153,     0,
+       0,     0,   154,   155,   156,   157,     0,     0,     0,     0,
+       0,     0,     0,     0,   158,   159,   160,   161,   162,   163,
+     164,     0,   165,   166,   167,     0,     0,   168,   169,   170,
+       0,   171,   172,   173,   174,   175,     0,   176,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   453,     0,
+       0,     0,   454,   455,   456,   457,     0,     0,     0,     0,
+       0,     0,     0,     0,   458,   459,   460,   461,   462,   463,
+     464,     0,   465,   466,   467,   900,     0,   468,   469,   470,
+     409,   410,   471,   472,   473,   474,     0,   475,     0,   177,
+       0,     0,     0,     0,     0,     0,     0,     0,   149,     0,
+     178,   179,     0,     0,     0,     0,   180,   150,   151,     0,
+       0,     0,     0,     0,     0,     0,   181,   182,     0,     0,
+     183,   184,   185,   186,     0,   152,   153,    91,     0,     0,
+     154,   155,   156,   157,   187,   409,   410,   188,     0,     0,
+       0,     0,   158,   159,   160,   161,   162,   163,   164,     0,
+     165,   166,   167,     0,     0,   168,   169,   170,     0,   171,
+     172,   173,   174,   175,     0,   176,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   476,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   177,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   178,   179,
+       0,     0,     0,     0,   180,   809,     0,     0,     0,     0,
+       0,     0,     0,   149,   181,   182,     0,     0,   183,   184,
+     185,   186,   150,   151,     0,    91,     0,     0,     0,     0,
+       0,     0,   187,     0,     0,   188,     0,     0,     0,     0,
+     152,   153,     0,   204,     0,   154,   155,   156,   157,     0,
+       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,   894,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,   531,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+     532,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+     650,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,     0,   651,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,   728,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,   633,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,   655,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,   657,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,   746,     0,
+     747,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   532,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   748,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,   557,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,   538,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,   532,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+     733,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   188,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,   709,     0,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   187,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,   954,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   188,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,    91,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   188,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   177,     0,     0,     0,     0,     0,     0,     0,
+       0,   149,     0,   178,   179,     0,     0,     0,     0,   180,
+     150,   151,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,   152,   153,
+      91,     0,     0,   154,   155,   156,   157,   187,     0,     0,
+     188,     0,     0,     0,     0,   158,   159,   160,   161,   162,
+     163,   164,     0,   165,   166,   167,     0,     0,   168,   169,
+     170,     0,   171,   172,   173,   174,   175,     0,   176,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     177,     0,     0,     0,     0,     0,     0,     0,     0,   149,
+       0,   178,   179,     0,     0,     0,     0,   180,   150,   151,
+       0,     0,     0,     0,     0,     0,     0,   181,   182,     0,
+       0,   183,   184,   185,   186,     0,   152,   153,    91,     0,
+       0,   154,   155,   156,   157,   187,     0,     0,   381,     0,
+       0,     0,     0,   158,   159,   160,   161,   162,   163,   164,
+       0,   165,   166,   167,     0,     0,   168,   169,   170,     0,
+     171,   172,   173,   174,   175,     0,   176,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   177,     0,
+       0,     0,     0,     0,     0,     0,     0,   149,     0,   178,
+     179,     0,     0,     0,     0,   180,   150,   151,     0,     0,
+       0,     0,     0,     0,     0,   181,   182,     0,     0,   183,
+     184,   185,   186,     0,   152,   153,    91,     0,     0,   154,
+     155,   156,   157,   444,     0,     0,   188,     0,     0,     0,
+       0,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,     0,     0,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   177,     0,     0,     0,
+       0,     0,     0,     0,     0,   149,     0,   178,   179,     0,
+       0,     0,     0,   180,   150,   151,     0,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,   152,   153,    91,     0,     0,   154,   155,   156,
+     157,   187,     0,     0,   541,     0,     0,     0,     0,   158,
+     159,   160,   161,   162,   163,   164,     0,   165,   166,   167,
+       0,     0,   168,   169,   170,     0,   171,   172,   173,   174,
+     175,     0,   176,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   177,     0,     0,     0,     0,     0,
+       0,     0,     0,   149,     0,   178,   179,     0,     0,     0,
+       0,   180,   150,   151,     0,     0,     0,     0,     0,     0,
+       0,   181,   182,     0,     0,   183,   184,   185,   186,     0,
+     152,   153,   888,     0,     0,   154,   155,   156,   157,   187,
+       0,     0,   381,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,   329,   330,   562,     0,   563,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   152,
+     153,     0,     0,     0,   154,   155,   156,   157,     0,     0,
+     332,   333,   334,     0,     0,   335,   158,   159,   160,   161,
+     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
+     169,   170,   177,   171,   172,   173,   174,   175,     0,   176,
+       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
+      91,     0,     0,     0,     0,     0,     0,   187,     0,     0,
+     917,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
+       0,     0,   183,   184,   185,   186,   329,   330,   331,   336,
+       0,     0,     0,     0,     0,     0,   187,     0,     0,   564,
+       0,     0,     0,     0,   152,   153,     0,     0,     0,   154,
+     155,   156,   157,     0,     0,   332,   333,   334,     0,     0,
+     335,   158,   159,   160,   161,   162,   163,   164,     0,   165,
+     166,   167,   329,   330,   168,   169,   170,     0,   171,   172,
+     173,   174,   175,     0,   176,     0,     0,     0,     0,     0,
+     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
+       0,   332,   333,   334,     0,     0,   335,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   178,   179,     0,
+       0,     0,     0,   180,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   181,   182,     0,     0,   183,   184,   185,
+     186,     0,     0,     0,   336,     0,     0,     0,     0,     0,
+       0,   187,     0,    19,   337,     0,    20,   -28,    21,   -28,
+       0,     0,    22,   178,   179,    23,    24,    25,     0,   180,
+       0,     0,    26,    27,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,    28,     0,     0,
+     336,    29,    30,     0,     0,     0,    31,   187,     0,     0,
+     564,     0,    32,     0,    33,    34,     0,    35,     0,    36,
+      37,    38,    39,    40,     0,    41,    42,    43,    44,    45,
+      46,    47,    48,    49,    50,    51,    52,    53,    54,    55,
+      56,     0,     0,    57,    58,    59,     0,    60,    61,    62,
+       0,    63,    64,    65,     0,     0,    66,     0,    67,     0,
+       0,    68,    69,    70,    71,     0,     0,    72,    73,    74,
+       0,     0,     0,     0,     0,    75,     0,     0,     0,    76,
+      77,    78,    79,    80,    81,    82,     0,    83,    84,    85,
+      86,    87,     0,     0,    88,     0,     0,     0,     0,   152,
+     153,    89,    90,    91,   154,   155,   156,   157,     0,     0,
+      92,     0,     0,     0,     0,     0,   158,   159,   160,   161,
+     162,   163,   164,     0,   165,   166,   167,     0,     0,   168,
+     169,   170,     0,   171,   172,   173,   174,   175,     0,   176,
+     152,   153,     0,     0,     0,   154,   155,   156,   157,     0,
+       0,     0,     0,     0,     0,     0,     0,   158,   159,   160,
+     161,   162,   163,   164,     0,   165,   166,   167,     0,     0,
+     168,   169,   170,     0,   171,   172,   173,   174,   175,     0,
+     176,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   178,   179,     0,     0,     0,     0,   180,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   181,   182,
+       0,     0,   183,   184,   185,   186,     0,     0,     0,    91,
+       0,     0,     0,     0,     0,     0,   187,     0,     0,   576,
+       0,     0,     0,   178,   179,     0,     0,     0,     0,   180,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   181,
+     182,     0,     0,   183,   184,   185,   186,     0,     0,     0,
+     888,     0,     0,     0,     0,     0,     0,   187,     0,     0,
+     576
+};
+
+static const yytype_int16 yycheck[] =
+{
+      26,   177,    28,   200,   140,    35,    32,   297,    13,    35,
+     274,   177,   188,   289,   278,    41,   414,   716,    46,   499,
+     105,   327,   107,   231,    18,   579,   111,   231,   582,     5,
+       3,   337,   236,   449,   236,    34,     3,   140,     4,     3,
+     346,   177,    70,    71,     4,    24,     3,     4,     3,    23,
+      78,     3,    23,     3,    31,   381,    61,   123,   234,   489,
+      59,    60,   494,   729,    33,     3,    35,   499,   103,     5,
+     140,    21,    22,    23,     3,     3,   125,   112,     3,   177,
+     577,   344,   579,   793,   794,   582,   759,     3,     3,     3,
+      23,     3,     3,     3,     3,     4,   124,   527,   126,   127,
+       3,     3,     3,    23,   130,   169,   169,   137,     3,     3,
+       3,   137,     3,     3,     3,   179,    23,    20,   169,   169,
+     169,    24,   148,   149,   187,   158,    35,    97,   231,    99,
+     169,   157,   179,   236,    21,    22,    23,   187,   143,    20,
+      21,    22,    23,    24,    25,   171,   179,     3,    23,   217,
+     126,   177,     3,    25,   169,   179,    23,    24,    25,    20,
+     123,   176,   188,    24,   863,   189,   192,     5,    24,    20,
+     238,   347,   882,    24,   137,    20,    20,   203,   179,    24,
+      24,   347,   286,   176,   210,    20,   179,   272,   189,    24,
+     126,   327,   169,   219,   260,   169,    80,    81,   224,   865,
+     179,   337,   207,     4,   308,   381,   342,   180,   234,   882,
+     346,   347,   156,   189,   158,   381,   180,   188,   244,   127,
+     187,   187,   921,   180,   327,   180,   231,   187,   180,   234,
+     315,   236,   237,   179,   337,   169,   169,   242,   188,   342,
+     275,   531,   180,   346,    27,   381,   281,   180,   538,   179,
+     285,   180,   180,   258,   158,   180,   255,   327,   564,   179,
+     757,   758,   169,   760,   180,   180,   180,   337,   180,   180,
+     180,   297,   342,   180,   279,   301,   346,   303,   180,   180,
+     586,   587,   588,   589,   590,   180,   180,   180,   126,   180,
+     180,   180,   318,   319,   179,   265,   179,   323,   169,   180,
+     626,   188,   628,   629,   179,   568,   332,   333,   334,   335,
+     413,   316,   575,   185,   186,   320,   179,   311,   185,   186,
+     179,   347,   327,   427,   169,   169,   261,   262,   591,   883,
+     179,   180,   337,   359,   169,    21,    22,   363,   364,   365,
+     366,   367,   368,   369,   370,   371,   372,   373,   374,   179,
+     576,   767,   768,   169,   179,   381,   169,   837,   584,   294,
+     176,     3,     4,   179,   844,   541,   392,   393,   394,   395,
+     396,   397,   398,   399,   400,   401,   402,   403,   404,   405,
+     406,   407,   408,   409,   410,   593,   883,     3,   414,   593,
+     594,   176,   594,     3,   179,    23,   422,   423,     3,   838,
+     839,   840,   841,   507,   508,   837,   838,   839,   840,   841,
+     808,   515,   844,   357,   358,    20,   501,   140,   141,    24,
+       4,   506,   169,   176,   509,   138,   139,   140,   564,    23,
+      24,    25,   376,   377,   378,   379,   380,     3,   728,   936,
+     576,   717,   546,   707,   750,   389,   179,   169,   584,   179,
+     586,   587,   588,   589,   590,   179,   632,   485,   179,   179,
+     626,   564,   628,   629,   179,   491,   792,   793,   794,   495,
+     179,   179,   676,   576,   676,   179,   502,   681,   179,   681,
+     179,   584,   745,   586,   587,   588,   589,   590,   179,   179,
+     593,   594,   179,   189,   564,   179,   179,   179,   179,   762,
+     763,   764,   765,   766,   179,   531,   576,   179,   179,   179,
+     179,   537,   538,   179,   584,   541,   586,   587,   588,   589,
+     590,   179,   179,   169,     5,   169,     7,     8,     9,    10,
+      11,     3,    13,    14,    15,    16,    17,    18,     4,   565,
+      21,    22,    23,    24,    25,   169,   169,     3,   574,     3,
+      20,    21,    22,    23,    24,    25,    20,    21,    22,    23,
+      24,    25,     5,   169,     3,   595,   169,   179,   169,   595,
+     596,   169,   748,   676,     3,     3,   169,   867,   681,     4,
+      11,   180,    13,    14,    15,    16,    17,    18,   593,   594,
+      21,    22,    23,    24,    25,    21,    22,    23,    24,    25,
+     626,   176,   628,   629,     3,   176,   632,   633,    20,    21,
+      22,    23,    24,    25,   750,     5,   792,   814,   881,     3,
+     179,   725,   179,   759,   650,   651,   792,   793,   794,   655,
+     700,   657,   132,     3,     3,   661,     3,   741,    20,    21,
+      22,    23,    24,    25,     3,   749,   189,   750,   674,   675,
+       3,   180,   180,     3,     3,   179,   759,   169,    24,   179,
+     169,   687,   667,   689,   169,   179,   169,   180,     3,   180,
+     878,   676,     5,   180,   176,     3,   681,     3,   683,    25,
+     750,     3,   708,    13,    14,    15,    16,    17,    18,   759,
+       3,    21,    22,    23,    24,    25,     3,   180,   179,     4,
+     180,   169,   728,    84,   185,   186,   180,   180,   189,   714,
+     180,    30,   816,    24,   740,    24,   180,   179,   744,     9,
+      10,    11,   748,    13,    14,    15,    16,    17,    18,    24,
+      23,    21,    22,    23,    24,    25,     4,   169,   180,   169,
+     180,   917,     4,   126,     3,   750,   882,    20,     3,     5,
+     169,   169,     5,   180,   185,   186,   179,     3,   862,   180,
+     180,    24,    29,   180,   180,   180,   792,   793,   794,   873,
+     180,   180,   180,     3,   188,   126,   180,   180,   169,   882,
+     169,   258,   808,   809,    10,     3,    14,     5,   906,     7,
+       8,     9,    10,    11,   904,    13,    14,    15,    16,    17,
+      18,   428,   528,    21,    22,    23,    24,    25,   685,   689,
+     498,   511,   882,    80,    81,    82,   268,   493,   537,   304,
+     416,   721,   848,   848,   850,    76,   852,    13,    14,    15,
+      16,    17,    18,   850,   675,    21,    22,    23,    24,    25,
+     897,   867,   109,   748,   111,   112,   113,   955,   871,   116,
+     117,   143,   119,   120,   959,   185,   186,   555,   142,   143,
+     140,   347,   744,   381,   750,   557,   593,    -1,   894,   594,
+     896,   897,    -1,   878,   158,   159,    -1,    -1,   162,   163,
+     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   917,   176,    -1,    -1,   185,   186,   902,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   931,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   939,    -1,    -1,    -1,    -1,    -1,   945,
+      -1,    -1,   948,     0,     1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   964,    -1,
+      -1,    -1,    -1,   969,   970,    -1,    -1,   973,   974,    -1,
+      27,    -1,    29,    -1,   980,    32,    33,    34,    35,    36,
+      37,    38,    -1,    -1,    41,    42,    43,   185,   186,    -1,
+      -1,    48,    49,    -1,    -1,    -1,    53,    54,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,
+      67,    68,    -1,    -1,    -1,    72,    -1,    -1,    -1,   185,
+     186,    78,    -1,    80,    81,    -1,    83,    -1,    85,    86,
+      87,    88,    89,    -1,    91,    92,    93,    94,    95,    96,
+      97,    98,    99,   100,   101,   102,   103,   104,   105,   106,
+      -1,    -1,   109,   110,   111,    -1,   113,   114,   115,    -1,
+     117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,    -1,
+     127,   128,   129,   130,    -1,    -1,   133,   134,   135,    -1,
+      -1,    -1,    -1,    -1,   141,    -1,    -1,   144,   145,   146,
+     147,   148,   149,   150,   151,    -1,   153,   154,   155,   156,
+     157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+     167,   168,   169,    -1,    -1,    -1,    -1,    -1,    -1,   176,
+     177,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
+     187,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
+      -1,    73,    74,    75,    76,    77,     3,    79,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,     3,
+      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
+      24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     142,   143,    -1,    -1,    -1,    -1,   148,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
+     162,   163,   164,   165,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,   176,    -1,    -1,   179,    -1,    -1,
+      -1,    -1,    -1,   185,   186,     3,    -1,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     3,    -1,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,     3,    -1,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,   185,   186,
+      -1,    -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,   185,   186,    21,    22,    23,    24,    25,     4,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,    -1,    -1,    21,    22,    23,    24,    25,
+       4,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,    -1,    -1,    21,    22,    23,
+      24,    25,     4,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+     185,   186,    21,    22,    23,    24,    25,    -1,    -1,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,   185,
+     186,    21,    22,    23,    24,    25,    -1,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,   185,   186,    21,    22,    23,    24,    25,    -1,     5,
+      -1,     7,     8,     9,    10,    11,    -1,    13,    14,    15,
+      16,    17,    18,   185,   186,    21,    22,    23,    24,    25,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,   185,   186,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
+     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,
+     186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,   169,
+      -1,     5,    -1,     7,     8,     9,    10,    11,    -1,    13,
+      14,    15,    16,    17,    18,   185,   186,    21,    22,    23,
+      24,    25,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,
+      -1,   185,   186,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+      -1,    -1,   185,   186,     5,    -1,     7,     8,     9,    10,
+      11,    -1,    13,    14,    15,    16,    17,    18,    -1,    -1,
+      21,    22,    23,    24,    25,     5,    -1,     7,     8,     9,
+      10,    11,    -1,    13,    14,    15,    16,    17,    18,    -1,
+      -1,    21,    22,    23,    24,    25,     5,    -1,     7,     8,
+       9,    10,    11,    -1,    13,    14,    15,    16,    17,    18,
+      -1,    -1,    21,    22,    23,    24,    25,     5,    -1,     7,
+       8,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
+      18,    -1,    -1,    21,    22,    23,    24,    25,     5,    -1,
+       7,     8,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    18,    -1,    -1,    21,    22,    23,    24,    25,    -1,
+      -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,    -1,    -1,
+     185,   186,     5,    -1,     7,     8,     9,    10,    11,    -1,
+      13,    14,    15,    16,    17,    18,    -1,    -1,    21,    22,
+      23,    24,    25,     5,    -1,     7,     8,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    18,    -1,    -1,    21,
+      22,    23,    24,    25,    -1,    -1,    -1,    -1,    -1,    38,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,
+      -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    63,    -1,    -1,    -1,    -1,    -1,
+     180,    -1,    -1,    -1,    -1,   185,   186,    -1,    -1,    78,
+      -1,    -1,    -1,    -1,    83,    84,    -1,    -1,    -1,    88,
+      89,   180,    -1,    -1,    -1,    -1,   185,   186,    -1,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,   180,    -1,    -1,    -1,    -1,   185,   186,   118,
+      -1,    -1,    -1,    -1,    -1,   124,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   180,   133,    -1,   135,    -1,   185,   186,
+       5,    -1,     7,     8,     9,    10,    11,    -1,    13,    14,
+      15,    16,    17,    18,    -1,    -1,    21,    22,    23,    24,
+      25,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,    -1,
+     169,    -1,   185,   186,    -1,    -1,    -1,   176,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   180,    -1,
+      -1,    -1,    -1,   185,   186,     5,    -1,     7,     8,     9,
+      10,    11,     4,    13,    14,    15,    16,    17,    18,    -1,
+      12,    21,    22,    23,    24,    25,    -1,    -1,    -1,    21,
+      22,    23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,    -1,    -1,    69,    70,    71,
+      -1,    73,    74,    75,    76,    77,    -1,    79,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    40,    -1,
+      -1,    -1,    44,    45,    46,    47,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,    61,
+      62,    -1,    64,    65,    66,   180,    -1,    69,    70,    71,
+     185,   186,    74,    75,    76,    77,    -1,    79,    -1,   131,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,
+     142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,
+     162,   163,   164,   165,    -1,    39,    40,   169,    -1,    -1,
+      44,    45,    46,    47,   176,   185,   186,   179,    -1,    -1,
+      -1,    -1,    56,    57,    58,    59,    60,    61,    62,    -1,
+      64,    65,    66,    -1,    -1,    69,    70,    71,    -1,    73,
+      74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   169,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,
+      -1,    -1,    -1,    -1,   148,     4,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,   158,   159,    -1,    -1,   162,   163,
+     164,   165,    21,    22,    -1,   169,    -1,    -1,    -1,    -1,
+      -1,    -1,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,
+      39,    40,    -1,   187,    -1,    44,    45,    46,    47,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    24,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,     5,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,     5,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,     5,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
+      25,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    12,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      21,    22,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    39,    40,
+     169,    -1,    -1,    44,    45,    46,    47,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    56,    57,    58,    59,    60,
+      61,    62,    -1,    64,    65,    66,    -1,    -1,    69,    70,
+      71,    -1,    73,    74,    75,    76,    77,    -1,    79,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     131,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,
+      -1,   142,   143,    -1,    -1,    -1,    -1,   148,    21,    22,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,    -1,
+      -1,   162,   163,   164,   165,    -1,    39,    40,   169,    -1,
+      -1,    44,    45,    46,    47,   176,    -1,    -1,   179,    -1,
+      -1,    -1,    -1,    56,    57,    58,    59,    60,    61,    62,
+      -1,    64,    65,    66,    -1,    -1,    69,    70,    71,    -1,
+      73,    74,    75,    76,    77,    -1,    79,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    12,    -1,   142,
+     143,    -1,    -1,    -1,    -1,   148,    21,    22,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   158,   159,    -1,    -1,   162,
+     163,   164,   165,    -1,    39,    40,   169,    -1,    -1,    44,
+      45,    46,    47,   176,    -1,    -1,   179,    -1,    -1,    -1,
+      -1,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    -1,    -1,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    12,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    21,    22,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    39,    40,   169,    -1,    -1,    44,    45,    46,
+      47,   176,    -1,    -1,   179,    -1,    -1,    -1,    -1,    56,
+      57,    58,    59,    60,    61,    62,    -1,    64,    65,    66,
+      -1,    -1,    69,    70,    71,    -1,    73,    74,    75,    76,
+      77,    -1,    79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   131,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    12,    -1,   142,   143,    -1,    -1,    -1,
+      -1,   148,    21,    22,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,   158,   159,    -1,    -1,   162,   163,   164,   165,    -1,
+      39,    40,   169,    -1,    -1,    44,    45,    46,    47,   176,
+      -1,    -1,   179,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    21,    22,    23,    -1,    25,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    39,
+      40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,    -1,
+      50,    51,    52,    -1,    -1,    55,    56,    57,    58,    59,
+      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
+      70,    71,   131,    73,    74,    75,    76,    77,    -1,    79,
+      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
+     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
+     179,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
+      -1,    -1,   162,   163,   164,   165,    21,    22,    23,   169,
+      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
+      -1,    -1,    -1,    -1,    39,    40,    -1,    -1,    -1,    44,
+      45,    46,    47,    -1,    -1,    50,    51,    52,    -1,    -1,
+      55,    56,    57,    58,    59,    60,    61,    62,    -1,    64,
+      65,    66,    21,    22,    69,    70,    71,    -1,    73,    74,
+      75,    76,    77,    -1,    79,    -1,    -1,    -1,    -1,    -1,
+      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
+      -1,    50,    51,    52,    -1,    -1,    55,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   142,   143,    -1,
+      -1,    -1,    -1,   148,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   158,   159,    -1,    -1,   162,   163,   164,
+     165,    -1,    -1,    -1,   169,    -1,    -1,    -1,    -1,    -1,
+      -1,   176,    -1,    29,   179,    -1,    32,    33,    34,    35,
+      -1,    -1,    38,   142,   143,    41,    42,    43,    -1,   148,
+      -1,    -1,    48,    49,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    63,    -1,    -1,
+     169,    67,    68,    -1,    -1,    -1,    72,   176,    -1,    -1,
+     179,    -1,    78,    -1,    80,    81,    -1,    83,    -1,    85,
+      86,    87,    88,    89,    -1,    91,    92,    93,    94,    95,
+      96,    97,    98,    99,   100,   101,   102,   103,   104,   105,
+     106,    -1,    -1,   109,   110,   111,    -1,   113,   114,   115,
+      -1,   117,   118,   119,    -1,    -1,   122,    -1,   124,    -1,
+      -1,   127,   128,   129,   130,    -1,    -1,   133,   134,   135,
+      -1,    -1,    -1,    -1,    -1,   141,    -1,    -1,    -1,   145,
+     146,   147,   148,   149,   150,   151,    -1,   153,   154,   155,
+     156,   157,    -1,    -1,   160,    -1,    -1,    -1,    -1,    39,
+      40,   167,   168,   169,    44,    45,    46,    47,    -1,    -1,
+     176,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,    59,
+      60,    61,    62,    -1,    64,    65,    66,    -1,    -1,    69,
+      70,    71,    -1,    73,    74,    75,    76,    77,    -1,    79,
+      39,    40,    -1,    -1,    -1,    44,    45,    46,    47,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    56,    57,    58,
+      59,    60,    61,    62,    -1,    64,    65,    66,    -1,    -1,
+      69,    70,    71,    -1,    73,    74,    75,    76,    77,    -1,
+      79,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,   159,
+      -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,   169,
+      -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,   179,
+      -1,    -1,    -1,   142,   143,    -1,    -1,    -1,    -1,   148,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   158,
+     159,    -1,    -1,   162,   163,   164,   165,    -1,    -1,    -1,
+     169,    -1,    -1,    -1,    -1,    -1,    -1,   176,    -1,    -1,
+     179
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint16 yystos[] =
+{
+       0,   191,     0,     1,    36,    37,    53,    54,   144,   177,
+     187,   192,   197,   199,   205,   201,   198,   177,   200,    29,
+      32,    34,    38,    41,    42,    43,    48,    49,    63,    67,
+      68,    72,    78,    80,    81,    83,    85,    86,    87,    88,
+      89,    91,    92,    93,    94,    95,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   109,   110,   111,
+     113,   114,   115,   117,   118,   119,   122,   124,   127,   128,
+     129,   130,   133,   134,   135,   141,   145,   146,   147,   148,
+     149,   150,   151,   153,   154,   155,   156,   157,   160,   167,
+     168,   169,   176,   193,   194,   195,   202,   203,   206,   212,
+     224,   225,   228,   229,   234,   235,   237,   238,   239,   240,
+     241,   243,   244,   251,   253,   257,   258,   261,   262,   263,
+     298,   308,   309,   315,   316,   317,   318,   319,   321,   326,
+     327,   328,   330,   331,   333,   336,   337,   340,   341,   349,
+     351,   352,   365,   372,   201,   205,   169,   204,   179,    12,
+      21,    22,    39,    40,    44,    45,    46,    47,    56,    57,
+      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
+      71,    73,    74,    75,    76,    77,    79,   131,   142,   143,
+     148,   158,   159,   162,   163,   164,   165,   176,   179,   280,
+     281,   283,   284,   288,   290,   291,   292,   293,   298,   299,
+     300,   307,   320,   179,   187,   280,   304,   179,   217,   218,
+     179,   280,   303,     4,   187,   221,   187,   221,   304,   179,
+     169,   187,   324,   176,   179,   364,   280,   169,   325,   169,
+     324,   179,   169,   176,   179,   346,   179,   179,   221,   221,
+      20,    24,   247,   298,   179,   216,   123,   137,   127,   324,
+     324,   169,   252,    80,    81,   213,   275,   324,    27,   196,
+     198,    33,    35,   196,   158,   207,   196,   169,   179,   249,
+     250,   169,   226,   231,     3,   248,   169,   230,   247,     3,
+     236,   248,     3,   248,     3,   248,   169,   245,   246,   247,
+       3,     4,    35,   222,   223,   255,   271,   169,   176,   268,
+      23,   179,   259,    23,   179,   266,    23,     4,   329,   169,
+     310,   200,   324,   324,   324,   176,   323,   280,     5,   126,
+     189,   332,     3,   179,   334,   169,   304,   179,   345,    21,
+      22,    23,    50,    51,    52,    55,   169,   179,   281,   288,
+     299,   343,   345,   350,   353,   354,   355,   345,    84,    98,
+     105,   298,   328,   280,   280,   280,   282,   179,   179,   179,
+     282,   280,   282,   179,   179,   179,   179,   179,   179,   179,
+     179,   179,   179,   179,   179,   280,   179,   179,   179,   179,
+     179,   179,   280,   281,   283,   307,   360,   361,   362,   179,
+     280,   283,     5,     7,     8,     9,    10,    11,    13,    14,
+      15,    16,    17,    18,    21,    22,    23,    24,    25,   185,
+     186,   285,   280,   189,   179,   302,   179,   179,   169,   158,
+     301,   302,     3,     4,   180,   280,   219,   298,     3,   280,
+       4,   169,   242,   242,   280,   280,   180,   288,   292,   298,
+     330,   366,   367,   368,   176,   283,   298,   298,   367,   369,
+     298,   371,   242,    40,    44,    45,    46,    47,    56,    57,
+      58,    59,    60,    61,    62,    64,    65,    66,    69,    70,
+      71,    74,    75,    76,    77,    79,   169,   214,   215,   169,
+     298,   220,   280,     3,     3,   221,   194,   200,   204,   204,
+     196,     5,   249,     3,    24,   179,   187,   248,     3,    24,
+     230,   247,   179,   276,   230,   298,   247,   169,   169,   247,
+     276,     3,   245,    29,    82,   109,   111,   112,   113,   116,
+     117,   119,   120,   272,   273,   275,     4,   204,     3,   256,
+     254,     5,    23,   269,   280,   180,   176,   179,   169,   260,
+     269,   179,   267,   280,   268,   176,   276,     3,   205,   248,
+     298,   322,   373,   280,   280,   298,   176,    23,   280,   335,
+     338,   339,    23,    25,   179,   298,   347,   348,   353,   354,
+     280,   280,   280,   280,     5,   353,   179,   281,   288,   299,
+     342,   356,   357,   358,     3,   344,    20,    23,    24,    25,
+     355,   353,   360,   179,   179,   180,     3,   180,   282,   282,
+     280,   180,   180,   180,   280,   280,   280,   280,   280,   280,
+     280,   280,   280,   280,   280,   280,   180,   282,   282,   282,
+     282,   282,   280,   283,   361,   362,     3,   132,     3,     3,
+     282,   180,     3,     5,   280,   287,   280,   280,   280,   280,
+     280,   280,   280,   280,   280,   280,   280,   280,   280,   280,
+       5,    24,   280,   286,   280,     5,   280,     5,   280,   288,
+     303,   289,   294,   294,   280,   280,   180,     3,   180,   276,
+     218,   180,     3,   180,     3,   179,     3,   370,   180,   180,
+     180,     3,   370,     3,   180,     3,    24,     3,   180,   179,
+     169,   324,   179,   208,   208,   280,   180,   250,   227,   232,
+     233,   284,   280,   169,   169,   231,   227,   248,     4,    23,
+     277,   278,   279,   280,   248,   276,   276,   248,   246,   276,
+     179,     3,     4,   208,   254,   169,   269,   260,     5,   269,
+     180,     3,   270,    23,   180,   276,    31,   169,   311,   312,
+       5,   329,   364,   180,     3,   353,    23,    25,   179,   280,
+       3,   180,   180,   280,   180,   356,   285,   359,   359,     3,
+     359,   356,   353,   353,   353,   353,   353,   366,   369,   304,
+     280,   180,   180,   180,   180,   180,   180,   180,   180,   180,
+     180,   180,   180,   180,   180,   180,   180,   180,   180,   180,
+     180,   180,     3,     3,     3,   280,   362,   280,   362,   280,
+     362,   180,   283,   280,   280,   280,   280,   280,     4,     4,
+     280,   295,   296,   297,   180,   180,   298,   169,    84,   280,
+     295,   125,   367,   180,   367,   180,   298,   214,   280,   220,
+      23,   169,   180,   210,   211,    30,    24,     3,    21,    22,
+      23,   188,   299,   180,    24,    24,   230,   280,     3,   180,
+       4,   298,    23,   264,   264,   245,   138,   139,   140,   274,
+     273,     4,   169,   276,   180,   269,   270,   169,   180,     4,
+     126,     3,   280,   276,   339,   180,   280,   297,   189,   276,
+     348,   353,     3,   180,   285,   358,   370,   370,   169,   363,
+     363,   363,   180,   303,     4,   280,     4,     3,   302,   276,
+     180,   180,     5,   180,     3,   180,   179,   209,   227,   232,
+     232,   232,   232,   227,   278,   279,   280,   179,   265,   280,
+     180,   276,   264,   270,   269,   169,   187,   313,   314,   169,
+     312,     3,   276,   180,   330,   363,   359,   180,   180,     5,
+     180,   180,   180,   180,   280,     4,   280,   296,     3,   298,
+     211,   180,   210,    24,    23,   264,   305,   306,   126,     3,
+     280,   180,   280,   280,     4,   280,   180,   180,   305,     5,
+     126,   169,   314,     3,     3,   280,   280,   280,   280,   280,
+       3,   280
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      fprintf (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
+    }
+}
+#endif /* YYERROR_VERBOSE */
+
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+  
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 8:
+#line 344 "fortran.y"
+    {yyerrok;yyclearin;;}
+    break;
+
+  case 13:
+#line 352 "fortran.y"
+    {
+                     if (inmoduledeclare == 0 )
+                     {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curinclude,
+                                              pos_end-pos_curinclude);
+                     }
+                  ;}
+    break;
+
+  case 18:
+#line 368 "fortran.y"
+    {
+            /* we should ignore the declaration until the keyword             */
+            /*    TOK_ENDDONOTTREAT                                           */
+            couldaddvariable = 0 ;
+            RemoveWordCUR_0(fortranout,-20,20);
+         ;}
+    break;
+
+  case 19:
+#line 375 "fortran.y"
+    {
+             couldaddvariable = 1 ;
+             RemoveWordCUR_0(fortranout,-24,24);
+          ;}
+    break;
+
+  case 22:
+#line 382 "fortran.y"
+    {pos_cur = setposcur();;}
+    break;
+
+  case 27:
+#line 394 "fortran.y"
+    {if (incom !=1) {strcpy(curbuf,"");incom=0;};}
+    break;
+
+  case 28:
+#line 397 "fortran.y"
+    {isrecursive = 0;;}
+    break;
+
+  case 29:
+#line 399 "fortran.y"
+    {isrecursive = 1;;}
+    break;
+
+  case 31:
+#line 403 "fortran.y"
+    {
+                      if ( couldaddvariable == 1)
+                      {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(1);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            writeheadnewsub_0(1);
+                      }
+                      }
+                   ;}
+    break;
+
+  case 32:
+#line 431 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (2)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      strcpy(subroutinename,(yyvsp[(2) - (2)].nac));
+                      /* Common case                                          */
+                      insubroutinedeclare = 1;
+                      /* in the second step we should write the head of       */
+                      /*    the subroutine sub_loop_<subroutinename>          */
+                      writeheadnewsub_0(1);
+                   ;}
+    break;
+
+  case 33:
+#line 449 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (6)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(3) - (6)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
+                         strcpy(DeclType,"");
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (6)].l));
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1((yyvsp[(3) - (6)].nac));
+                            writeheadnewsub_0(2);
+                      }
+                   ;}
+    break;
+
+  case 34:
+#line 482 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(3) - (4)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(3) - (4)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                         strcpy(DeclType,"");
+                         Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1((yyvsp[(3) - (4)].nac));
+                            writeheadnewsub_0(2);
+                      }
+                   ;}
+    break;
+
+  case 35:
+#line 516 "fortran.y"
+    {
+                      GlobalDeclaration = 0;
+                      strcpy(curmodulename,(yyvsp[(2) - (2)].nac));
+                      strcpy(subroutinename,"");
+                      Add_NameOfModule_1((yyvsp[(2) - (2)].nac));
+                      if ( inmoduledeclare == 0 )
+                      {
+                         /* To know if there are in the module declaration    */
+                         inmoduledeclare = 1;
+                         /* to know if a module has been met                  */
+                         inmodulemeet = 1;
+                         /* to know if we are after the keyword contains      */
+                         aftercontainsdeclare = 0 ;
+                      }
+                   ;}
+    break;
+
+  case 36:
+#line 533 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));strcpy(subroutinename,(yyvsp[(1) - (1)].nac));
+                      }
+                   ;}
+    break;
+
+  case 38:
+#line 542 "fortran.y"
+    {
+                      pos_curinclude = setposcur()-9;
+                   ;}
+    break;
+
+  case 39:
+#line 546 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Include_1((yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 40:
+#line 550 "fortran.y"
+    {
+                      if ( firstpass == 1 && couldaddvariable == 1) (yyval.l)=NULL;
+                   ;}
+    break;
+
+  case 41:
+#line 553 "fortran.y"
+    {
+                      if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=NULL;
+                   ;}
+    break;
+
+  case 42:
+#line 557 "fortran.y"
+    {
+                       if ( firstpass == 1 && couldaddvariable == 1 ) (yyval.l)=(yyvsp[(2) - (3)].l);
+                   ;}
+    break;
+
+  case 45:
+#line 564 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l));
+                      }
+                   ;}
+    break;
+
+  case 46:
+#line 571 "fortran.y"
+    {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");
+                         curvar=createvar((yyvsp[(1) - (1)].na),NULL);
+                        strcpy(nameinttypename,nameinttypenameback);
+                         curlistvar=insertvar(NULL,curvar);
+                         (yyval.l)=settype("",curlistvar);
+                      }
+                   ;}
+    break;
+
+  case 47:
+#line 583 "fortran.y"
+    {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");                      
+                         curvar=createvar((yyvsp[(3) - (3)].na),NULL);
+                         strcpy(nameinttypename,nameinttypenameback);                         
+                         (yyval.l)=insertvar((yyvsp[(1) - (3)].l),curvar);
+                      }
+                   ;}
+    break;
+
+  case 48:
+#line 594 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 49:
+#line 595 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),"*");;}
+    break;
+
+  case 50:
+#line 598 "fortran.y"
+    {
+                      if ( VarTypepar == 1 )
+                      {
+                         couldaddvariable = 1 ;
+                         VarTypepar = 0;
+                      }
+                   ;}
+    break;
+
+  case 51:
+#line 606 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         VarType = 1;
+                         couldaddvariable = 0 ;
+                      }
+                   ;}
+    break;
+
+  case 52:
+#line 614 "fortran.y"
+    {
+                      if ( VarType == 1 ) couldaddvariable = 1 ;
+                      VarType = 0;
+                      VarTypepar = 0;
+                   ;}
+    break;
+
+  case 54:
+#line 621 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if ( insubroutinedeclare == 0 )
+                         {
+                                                  Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                                                  }
+                         else Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                         pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   ;}
+    break;
+
+  case 55:
+#line 636 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 )
+                     {
+                        if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                         else Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   ;}
+    break;
+
+  case 57:
+#line 650 "fortran.y"
+    {
+                     pos_end = setposcur();
+                     RemoveWordSET_0(fortranout,pos_cursave,
+                                                pos_end-pos_cursave);
+                  ;}
+    break;
+
+  case 59:
+#line 657 "fortran.y"
+    {
+                   /* if the variable is a parameter we can suppose that is   */
+                   /*    value is the same on each grid. It is not useless to */
+                   /*    create a copy of it on each grid                     */
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_Globliste_1((yyvsp[(1) - (1)].l));
+                         /* if variableparamlists has been declared in a      */
+                         /*    subroutine                                     */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                         }
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curdimension,
+                                                pos_end-pos_curdimension);
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                   ;}
+    break;
+
+  case 60:
+#line 694 "fortran.y"
+    {
+      if (firstpass == 0)
+      {
+      if ((yyvsp[(1) - (1)].lnn))
+      {
+      removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+      pos_end = setposcur();
+           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
+      writelistpublic((yyvsp[(1) - (1)].lnn));
+      }
+      }
+      ;}
+    break;
+
+  case 70:
+#line 716 "fortran.y"
+    {
+                      /* we should remove the data declaration                */
+                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
+                      {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curdata,
+                                              pos_end-pos_curdata);
+                      }
+                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
+                      {
+                      if (firstpass == 0)
+                      {
+                        ReWriteDataStatement_0(fortranout);
+                        pos_end = setposcur();
+                  }
+                      }
+                  ;}
+    break;
+
+  case 72:
+#line 736 "fortran.y"
+    {
+         PublicDeclare = 0 ;
+         PrivateDeclare = 0 ;
+      ;}
+    break;
+
+  case 110:
+#line 787 "fortran.y"
+    {
+                      /* if the variable is a parameter we can suppose that is*/
+                      /*    value is the same on each grid. It is not useless */
+                      /*    to create a copy of it on each grid               */
+                      if ( couldaddvariable == 1 )
+                      {
+                      pos_end = setposcur();
+                      /*if (insubroutinedeclare == 0)
+                        {   */
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                 pos_end-pos_cur_decl);
+                                         
+                       /* }
+                      else
+                       {*/
+                        ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                        pos_cur_decl = setposcur();
+                        
+                       /*}*/
+                      if ( firstpass == 0 &&
+                           GlobalDeclaration == 0 &&
+                           insubroutinedeclare == 0 )
+                      {
+
+                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
+                                                                ,curmodulename);
+                         tofich(fortranout,ligne,1);
+                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
+                         module_declar = associate(ligne);
+                         sprintf (ligne, " ");
+                         tofich (module_declar, ligne,1);
+                         GlobalDeclaration = 1 ;
+                         pos_cur_decl = setposcur();
+
+                      }
+                         (yyval.l) = (yyvsp[(1) - (2)].l);
+                         Add_Globliste_1((yyvsp[(1) - (2)].l));
+                                                  
+                         if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+                         else
+                         {
+                            if ( pointerdeclare == 1 )
+                                                Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                            Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                         }
+
+                         /* if variables has been declared in a subroutine    */
+                         if ( insubroutinedeclare == 1 )
+                         { 
+                       /*    Add_SubroutineDeclaration_Var_1($1);*/
+                         }
+                         /* If there are a SAVE declarations in module's      */
+                         /*    subroutines we should remove it from the       */
+                         /*    subroutines declaration and add it in the      */
+                         /*    global declarations                            */
+                         if ( aftercontainsdeclare == 1 &&
+                              SaveDeclare == 1 && firstpass == 1 )
+                         {
+                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                              else  Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                         }
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                      GlobalDeclarationType = 0; 
+                   ;}
+    break;
+
+  case 111:
+#line 871 "fortran.y"
+    {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,(yyvsp[(2) - (3)].nac));
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,(yyvsp[(2) - (3)].nac));
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                         Add_FunctionType_Var_1((yyvsp[(2) - (3)].nac));
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      strcpy(nameinttypename,"");
+
+                   ;}
+    break;
+
+  case 112:
+#line 908 "fortran.y"
+    {
+                       functiondeclarationisdone = 1;
+                   ;}
+    break;
+
+  case 113:
+#line 914 "fortran.y"
+    {
+                      VariableIsParameter = 1;
+                      pos_curparameter = setposcur()-9;
+                   ;}
+    break;
+
+  case 114:
+#line 919 "fortran.y"
+    {
+                      pos_curdata = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                      Init_List_Data_Var();
+                   ;}
+    break;
+
+  case 115:
+#line 924 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+/*                      sprintf(ligne,"%s",$3);*/
+                      createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+                      if (firstpass == 1)
+                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].nac),ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].nac),ligne);
+                      }
+                   ;}
+    break;
+
+  case 116:
+#line 938 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+                      /*sprintf(ligne,"%s",$5);   */
+                      createstringfromlistname(ligne,(yyvsp[(5) - (6)].lnn));                      
+                      if (firstpass == 1)                      
+                      Add_Data_Var_1(&List_Data_Var,(yyvsp[(3) - (6)].nac),ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(3) - (6)].nac),ligne);                      
+                      }
+                   ;}
+    break;
+
+  case 117:
+#line 952 "fortran.y"
+    {
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       if (firstpass == 1)
+                       Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+                       else
+                       Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+                   ;}
+    break;
+
+  case 118:
+#line 967 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0);
+                      }
+                   ;}
+    break;
+
+  case 119:
+#line 974 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);
+                      }
+                   ;}
+    break;
+
+  case 124:
+#line 988 "fortran.y"
+    {
+                     pos_cursave = setposcur()-4;
+                  ;}
+    break;
+
+  case 126:
+#line 994 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 ) Add_Save_Var_1((yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].d));
+                  ;}
+    break;
+
+  case 127:
+#line 999 "fortran.y"
+    {
+		(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
+		;}
+    break;
+
+  case 128:
+#line 1003 "fortran.y"
+    {
+      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
+      exit(0);
+      ;}
+    break;
+
+  case 129:
+#line 1008 "fortran.y"
+    {
+      (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn));
+      ;}
+    break;
+
+  case 130:
+#line 1013 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 131:
+#line 1015 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 132:
+#line 1017 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 133:
+#line 1019 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 134:
+#line 1021 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 135:
+#line 1024 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"");;}
+    break;
+
+  case 136:
+#line 1026 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 143:
+#line 1038 "fortran.y"
+    {
+	ininterfacedeclare = 1 ;
+	printf("INTEFACE entree\n");
+	;}
+    break;
+
+  case 144:
+#line 1043 "fortran.y"
+    {
+      ininterfacedeclare = 0;
+      ;}
+    break;
+
+  case 145:
+#line 1048 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curdimension = setposcur()-9;
+                   ;}
+    break;
+
+  case 146:
+#line 1054 "fortran.y"
+    {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar(NULL,curvar);
+            /*                                                                */
+            (yyval.l)=settype("",curlistvar);
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      ;}
+    break;
+
+  case 147:
+#line 1070 "fortran.y"
+    {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar((yyvsp[(3) - (5)].nac),(yyvsp[(4) - (5)].d));
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar((yyvsp[(1) - (5)].l),curvar);
+            /*                                                                */
+            (yyval.l)=curlistvar;
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      ;}
+    break;
+
+  case 150:
+#line 1090 "fortran.y"
+    {
+        (yyval.lnn)=(listname *)NULL;
+        ;}
+    break;
+
+  case 151:
+#line 1094 "fortran.y"
+    {
+          (yyval.lnn)=(yyvsp[(3) - (3)].lnn);
+         ;}
+    break;
+
+  case 152:
+#line 1099 "fortran.y"
+    {
+           (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].nac),0);
+           ;}
+    break;
+
+  case 153:
+#line 1103 "fortran.y"
+    {
+          (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].nac),0);
+          ;}
+    break;
+
+  case 154:
+#line 1108 "fortran.y"
+    {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcommon,
+                                                  pos_end-pos_curcommon);
+                   ;}
+    break;
+
+  case 155:
+#line 1114 "fortran.y"
+    {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].nac));
+                            Add_NameOfCommon_1((yyvsp[(2) - (3)].nac),subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   ;}
+    break;
+
+  case 156:
+#line 1125 "fortran.y"
+    {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].nac));
+                            Add_NameOfCommon_1((yyvsp[(3) - (5)].nac),subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   ;}
+    break;
+
+  case 157:
+#line 1137 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6;
+                   ;}
+    break;
+
+  case 158:
+#line 1142 "fortran.y"
+    {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6-7;
+                   ;}
+    break;
+
+  case 159:
+#line 1148 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   ;}
+    break;
+
+  case 160:
+#line 1153 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   ;}
+    break;
+
+  case 161:
+#line 1157 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         positioninblock = positioninblock + 1 ;
+                         strcpy(commonvar,(yyvsp[(1) - (2)].nac));
+                         commondim = (yyvsp[(2) - (2)].d);
+                      }
+                   ;}
+    break;
+
+  case 162:
+#line 1167 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),"");
+                         positioninblock=0;
+                         strcpy(commonblockname,"");
+                      }
+                   ;}
+    break;
+
+  case 163:
+#line 1176 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy((yyval.nac),(yyvsp[(2) - (3)].nac));
+                         positioninblock=0;
+                         strcpy(commonblockname,(yyvsp[(2) - (3)].nac));
+                      }
+                   ;}
+    break;
+
+  case 166:
+#line 1189 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));
+                   ;}
+    break;
+
+  case 167:
+#line 1193 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 ) (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));
+                   ;}
+    break;
+
+  case 168:
+#line 1198 "fortran.y"
+    {
+                     if ( couldaddvariable == 1 )
+                     {
+                         curvar=(variable *) malloc(sizeof(variable));
+                         /*                                                   */
+                         Init_Variable(curvar);
+                         /*                                                   */
+                         curvar->v_VariableIsParameter=1;
+                         strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].nac));
+                         Save_Length((yyvsp[(1) - (3)].nac),4);
+                         strcpy(curvar->v_subroutinename,subroutinename);
+                         Save_Length(subroutinename,11);
+                         strcpy(curvar->v_modulename,curmodulename);
+                         Save_Length(curmodulename,6);
+                         strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+                         Save_Length((yyvsp[(3) - (3)].na),14);
+                         strcpy(curvar->v_commoninfile,mainfile);
+                         Save_Length(mainfile,10);
+                         (yyval.v)=curvar;
+                      }
+                   ;}
+    break;
+
+  case 172:
+#line 1226 "fortran.y"
+    {
+                       if ( insubroutinedeclare == 1 )
+                       {
+                          Add_ImplicitNoneSubroutine_1();
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_end-13,
+                                                             13);
+                       }
+                    ;}
+    break;
+
+  case 175:
+#line 1240 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         /*                                                   */
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar((yyvsp[(3) - (6)].nac),curdim);
+                            GlobalDeclarationType == 0;
+                         }
+                         else
+                         {
+                            curvar=createvar((yyvsp[(3) - (6)].nac),(yyvsp[(4) - (6)].d));
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar(DeclType,curvar);
+                         /*                                                   */
+                         curlistvar=insertvar(NULL,curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         (yyval.l)=settype(DeclType,curlistvar);
+                      }
+                      strcpy(vallengspec,"");
+                   ;}
+    break;
+
+  case 176:
+#line 1273 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar((yyvsp[(4) - (7)].nac),curdim);
+                         }
+                         else
+                         {
+                            curvar=createvar((yyvsp[(4) - (7)].nac),(yyvsp[(5) - (7)].d));
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar((yyvsp[(1) - (7)].l)->var->v_typevar,curvar);
+                         /*                                                   */
+                         strcpy(curvar->v_typevar,((yyvsp[(1) - (7)].l)->var->v_typevar));
+                         Save_Length((yyvsp[(1) - (7)].l)->var->v_typevar,3);
+                         /*                                                   */
+                         curlistvar=insertvar((yyvsp[(1) - (7)].l),curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         (yyval.l)=curlistvar;
+                      }
+                      strcpy(vallengspec,"");
+                   ;}
+    break;
+
+  case 177:
+#line 1307 "fortran.y"
+    {dimsgiven=0;;}
+    break;
+
+  case 178:
+#line 1310 "fortran.y"
+    {strcpy(DeclType,(yyvsp[(1) - (2)].nac));;}
+    break;
+
+  case 179:
+#line 1312 "fortran.y"
+    {
+                      strcpy(DeclType,"CHARACTER");
+                   ;}
+    break;
+
+  case 180:
+#line 1316 "fortran.y"
+    {
+                      strcpy(DeclType,(yyvsp[(1) - (3)].nac));
+                      strcpy(nameinttypename,(yyvsp[(3) - (3)].nac));
+                   ;}
+    break;
+
+  case 181:
+#line 1321 "fortran.y"
+    {
+                      strcpy(DeclType,"TYPE");
+                      GlobalDeclarationType = 1
+                   ;}
+    break;
+
+  case 182:
+#line 1327 "fortran.y"
+    {
+                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
+                      couldaddvariable = 0 ;
+                      pos_cur_decl = setposcur()-5;*/
+                   pos_cur_decl = setposcur()-5;
+                   ;}
+    break;
+
+  case 184:
+#line 1336 "fortran.y"
+    {c_selectorgiven=1;strcpy(c_selectorname,(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 185:
+#line 1337 "fortran.y"
+    {c_star = 1;;}
+    break;
+
+  case 190:
+#line 1345 "fortran.y"
+    {
+                      pos_cur_decl = setposcur()-9;
+                   ;}
+    break;
+
+  case 191:
+#line 1349 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 192:
+#line 1352 "fortran.y"
+    {
+                      strcpy((yyval.nac),"INTEGER");
+                      pos_cur_decl = setposcur()-7;
+                   ;}
+    break;
+
+  case 193:
+#line 1356 "fortran.y"
+    {
+                      strcpy((yyval.nac),"REAL");
+                      pos_cur_decl = setposcur()-4;
+                   ;}
+    break;
+
+  case 194:
+#line 1361 "fortran.y"
+    {strcpy((yyval.nac),"COMPLEX");
+                   pos_cur_decl = setposcur()-7;;}
+    break;
+
+  case 195:
+#line 1364 "fortran.y"
+    {
+                      pos_cur_decl = setposcur()-16;
+                      strcpy((yyval.nac),"REAL");
+                      strcpy(nameinttypename,"8");
+                   ;}
+    break;
+
+  case 196:
+#line 1370 "fortran.y"
+    {strcpy((yyval.nac),"DOUBLE COMPLEX");;}
+    break;
+
+  case 197:
+#line 1372 "fortran.y"
+    {
+                      strcpy((yyval.nac),"LOGICAL");
+                      pos_cur_decl = setposcur()-7;
+                   ;}
+    break;
+
+  case 199:
+#line 1378 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 200:
+#line 1380 "fortran.y"
+    {sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 201:
+#line 1381 "fortran.y"
+    {strcpy((yyval.na),"*(*)");;}
+    break;
+
+  case 208:
+#line 1392 "fortran.y"
+    {
+                      if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+                      {
+                         strcpy(nameinttypename,"8");
+                         sprintf(NamePrecision,"");
+                      }
+                      else sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].nac),(yyvsp[(3) - (3)].na));
+                   ;}
+    break;
+
+  case 209:
+#line 1401 "fortran.y"
+    {
+                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 210:
+#line 1405 "fortran.y"
+    {
+                      strcpy(NamePrecision,(yyvsp[(1) - (1)].nac));
+                   ;}
+    break;
+
+  case 211:
+#line 1409 "fortran.y"
+    {strcpy(CharacterSize,(yyvsp[(1) - (1)].na));
+                    strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 212:
+#line 1411 "fortran.y"
+    {strcpy(CharacterSize,"*");
+                    strcpy((yyval.na),"*");;}
+    break;
+
+  case 220:
+#line 1425 "fortran.y"
+    {
+                      VariableIsParameter = 1;
+                   ;}
+    break;
+
+  case 222:
+#line 1430 "fortran.y"
+    {Allocatabledeclare = 1;;}
+    break;
+
+  case 223:
+#line 1432 "fortran.y"
+    {
+                      dimsgiven=1;
+                      curdim=(yyvsp[(2) - (2)].d);
+                   ;}
+    break;
+
+  case 224:
+#line 1437 "fortran.y"
+    {ExternalDeclare = 1;;}
+    break;
+
+  case 225:
+#line 1439 "fortran.y"
+    {strcpy(IntentSpec,(yyvsp[(3) - (4)].nac));;}
+    break;
+
+  case 227:
+#line 1441 "fortran.y"
+    {optionaldeclare = 1 ;;}
+    break;
+
+  case 228:
+#line 1442 "fortran.y"
+    {pointerdeclare = 1 ;;}
+    break;
+
+  case 229:
+#line 1443 "fortran.y"
+    {
+/*                       if ( inmodulemeet == 1 )
+                       {*/
+                          SaveDeclare = 1 ;
+                     /*  }*/
+                    ;}
+    break;
+
+  case 230:
+#line 1450 "fortran.y"
+    {Targetdeclare = 1;;}
+    break;
+
+  case 231:
+#line 1452 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 232:
+#line 1453 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 233:
+#line 1454 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac)); ;}
+    break;
+
+  case 234:
+#line 1457 "fortran.y"
+    {PublicDeclare = 1;;}
+    break;
+
+  case 235:
+#line 1459 "fortran.y"
+    {PrivateDeclare = 1;;}
+    break;
+
+  case 236:
+#line 1461 "fortran.y"
+    {if ( created_dimensionlist == 1 )
+                       {
+                           (yyval.d)=(listdim *)NULL;
+                       }
+                   ;}
+    break;
+
+  case 237:
+#line 1467 "fortran.y"
+    {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) (yyval.d)=(yyvsp[(2) - (3)].d);;}
+    break;
+
+  case 238:
+#line 1470 "fortran.y"
+    {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));;}
+    break;
+
+  case 239:
+#line 1473 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                         if ( created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));;}
+    break;
+
+  case 240:
+#line 1476 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"1");
+                      strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na));
+                      Save_Length((yyvsp[(1) - (1)].na),1);
+                   ;}
+    break;
+
+  case 241:
+#line 1481 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"");
+                      strcpy((yyval.dim1).last,"");
+                   ;}
+    break;
+
+  case 242:
+#line 1485 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));
+                      Save_Length((yyvsp[(1) - (2)].na),2);
+                      strcpy((yyval.dim1).last,"");
+                   ;}
+    break;
+
+  case 243:
+#line 1490 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,"");
+                      strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na));
+                      Save_Length((yyvsp[(2) - (2)].na),1);
+                   ;}
+    break;
+
+  case 244:
+#line 1496 "fortran.y"
+    {
+                      strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));
+                      Save_Length((yyvsp[(1) - (3)].na),2);
+                      strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na));
+                      Save_Length((yyvsp[(3) - (3)].na),1);
+                   ;}
+    break;
+
+  case 245:
+#line 1503 "fortran.y"
+    {strcpy((yyval.na),"*");;}
+    break;
+
+  case 246:
+#line 1504 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 247:
+#line 1506 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 248:
+#line 1508 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 249:
+#line 1510 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 250:
+#line 1512 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 251:
+#line 1516 "fortran.y"
+    {sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 252:
+#line 1518 "fortran.y"
+    {sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 253:
+#line 1520 "fortran.y"
+    {sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 254:
+#line 1522 "fortran.y"
+    {sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 255:
+#line 1524 "fortran.y"
+    {sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 256:
+#line 1526 "fortran.y"
+    {sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 257:
+#line 1528 "fortran.y"
+    {sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 258:
+#line 1530 "fortran.y"
+    {sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 259:
+#line 1532 "fortran.y"
+    {sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 260:
+#line 1534 "fortran.y"
+    {sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 261:
+#line 1536 "fortran.y"
+    {sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 262:
+#line 1538 "fortran.y"
+    {sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 263:
+#line 1540 "fortran.y"
+    {sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 264:
+#line 1542 "fortran.y"
+    {sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 265:
+#line 1544 "fortran.y"
+    {sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 266:
+#line 1546 "fortran.y"
+    {sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 267:
+#line 1548 "fortran.y"
+    {sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 268:
+#line 1550 "fortran.y"
+    {sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 269:
+#line 1552 "fortran.y"
+    {sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 270:
+#line 1554 "fortran.y"
+    {sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 271:
+#line 1556 "fortran.y"
+    {sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 272:
+#line 1558 "fortran.y"
+    {sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 273:
+#line 1560 "fortran.y"
+    {sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 274:
+#line 1562 "fortran.y"
+    {sprintf((yyval.na),"SIGN(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 275:
+#line 1564 "fortran.y"
+    {sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 276:
+#line 1566 "fortran.y"
+    {sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 277:
+#line 1568 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 278:
+#line 1570 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                   { strcpy((yyval.na),(yyvsp[(1) - (3)].na));strcat((yyval.na),",");strcat((yyval.na),(yyvsp[(3) - (3)].na));};}
+    break;
+
+  case 279:
+#line 1573 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 280:
+#line 1575 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 281:
+#line 1577 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 282:
+#line 1579 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 283:
+#line 1581 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 284:
+#line 1583 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 285:
+#line 1585 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"+");;}
+    break;
+
+  case 286:
+#line 1586 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),"-");;}
+    break;
+
+  case 287:
+#line 1589 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 288:
+#line 1591 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 289:
+#line 1593 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 290:
+#line 1595 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 291:
+#line 1597 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 292:
+#line 1599 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 293:
+#line 1601 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 294:
+#line 1603 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 295:
+#line 1605 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 296:
+#line 1607 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 297:
+#line 1609 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 298:
+#line 1611 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 299:
+#line 1613 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 300:
+#line 1615 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 301:
+#line 1617 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 302:
+#line 1619 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 303:
+#line 1621 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 304:
+#line 1623 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 305:
+#line 1625 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 306:
+#line 1627 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 307:
+#line 1629 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 308:
+#line 1631 "fortran.y"
+    {strcpy((yyval.na),"");;}
+    break;
+
+  case 309:
+#line 1633 "fortran.y"
+    {sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 310:
+#line 1635 "fortran.y"
+    {sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 311:
+#line 1637 "fortran.y"
+    {sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 312:
+#line 1640 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 313:
+#line 1642 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 314:
+#line 1645 "fortran.y"
+    {if ( couldaddvariable == 1 )
+						{
+						printf("ident = %s\n",(yyvsp[(1) - (1)].nac));
+						strcpy((yyval.na),(yyvsp[(1) - (1)].nac));}
+						;}
+    break;
+
+  case 315:
+#line 1651 "fortran.y"
+    {if ( couldaddvariable == 1 ) {
+                   printf("struct = %s\n",(yyvsp[(1) - (1)].na));
+                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+                   ;}
+    break;
+
+  case 316:
+#line 1656 "fortran.y"
+    {if ( couldaddvariable == 1 ) {
+                   printf("arrayref = %s\n",(yyvsp[(1) - (1)].na));
+                   strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+                   };}
+    break;
+
+  case 317:
+#line 1661 "fortran.y"
+    {
+                      agrif_parentcall =0;
+                      if (!strcasecmp(identcopy,"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
+                      {
+                         inagrifcallargument = 1;
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                      }
+                   ;}
+    break;
+
+  case 318:
+#line 1674 "fortran.y"
+    {
+                     strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   ;}
+    break;
+
+  case 319:
+#line 1679 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 320:
+#line 1681 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                                sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 321:
+#line 1684 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                         sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 322:
+#line 1688 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                         sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].nac),(yyvsp[(3) - (4)].na));
+                         ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+                         agrif_parentcall =0;
+                      }
+                   ;}
+    break;
+
+  case 323:
+#line 1698 "fortran.y"
+    {
+                      sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   ;}
+    break;
+
+  case 324:
+#line 1704 "fortran.y"
+    {sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 325:
+#line 1706 "fortran.y"
+    {strcpy((yyval.na)," ");;}
+    break;
+
+  case 326:
+#line 1708 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 327:
+#line 1710 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 328:
+#line 1712 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 329:
+#line 1714 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 330:
+#line 1715 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 331:
+#line 1718 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 332:
+#line 1720 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                               sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 333:
+#line 1723 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));;}
+    break;
+
+  case 334:
+#line 1724 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 335:
+#line 1725 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));;}
+    break;
+
+  case 336:
+#line 1726 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));;}
+    break;
+
+  case 337:
+#line 1727 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),":");;}
+    break;
+
+  case 338:
+#line 1729 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 && afterpercent == 0)
+                       {
+                       if ( Vartonumber((yyvsp[(1) - (1)].nac)) == 1 )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if (!strcasecmp((yyvsp[(1) - (1)].nac),"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                       if ( VariableIsNotFunction((yyvsp[(1) - (1)].nac)) == 0 )
+                       {
+                       printf("var = %s\n",(yyvsp[(1) - (1)].nac));
+                          if ( inagrifcallargument == 1 )
+                          {
+                             if ( !strcasecmp((yyvsp[(1) - (1)].nac),identcopy) )
+                             {
+                                strcpy(sameagrifname,identcopy);
+                                sameagrifargument = 1;
+                             }
+                          }
+                          strcpy(identcopy,(yyvsp[(1) - (1)].nac));
+                          pointedvar=0;
+                          strcpy(truename,(yyvsp[(1) - (1)].nac));
+                          if (variscoupled_0((yyvsp[(1) - (1)].nac))) strcpy(truename,getcoupledname_0((yyvsp[(1) - (1)].nac)));
+
+                          if ( VarIsNonGridDepend(truename) == 0 &&
+                               Variableshouldberemove(truename) == 0 )
+                          {                      
+                             if ( inagrifcallargument == 1 ||
+                                  varispointer_0(truename) == 1 )
+                             {
+                             printf("var2 = %s\n",(yyvsp[(1) - (1)].nac));
+                            if ((IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].nac)) == 1) || (inagrifcallargument == 1))
+                             {
+                              if (varistyped_0(truename) == 0)
+                                 {
+                                 ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].nac)));
+                                 }
+                                 }
+                             }
+                             printf("ici3\n");
+                             if ( inagrifcallargument != 1 ||
+                                  sameagrifargument ==1 )
+                                  {
+                                  printf("ici5 %s\n",truename);
+                                  Add_UsedInSubroutine_Var_1(truename);
+                          }
+                          }
+                          NotifyAgrifFunction_0(truename);
+                       }
+                       }
+                       else
+                       {
+                       afterpercent = 0;
+                    }
+                    ;}
+    break;
+
+  case 339:
+#line 1788 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".TRUE.");;}
+    break;
+
+  case 340:
+#line 1789 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),".FALSE.");;}
+    break;
+
+  case 341:
+#line 1790 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 342:
+#line 1791 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 343:
+#line 1792 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 344:
+#line 1793 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 345:
+#line 1795 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.nac),"%s%s",(yyvsp[(1) - (2)].nac),(yyvsp[(2) - (2)].nac));;}
+    break;
+
+  case 347:
+#line 1799 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 349:
+#line 1802 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 350:
+#line 1804 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 351:
+#line 1806 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 352:
+#line 1807 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 353:
+#line 1810 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 354:
+#line 1812 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 355:
+#line 1813 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 356:
+#line 1815 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na)," ");;}
+    break;
+
+  case 357:
+#line 1816 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 358:
+#line 1818 "fortran.y"
+    {   strcpy(InitialValueGiven," ");;}
+    break;
+
+  case 359:
+#line 1820 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
+                          strcpy(InitialValueGiven,"=");
+                       }
+                    ;}
+    break;
+
+  case 360:
+#line 1828 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,(yyvsp[(3) - (3)].na));
+                          strcpy(InitialValueGiven,"=>");
+                       }
+                    ;}
+    break;
+
+  case 361:
+#line 1836 "fortran.y"
+    {pos_curinit = setposcur();;}
+    break;
+
+  case 362:
+#line 1839 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 363:
+#line 1842 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuse_0((yyvsp[(2) - (2)].nac));
+                      }
+                      sprintf(charusemodule,"%s",(yyvsp[(2) - (2)].nac));
+                      Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].nac));
+
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    ;}
+    break;
+
+  case 364:
+#line 1862 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      if (insubroutinedeclare == 1)
+                      {
+                         Add_CouplePointed_Var_1((yyvsp[(2) - (4)].nac),(yyvsp[(4) - (4)].lc));
+                      }
+                      if ( firstpass == 1 )
+                      {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            coupletmp = (yyvsp[(4) - (4)].lc);
+                            strcpy(ligne,"");
+                            while ( coupletmp )
+                            {
+                               strcat(ligne,coupletmp->c_namevar);
+                               strcat(ligne," => ");
+                               strcat(ligne,coupletmp->c_namepointedvar);
+                               coupletmp = coupletmp->suiv;
+                               if ( coupletmp ) strcat(ligne,",");
+                            }
+                            sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].nac));
+                         }
+                         Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].nac));
+                      }
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    ;}
+    break;
+
+  case 365:
+#line 1896 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuseonly_0((yyvsp[(2) - (6)].nac));
+                      }
+                      sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
+                      Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
+
+                       if ( inmoduledeclare == 0 )
+                       {
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_curuse,
+                                                pos_end-pos_curuse);
+                       }
+                       }
+                    ;}
+    break;
+
+  case 366:
+#line 1916 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if variables has been declared in a subroutine      */
+                       if (insubroutinedeclare == 1)
+                       {
+                          Add_CouplePointed_Var_1((yyvsp[(2) - (6)].nac),(yyvsp[(6) - (6)].lc));
+                       }
+                       if ( firstpass == 1 )
+                       {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                             coupletmp = (yyvsp[(6) - (6)].lc);
+                             strcpy(ligne,"");
+                             while ( coupletmp )
+                             {
+                                strcat(ligne,coupletmp->c_namevar);
+                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
+                                                           strcat(ligne," => ");
+                                strcat(ligne,coupletmp->c_namepointedvar);
+                                coupletmp = coupletmp->suiv;
+                                if ( coupletmp ) strcat(ligne,",");
+                             }
+                             sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].nac));
+                          }
+                          Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].nac));
+                       }
+                       if ( firstpass == 0 )
+                       {
+                          if ( inmoduledeclare == 0 )
+                          {
+
+                            pos_end = setposcur();
+                             RemoveWordSET_0(fortranout,pos_curuse,
+                                                   pos_end-pos_curuse);
+                       if (oldfortranout) 
+                         variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].nac),oldfortranout,pos_curuseold);
+                        
+                          }
+                          else
+                          {
+
+                             /* if we are in the module declare and if the    */
+                             /* onlylist is a list of global variable         */
+                             variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].nac), fortranout,pos_curuse);
+                          }
+                       }
+                       }
+                    ;}
+    break;
+
+  case 367:
+#line 1967 "fortran.y"
+    {
+                      pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                     if (firstpass == 0 && oldfortranout) {
+                     pos_curuseold = setposcurname(oldfortranout);
+                     }
+                   ;}
+    break;
+
+  case 368:
+#line 1975 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 369:
+#line 1978 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
+                    ;}
+    break;
+
+  case 370:
+#line 1982 "fortran.y"
+    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
+                        }
+                    ;}
+    break;
+
+  case 371:
+#line 1992 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
+                       Save_Length((yyvsp[(1) - (3)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
+                       Save_Length((yyvsp[(3) - (3)].nac),22);
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                     ;}
+    break;
+
+  case 372:
+#line 2003 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 ) (yyval.lc) = (yyvsp[(1) - (1)].lc);
+                    ;}
+    break;
+
+  case 373:
+#line 2007 "fortran.y"
+    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+                        (yyval.lc) = (yyvsp[(3) - (3)].lc);
+                        }
+                    ;}
+    break;
+
+  case 374:
+#line 2017 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].nac));
+                       Save_Length((yyvsp[(1) - (3)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].nac));
+                       Save_Length((yyvsp[(3) - (3)].nac),22);
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                       pointedvar=1;
+                       Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].nac));
+                    ;}
+    break;
+
+  case 375:
+#line 2028 "fortran.y"
+    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].nac));
+                       Save_Length((yyvsp[(1) - (1)].nac),21);
+                       strcpy(coupletmp->c_namepointedvar,"");
+                       coupletmp->suiv = NULL;
+                       (yyval.lc) = coupletmp;
+                     ;}
+    break;
+
+  case 377:
+#line 2039 "fortran.y"
+    {
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 378:
+#line 2045 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                         curmodulename);
+                                                         inallocate = 0;
+                     ;}
+    break;
+
+  case 380:
+#line 2052 "fortran.y"
+    {
+                       GlobalDeclaration = 0 ;
+                       if ( firstpass == 0 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                          if ( module_declar && insubroutinedeclare == 0 )
+                          {
+                              fclose(module_declar);
+                          }
+                       }
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       if ( inmodulemeet == 1 )
+                       {
+                         /* we are in a module                                */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            /* it is like an end subroutine <name>            */
+                            insubroutinedeclare = 0 ;
+                            /*                                                */
+                            pos_cur = setposcur();
+                            closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                         }
+                         else
+                         {
+                            /* it is like an end module <name>                */
+                            inmoduledeclare = 0 ;
+                            inmodulemeet = 0 ;
+                         }
+                       }
+                       else
+                       {
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+                          pos_cur = setposcur();                        
+                          closeandcallsubloopandincludeit_0(2);
+                            functiondeclarationisdone = 0;
+                          if ( firstpass == 0 )
+                          {
+                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                             else fprintf(paramout,"C\n");
+                             fclose(paramout);
+                           }
+                        }
+                      }
+                      strcpy(subroutinename,"");
+                    ;}
+    break;
+
+  case 381:
+#line 2102 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();                      
+                       closeandcallsubloopandincludeit_0(3);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 382:
+#line 2120 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+                                             
+                       closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 383:
+#line 2140 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+
+                       closeandcallsubloopandincludeit_0(0);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    ;}
+    break;
+
+  case 384:
+#line 2159 "fortran.y"
+    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if we never meet the contains keyword               */
+                      Remove_Word_end_module_0(strlen((yyvsp[(2) - (2)].nac)));
+                       if ( inmoduledeclare == 1 )
+                       {
+                          if ( aftercontainsdeclare == 0 )
+                          {
+                             Write_GlobalParameter_Declaration_0();
+                             Write_NotGridDepend_Declaration_0();
+                             Write_GlobalType_Declaration_0();
+                             if ( module_declar_type )
+                             {
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                             Write_Alloc_Subroutine_For_End_0();
+                          }
+                       }
+                                           
+                       inmoduledeclare = 0 ;
+                       inmodulemeet = 0 ;
+
+                      Write_Word_end_module_0();
+                      strcpy(curmodulename,"");
+                      aftercontainsdeclare = 1;
+                      if ( firstpass == 0 )
+                      {
+                         if ( module_declar && insubroutinedeclare == 0)
+                         {
+                           fclose(module_declar);
+                         }
+                         if ( module_declar_type && insubroutinedeclare == 0)
+                         {
+                          fclose(module_declar_type);
+                          module_declar_type = 0;
+                         }
+                      }
+                      GlobalDeclaration = 0 ;
+                      }
+                  ;}
+    break;
+
+  case 398:
+#line 2217 "fortran.y"
+    {
+                      if (inmoduledeclare == 1 )
+                      {
+                         Remove_Word_Contains_0();
+                         Write_GlobalParameter_Declaration_0();
+                         Write_GlobalType_Declaration_0();
+                             if ( module_declar_type)
+                             {                         
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                         Write_NotGridDepend_Declaration_0();
+                         Write_Alloc_Subroutine_0();
+                         inmoduledeclare = 0 ;
+                         aftercontainsdeclare = 1;
+                      }
+                      else
+                      {
+                      incontainssubroutine = 1;
+                      strcpy(previoussubroutinename,subroutinename);
+                       if ( couldaddvariable == 1 )
+                       {
+                          if ( firstpass == 1 ) List_ContainsSubroutine =
+                                                Addtolistnom(subroutinename,
+                                                     List_ContainsSubroutine,0);
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+
+                          closeandcallsubloop_contains_0();
+                            functiondeclarationisdone = 0;
+                         if ( firstpass == 0 )
+                         {
+                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                            else fprintf(paramout,"C\n");
+                            fclose(paramout);
+                         }
+                         }
+                         strcpy(subroutinename,"");
+                      }
+                   ;}
+    break;
+
+  case 399:
+#line 2261 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       functiondeclarationisdone = 0;
+                       }
+                    ;}
+    break;
+
+  case 400:
+#line 2271 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 401:
+#line 2280 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 402:
+#line 2289 "fortran.y"
+    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));
+                       pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].nac));
+                       }
+                    ;}
+    break;
+
+  case 414:
+#line 2311 "fortran.y"
+    {strcpy((yyval.nac),"");;}
+    break;
+
+  case 415:
+#line 2312 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+  case 425:
+#line 2332 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 426:
+#line 2338 "fortran.y"
+    {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     ;}
+    break;
+
+  case 432:
+#line 2349 "fortran.y"
+    {if ( couldaddvariable == 1 ) created_dimensionlist = 0;;}
+    break;
+
+  case 433:
+#line 2351 "fortran.y"
+    {
+                  created_dimensionlist = 1;
+                  if  ( agrif_parentcall == 1 )
+                  {
+                      ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                      agrif_parentcall =0;
+                      fprintf(fortranout," = ");
+                  }
+              ;}
+    break;
+
+  case 434:
+#line 2361 "fortran.y"
+    {created_dimensionlist = 1;;}
+    break;
+
+  case 439:
+#line 2369 "fortran.y"
+    {
+                      inagrifcallargument = 0 ;
+                      incalldeclare=0;
+                      if ( oldfortranout &&
+                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
+                           firstpass == 0 &&
+                           callmpiinit == 1)
+                      {
+                      /*   pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
+                                                                   ,mpiinitvar);*/
+                      }
+                      if ( oldfortranout           &&
+                           callagrifinitgrids == 1 &&
+                           firstpass == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+
+                         strcpy(subofagrifinitgrids,subroutinename);
+                      }
+                      Instanciation_0(sameagrifname);
+                   ;}
+    break;
+
+  case 444:
+#line 2403 "fortran.y"
+    {
+                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"MPI_Init") )
+                       {
+                          callmpiinit = 1;
+                       }
+                       else
+                       {
+                          callmpiinit = 0;
+                       }
+                       if (!strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Init_Grids") )
+                       {
+                          callagrifinitgrids = 1;
+                          strcpy(meetagrifinitgrids,subroutinename);
+                       }
+                       else callagrifinitgrids = 0;
+                       if ( !strcasecmp((yyvsp[(2) - (2)].nac),"Agrif_Open_File") )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if ( Vartonumber((yyvsp[(2) - (2)].nac)) == 1 )
+                       {
+                          incalldeclare=1;
+                          inagrifcallargument = 1 ;
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                    ;}
+    break;
+
+  case 445:
+#line 2433 "fortran.y"
+    {pos_curcall=setposcur()-4;;}
+    break;
+
+  case 448:
+#line 2438 "fortran.y"
+    {
+                  if ( callmpiinit == 1 )
+                  {
+                     strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                     if ( firstpass == 1 )
+                     {
+                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
+/*                        curvar=createvar($1,NULL);
+                        curlistvar=insertvar(NULL,curvar);
+                        List_Subr outineArgument_Var = AddListvarToListvar
+                         (curlistvar,List_SubroutineAr gument_Var,1);*/
+                     }
+                  }
+               ;}
+    break;
+
+  case 520:
+#line 2562 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 521:
+#line 2563 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 522:
+#line 2564 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 523:
+#line 2567 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 524:
+#line 2569 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 525:
+#line 2571 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 526:
+#line 2573 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 527:
+#line 2575 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 528:
+#line 2577 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));;}
+    break;
+
+  case 529:
+#line 2578 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 530:
+#line 2579 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 531:
+#line 2582 "fortran.y"
+    {if ( couldaddvariable == 1 ) strcpy((yyval.na),(yyvsp[(1) - (1)].na));;}
+    break;
+
+  case 532:
+#line 2584 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na)," (%s)",(yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 533:
+#line 2586 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 534:
+#line 2588 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 535:
+#line 2590 "fortran.y"
+    {if ( couldaddvariable == 1 ) sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));;}
+    break;
+
+  case 536:
+#line 2594 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                              sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].nac),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));;}
+    break;
+
+  case 537:
+#line 2597 "fortran.y"
+    {if ( couldaddvariable == 1 )
+                                        sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].nac),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));;}
+    break;
+
+  case 544:
+#line 2613 "fortran.y"
+    {Add_Allocate_Var_1((yyvsp[(1) - (1)].nac),curmodulename);;}
+    break;
+
+  case 547:
+#line 2618 "fortran.y"
+    {Add_Allocate_Var_1((yyvsp[(1) - (4)].nac),curmodulename);;}
+    break;
+
+  case 555:
+#line 2641 "fortran.y"
+    {strcpy((yyval.nac),(yyvsp[(1) - (1)].nac));;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 6522 "fortran.tab.c"
+      default: break;
+    }
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+#line 2643 "fortran.y"
+
+
+void processfortran(char *fichier_entree)
+{
+   extern FILE *fortranin;
+   extern FILE *fortranout;
+   char nomfile[LONG_C];
+   int c;
+   int confirmyes;
+
+/*   fortrandebug = 1;*/
+   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
+/******************************************************************************/
+/*  1-  Open input and output files                                           */
+/******************************************************************************/
+   strcpy(nomfile,commondirin);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   fortranin=fopen( nomfile,"r");
+   if (! fortranin)
+   {
+      printf("Error : File %s does not exist\n",nomfile);
+      exit(1);
+   }
+
+   strcpy(curfile,nomfile);
+   strcpy(nomfile,commondirout);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   strcpy(nomfileoutput,nomfile);
+   Save_Length(nomfileoutput,31);
+   if (firstpass == 1)
+   {
+      if (checkexistcommon == 1)
+      {
+         if (fopen(nomfile,"r"))
+         {
+            printf("Warning : file %s already exist\n",nomfile);
+            confirmyes = 0;
+            while (confirmyes==0)
+            {
+               printf("Override file %s ? [Y/N]\n",nomfile);
+               c=getchar();
+               getchar();
+               if (c==79 || c==110)
+               {
+                  printf("We stop\n");
+                  exit(1);
+               }
+               if (c==89 || c==121)
+               {
+                  confirmyes=1;
+               }
+            }
+         }
+      }
+   }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+   line_num_fortran_common=1;
+   line_num_fortran=1;
+   PublicDeclare = 0;
+   PrivateDeclare = 0;
+   ExternalDeclare = 0;
+   SaveDeclare = 0;
+   pointerdeclare = 0;
+   optionaldeclare = 0;
+   incalldeclare = 0;
+   VarType = 0;
+   VarTypepar = 0;
+   Allocatabledeclare = 0 ;
+   Targetdeclare = 0 ;
+   strcpy(NamePrecision," ");
+   VariableIsParameter =  0 ;
+   strcpy(NamePrecision,"");
+   c_star = 0 ;
+   functiondeclarationisdone = 0;
+   insubroutinedeclare = 0 ;
+   ininterfacedeclare = 0 ;   
+   strcpy(subroutinename," ");
+   isrecursive = 0;
+   strcpy(InitialValueGiven," ");
+   strcpy(EmptyChar," ");
+   inmoduledeclare = 0;
+   incontainssubroutine = 0;
+   module_declar_type = 0;
+   GlobalDeclarationType = 0;
+   colnum=0;
+   incom=0;
+   couldaddvariable=1;
+   afterpercent = 0;
+   aftercontainsdeclare = 1;
+   strcpy(nameinttypename,"");
+   /* Name of the file without format                                         */
+   tmp = strchr(fichier_entree, '.');
+   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
+   Save_Length(curfilename,30);
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+   if (firstpass == 0 )
+   {
+      fortranout=fopen(nomfileoutput,"w");
+
+/*      NewModule_Creation_0();*/
+   }
+
+   fortranparse();
+
+   if (firstpass == 0 )
+   {
+   NewModule_Creation_0();
+   }
+   
+   strcpy(curfile,mainfile);
+
+   if (firstpass == 0 )
+   {
+   fclose(fortranout);
+   }
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y	(revision 3437)
@@ -0,0 +1,2766 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http ://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+%{
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+extern int line_num_fortran;
+extern int line_num_fortran_common;
+char *tmp;
+char c_selectorname[LONG_C];
+char ligne[LONG_C];
+char truename[LONGNOM];
+char identcopy[LONG_C];
+int c_selectorgiven=0;
+int incom;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+listdim *parcoursdim;
+int removeline=0;
+listvar *test;
+%}
+
+%union {
+       char      nac[LONG_C];
+       char      na[LONGNOM];
+       listdim  *d;
+       listvar  *l;
+       listnom  *ln;
+       listcouple  *lc;
+       listname *lnn;
+       typedim   dim1;
+       variable *v;
+       }
+
+%left ','
+%nonassoc ':'
+%right '='
+%left TOK_BINARY_OP
+%left TOK_EQV TOK_NEQV
+%left TOK_OR TOK_XOR
+%left TOK_AND
+%left TOK_NOT
+%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
+%nonassoc TOK_UNARY_OP
+%left TOK_DSLASH
+%left '+' '-'
+%left '*' TOK_SLASH
+%right TOK_DASTER
+
+%token TOK_SEP
+%token TOK_SEMICOLON
+%token TOK_NEXTLINE
+%token TOK_PARAMETER
+%token TOK_RESULT
+%token TOK_ONLY
+%token TOK_INCLUDE
+%token TOK_SUBROUTINE
+%token TOK_PROGRAM
+%token TOK_FUNCTION
+%token TOK_OMP
+%token TOK_DOLLAR
+%token TOK_FORMAT
+%token TOK_MAX
+%token TOK_TANH
+%token TOK_WHERE
+%token TOK_ELSEWHERE
+%token TOK_ENDWHERE
+%token TOK_MAXVAL
+%token TOK_TRIM
+%token TOK_SUM
+%token TOK_SQRT
+%token TOK_CASE
+%token TOK_SELECTCASE
+%token TOK_FILE
+%token TOK_END
+%token TOK_ERR
+%token TOK_DONOTTREAT
+%token TOK_ENDDONOTTREAT
+%token TOK_EXIST
+%token TOK_MIN
+%token TOK_FLOAT
+%token TOK_EXP
+%token TOK_COS
+%token TOK_COSH
+%token TOK_ACOS
+%token TOK_NINT
+%token TOK_CYCLE
+%token TOK_SIN
+%token TOK_SINH
+%token TOK_ASIN
+%token TOK_EQUIVALENCE
+%token TOK_BACKSPACE
+%token TOK_LOG
+%token TOK_TAN
+%token TOK_ATAN
+%token TOK_RECURSIVE
+%token TOK_ABS
+%token TOK_MOD
+%token TOK_SIGN
+%token TOK_MINLOC
+%token TOK_MAXLOC
+%token TOK_EXIT
+%token TOK_MINVAL
+%token TOK_PUBLIC
+%token TOK_PRIVATE
+%token TOK_ALLOCATABLE
+%token TOK_RETURN
+%token TOK_THEN
+%token TOK_ELSEIF
+%token TOK_ELSE
+%token TOK_ENDIF
+%token TOK_PRINT
+%token TOK_PLAINGOTO
+%token TOK_CONSTRUCTID
+%token TOK_LOGICALIF
+%token TOK_PLAINDO
+%token TOK_CONTAINS
+%token TOK_ENDDO
+%token TOK_MODULE
+%token TOK_ENDMODULE
+%token TOK_DOWHILE
+%token TOK_ALLOCATE
+%token TOK_OPEN
+%token TOK_CLOSE
+%token TOK_INQUIRE
+%token TOK_WRITE
+%token TOK_READ
+%token TOK_REWIND
+%token TOK_DEALLOCATE
+%token TOK_NULLIFY
+%token TOK_FIN
+%token TOK_DEBUT
+%token TOK_DIMENSION
+%token TOK_ENDSELECT
+%token TOK_EXTERNAL
+%token TOK_INTENT
+%token TOK_INTRINSIC
+%token TOK_NAMELIST
+%token TOK_CASEDEFAULT
+%token TOK_OPTIONAL
+%token TOK_POINTER
+%token TOK_CONTINUE
+%token TOK_SAVE
+%token TOK_TARGET
+%token TOK_QUOTE
+%token TOK_IMPLICIT
+%token TOK_NONE
+%token TOK_CALL
+%token TOK_STAT
+%token TOK_POINT_TO
+%token TOK_COMMON
+%token TOK_GLOBAL
+%token TOK_INTERFACE
+%token TOK_ENDINTERFACE
+%token TOK_LEFTAB
+%token TOK_RIGHTAB
+%token TOK_PAUSE
+%token TOK_PROCEDURE
+%token TOK_STOP
+%token TOK_NAMEEQ
+%token TOK_REAL8
+%token <nac> TOK_OUT
+%token <nac> TOK_INOUT
+%token <nac> TOK_IN
+%token <nac> TOK_USE
+%token <nac> TOK_DSLASH
+%token <nac> TOK_DASTER
+%token <nac> TOK_EQ
+%token <nac> TOK_EQV
+%token <nac> TOK_GT
+%token <nac> TOK_LT
+%token <nac> TOK_GE
+%token <nac> TOK_NE
+%token <nac> TOK_NEQV
+%token <nac> TOK_LE
+%token <nac> TOK_OR
+%token <nac> TOK_XOR
+%token <nac> TOK_NOT
+%token <nac> TOK_AND
+%token <nac> TOK_TRUE
+%token <nac> TOK_FALSE
+%token <nac> TOK_LABEL
+%token <nac> TOK_TYPE
+%token <nac> TOK_TYPEPAR
+%token <nac> TOK_ENDTYPE
+%token <nac> TOK_REAL
+%token <nac> TOK_INTEGER
+%token <nac> TOK_LOGICAL
+%token <nac> TOK_DOUBLEPRECISION
+%token <nac> TOK_DOUBLEREAL
+%token <nac> TOK_ENDSUBROUTINE
+%token <nac> TOK_ENDFUNCTION
+%token <nac> TOK_ENDPROGRAM
+%token <nac> TOK_ENDUNIT
+%token <nac> TOK_CHARACTER
+%token <nac> TOK_CHAR_CONSTANT
+%token <nac> TOK_CHAR_CUT
+%token <nac> TOK_DATA
+%token <nac> TOK_CHAR_INT
+%token <nac> TOK_CHAR_MESSAGE
+%token <nac> TOK_CSTREAL
+%token <nac> TOK_CSTREALDP
+%token <nac> TOK_CSTREALQP
+%token <nac> TOK_SFREAL
+%token <nac> TOK_COMPLEX
+%token <nac> TOK_DOUBLECOMPLEX
+%token <nac> TOK_NAME
+%token <nac> TOK_NAME_CHAR
+%token <nac> TOK_PROBTYPE  /* dimension of the problem                        */
+%token <nac> TOK_INTERPTYPE/* kind of interpolation                           */
+%token <nac> TOK_VARTYPE   /* posit ion of the grid variable on the cells of  */
+                          /*     the mesh                                     */
+%token <nac> TOK_SLASH
+%token <nac> TOK_BC        /* calculation of the boundary conditions           */
+%token <nac> TOK_OP
+%token <nac> TOK_CSTINT
+%token <nac> TOK_COMMENT
+%token <nac> TOK_FILENAME
+%token ','
+%token ':'
+%token '('
+%token ')'
+%token '['
+%token ']'
+%token '!'
+%token '_'
+%token '<'
+%token '>'
+%type <l> dcl
+%type <l> after_type
+%type <l> dimension
+%type <l> paramlist
+%type <l> args
+%type <l> arglist
+%type <lc> only_list
+%type <lc> only_name
+%type <lc> rename_list
+%type <lc> rename_name
+%type <d> dims
+%type <d> dimlist
+%type <dim1> dim
+%type <v> paramitem
+%type <nac> comblock
+%type <nac> name_routine
+%type <nac> module_name
+%type <nac> opt_name
+%type <nac> type
+%type <nac> word_endsubroutine
+%type <nac> word_endfunction
+%type <nac> word_endprogram
+%type <nac> word_endunit
+%type <nac> typename
+%type <nac> typespec
+%type <nac> string_constant
+%type <nac> simple_const
+%type <nac> ident
+%type <nac> do_var
+%type <nac> intent_spec
+%type <nac> signe
+%type <nac> opt_signe
+%type <nac> filename
+%type <nac> attribute
+%type <na> complex_const
+%type <na> begin_array
+%type <na> clause
+%type <na> arg
+%type <na> uexpr
+%type <na> minmaxlist
+%type <na> lhs
+%type <na> vec
+%type <na> outlist
+%type <na> out2
+%type <na> other
+%type <na> dospec
+%type <na> expr_data
+%type <na> structure_component
+%type <na> array_ele_substring_func_ref
+%type <na> funarglist
+%type <na> funarg
+%type <na> funargs
+%type <na> triplet
+%type <na> substring
+%type <na> opt_substring
+%type <na> opt_expr
+%type <na> optexpr
+%type <lnn> datavallist
+%type <lnn> datanamelist
+%type <na> after_slash
+%type <na> after_equal
+%type <na> predefinedfunction
+%type <na> expr
+%type <na> ubound
+%type <na> operation
+%type <na> proper_lengspec
+%type <lnn> use_name_list
+%type <lnn> public
+
+%left TOK_OP
+%%
+input :
+      | input line
+      ;
+line :  '\n' position
+      | thislabel suite_line_list
+      | TOK_COMMENT
+      | keyword cmnt writedeclar
+      | error writedeclar nulcurbuf
+                   {yyerrok;yyclearin;}
+      ;
+suite_line_list : suite_line
+      |   suite_line_list TOK_SEMICOLON suite_line
+      ;
+suite_line : entry fin_line  /* subroutine, function, module                    */
+      | spec fin_line      /* declaration                                     */
+      | before_include filename fin_line
+                  {
+                     if (inmoduledeclare == 0 )
+                     {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curinclude,
+                                              pos_end-pos_curinclude);
+                     }
+                  }
+      | exec cmnt writedeclar /* if, do etc ...                               */
+      | instr fin_line    /* instruction ident  : do i = 1 ...                */
+      ;
+instr : ident ':'
+      ;
+fin_line : position cmnt
+      ;
+keyword : TOK_DONOTTREAT
+         {
+            /* we should ignore the declaration until the keyword             */
+            /*    TOK_ENDDONOTTREAT                                           */
+            couldaddvariable = 0 ;
+            RemoveWordCUR_0(fortranout,-20,20);
+         }
+      | TOK_ENDDONOTTREAT
+         {
+             couldaddvariable = 1 ;
+             RemoveWordCUR_0(fortranout,-24,24);
+          }
+      | TOK_OMP
+      | TOK_DOLLAR
+      ;
+position : {pos_cur = setposcur();}
+      ;
+thislabel :
+      | TOK_LABEL nulcurbuf
+      ;
+cmnt :
+      | TOK_COMMENT
+      ;
+incomment :
+                   {incom = 1;}
+      ;
+nulcurbuf :
+                   {if (incom !=1) {strcpy(curbuf,"");incom=0;}}
+      ;
+opt_recursive :
+		{isrecursive = 0;}
+      | TOK_RECURSIVE
+		{isrecursive = 1;}
+      ;
+entry :
+      | opt_recursive TOK_SUBROUTINE name_routine arglist
+                   {
+                      if ( couldaddvariable == 1)
+                      {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      Add_SubroutineArgument_Var_1($4);
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(1);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            writeheadnewsub_0(1);
+                      }
+                      }
+                   }
+      | TOK_PROGRAM name_routine
+                   {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+
+                      }
+                      strcpy(subroutinename,$2);
+                      /* Common case                                          */
+                      insubroutinedeclare = 1;
+                      /* in the second step we should write the head of       */
+                      /*    the subroutine sub_loop_<subroutinename>          */
+                      writeheadnewsub_0(1);
+                   }
+      | opt_recursive TOK_FUNCTION name_routine arglist TOK_RESULT arglist1
+                   {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,$3);
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1($4);
+                         strcpy(DeclType,"");
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1($4);
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1($3);
+                            writeheadnewsub_0(2);
+                      }
+                   }
+      | opt_recursive TOK_FUNCTION name_routine arglist
+                   {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3);
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,$3);
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1($4);
+                         strcpy(DeclType,"");
+                         Add_FunctionType_Var_1($3);
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                            insubroutinedeclare = 1;
+                            /* we should to list of the subroutine argument   */
+                            /* name of the function which has to be defined   */
+                            Add_SubroutineArgument_Var_1($4);
+                            strcpy(DeclType,"");
+                            Add_FunctionType_Var_1($3);
+                            writeheadnewsub_0(2);
+                      }
+                   }
+      | TOK_MODULE TOK_NAME
+                   {
+                      GlobalDeclaration = 0;
+                      strcpy(curmodulename,$2);
+                      strcpy(subroutinename,"");
+                      Add_NameOfModule_1($2);
+                      if ( inmoduledeclare == 0 )
+                      {
+                         /* To know if there are in the module declaration    */
+                         inmoduledeclare = 1;
+                         /* to know if a module has been met                  */
+                         inmodulemeet = 1;
+                         /* to know if we are after the keyword contains      */
+                         aftercontainsdeclare = 0 ;
+                      }
+                   }
+      ;
+name_routine : TOK_NAME
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy($$,$1);strcpy(subroutinename,$1);
+                      }
+                   }
+writedeclar :
+      ;
+before_include : TOK_INCLUDE
+                   {
+                      pos_curinclude = setposcur()-9;
+                   }
+filename : TOK_CHAR_CONSTANT
+                   {
+                      if ( couldaddvariable == 1 ) Add_Include_1($1);
+                   }
+      ;
+arglist :           {
+                      if ( firstpass == 1 && couldaddvariable == 1) $$=NULL;
+                   }
+      | '(' ')'    {
+                      if ( firstpass == 1 && couldaddvariable == 1 ) $$=NULL;
+                   }
+      | '(' args ')'
+                   {
+                       if ( firstpass == 1 && couldaddvariable == 1 ) $$=$2;
+                   }
+      ;
+arglist1:
+      | '(' ')'
+      | '(' args ')'
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_SubroutineArgument_Var_1($2);
+                      }
+                   }
+      ;
+args :arg           {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");
+                         curvar=createvar($1,NULL);
+                        strcpy(nameinttypename,nameinttypenameback);
+                         curlistvar=insertvar(NULL,curvar);
+                         $$=settype("",curlistvar);
+                      }
+                   }
+      | args ',' arg
+                   {
+                      if ( firstpass == 1  && couldaddvariable == 1)
+                      {
+                         strcpy(nameinttypenameback,nameinttypename);
+                         strcpy(nameinttypename,"");                      
+                         curvar=createvar($3,NULL);
+                         strcpy(nameinttypename,nameinttypenameback);                         
+                         $$=insertvar($1,curvar);
+                      }
+                   }
+      ;
+arg : TOK_NAME      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | '*'        {if ( couldaddvariable == 1 ) strcpy($$,"*");}
+      ;
+spec : type after_type
+                   {
+                      if ( VarTypepar == 1 )
+                      {
+                         couldaddvariable = 1 ;
+                         VarTypepar = 0;
+                      }
+                   }
+      | TOK_TYPE opt_spec opt_sep opt_name
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         VarType = 1;
+                         couldaddvariable = 0 ;
+                      }
+                   }
+      | TOK_ENDTYPE opt_name
+                   {
+                      if ( VarType == 1 ) couldaddvariable = 1 ;
+                      VarType = 0;
+                      VarTypepar = 0;
+                   }
+      | TOK_POINTER list_couple
+      | before_parameter  '(' paramlist ')'
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if ( insubroutinedeclare == 0 )
+                         {
+                                                  Add_GlobalParameter_Var_1($3);
+                                                  }
+                         else Add_Parameter_Var_1($3);
+                         pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   }
+      | before_parameter  paramlist
+                   {
+                     if ( couldaddvariable == 1 )
+                     {
+                        if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1($2);
+                         else Add_Parameter_Var_1($2);
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                    pos_end-pos_cur_decl);
+                      }
+                      VariableIsParameter =  0 ;
+                   }
+      | common
+      | save
+                  {
+                     pos_end = setposcur();
+                     RemoveWordSET_0(fortranout,pos_cursave,
+                                                pos_end-pos_cursave);
+                  }
+      | implicit
+      | dimension
+                  {
+                   /* if the variable is a parameter we can suppose that is   */
+                   /*    value is the same on each grid. It is not useless to */
+                   /*    create a copy of it on each grid                     */
+                      if ( couldaddvariable == 1 )
+                      {
+                         Add_Globliste_1($1);
+                         /* if variableparamlists has been declared in a      */
+                         /*    subroutine                                     */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            Add_Dimension_Var_1($1);
+                         }
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curdimension,
+                                                pos_end-pos_curdimension);
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                   }
+      | public
+      {
+      if (firstpass == 0)
+      {
+      if ($1)
+      {
+      removeglobfromlist(&($1));
+      pos_end = setposcur();
+           RemoveWordSET_0(fortranout,pos_cur,pos_end-pos_cur);
+      writelistpublic($1);
+      }
+      }
+      }
+      | private
+      | use_stat
+      | module_proc_stmt
+      | interface
+      | namelist
+      | TOK_BACKSPACE '(' expr ')'
+      | TOK_EXTERNAL opt_sep use_name_list
+      | TOK_INTRINSIC opt_sep use_intrinsic_list
+      | TOK_EQUIVALENCE list_expr_equi
+      | before_data data '\n'
+                   {
+                      /* we should remove the data declaration                */
+                      if ( couldaddvariable == 1 && aftercontainsdeclare != 2 )
+                      {
+                        pos_end = setposcur();
+                        RemoveWordSET_0(fortranout,pos_curdata,
+                                              pos_end-pos_curdata);
+                      }
+                      if ( couldaddvariable == 1 && aftercontainsdeclare == 1 )
+                      {
+                      if (firstpass == 0)
+                      {
+                        ReWriteDataStatement_0(fortranout);
+                        pos_end = setposcur();
+                  }
+                      }
+                  }
+      ;
+opt_spec :
+      | access_spec
+      {
+         PublicDeclare = 0 ;
+         PrivateDeclare = 0 ;
+      }
+      ;
+name_intrinsic : TOK_SUM
+      | TOK_TANH
+      | TOK_MAXVAL
+      | TOK_MIN
+      | TOK_MINVAL
+      | TOK_TRIM
+      | TOK_SQRT
+      | TOK_NINT
+      | TOK_FLOAT
+      | TOK_EXP
+      | TOK_COS
+      | TOK_COSH
+      | TOK_ACOS
+      | TOK_SIN
+      | TOK_SINH
+      | TOK_ASIN
+      | TOK_LOG
+      | TOK_TAN
+      | TOK_ATAN
+      | TOK_MOD
+      | TOK_SIGN
+      | TOK_MINLOC
+      | TOK_MAXLOC
+      | TOK_NAME
+      ;
+use_intrinsic_list : name_intrinsic
+      | use_intrinsic_list ',' name_intrinsic
+      ;
+list_couple : '(' list_expr ')'
+      | list_couple ',' '(' list_expr ')'
+      ;
+list_expr_equi : expr_equi
+      | list_expr_equi ',' expr_equi
+      ;
+expr_equi : '(' list_expr_equi1 ')'
+      ;
+list_expr_equi1 : ident dims
+      | list_expr_equi1 ',' ident dims
+      ;
+list_expr : expr
+      | list_expr ',' expr
+      ;
+opt_sep :
+      | ':' ':'
+      ;
+after_type : dcl nodimsgiven
+                   {
+                      /* if the variable is a parameter we can suppose that is*/
+                      /*    value is the same on each grid. It is not useless */
+                      /*    to create a copy of it on each grid               */
+                      if ( couldaddvariable == 1 )
+                      {
+                      pos_end = setposcur();
+                      /*if (insubroutinedeclare == 0)
+                        {   */
+                         RemoveWordSET_0(fortranout,pos_cur_decl,
+                                                 pos_end-pos_cur_decl);
+                                         
+                       /* }
+                      else
+                       {*/
+                        ReWriteDeclarationAndAddTosubroutine_01($1);
+                        pos_cur_decl = setposcur();
+                        
+                       /*}*/
+                      if ( firstpass == 0 &&
+                           GlobalDeclaration == 0 &&
+                           insubroutinedeclare == 0 )
+                      {
+
+                         sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n"
+                                                                ,curmodulename);
+                         tofich(fortranout,ligne,1);
+                         sprintf (ligne, "Module_Declar_%s.h",curmodulename);
+                         module_declar = associate(ligne);
+                         sprintf (ligne, " ");
+                         tofich (module_declar, ligne,1);
+                         GlobalDeclaration = 1 ;
+                         pos_cur_decl = setposcur();
+
+                      }
+                         $$ = $1;
+                         Add_Globliste_1($1);
+                                                  
+                         if ( insubroutinedeclare == 0 )
+                                                  Add_GlobalParameter_Var_1($1);
+                         else
+                         {
+                            if ( pointerdeclare == 1 )
+                                                Add_Pointer_Var_From_List_1($1);
+                            Add_Parameter_Var_1($1);
+                         }
+
+                         /* if variables has been declared in a subroutine    */
+                         if ( insubroutinedeclare == 1 )
+                         { 
+                       /*    Add_SubroutineDeclaration_Var_1($1);*/
+                         }
+                         /* If there are a SAVE declarations in module's      */
+                         /*    subroutines we should remove it from the       */
+                         /*    subroutines declaration and add it in the      */
+                         /*    global declarations                            */
+                         if ( aftercontainsdeclare == 1 &&
+                              SaveDeclare == 1 && firstpass == 1 )
+                         {
+                              if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1($1);
+                              else  Add_SubroutineDeclarationSave_Var_1($1);
+                         }
+                      }
+                      /*                                                      */
+                      PublicDeclare = 0;
+                      PrivateDeclare = 0;
+                      ExternalDeclare = 0;
+                      strcpy(NamePrecision,"");
+                      c_star = 0;
+                      strcpy(InitialValueGiven," ");
+                      strcpy(IntentSpec,"");
+                      VariableIsParameter =  0 ;
+                      Allocatabledeclare = 0 ;
+                      Targetdeclare = 0 ;
+                      SaveDeclare = 0;
+                      pointerdeclare = 0;
+                      optionaldeclare = 0 ;
+                      dimsgiven=0;
+                      c_selectorgiven=0;
+                      strcpy(nameinttypename,"");
+                      strcpy(c_selectorname,"");
+                      GlobalDeclarationType = 0; 
+                   }
+      | before_function name_routine arglist
+                   {
+                      /* open param file                                      */
+                      if ( firstpass == 0 )
+                      {
+                         sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2);
+                         paramout=fopen(ligne,"w");
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                      }
+                      strcpy(subroutinename,$2);
+                      if ( inmodulemeet == 1 )
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1($3);
+                         Add_FunctionType_Var_1($2);
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      else
+                      {
+                         insubroutinedeclare = 1;
+                         /* we should to list of the subroutine argument the  */
+                         /*    name of the function which has to be defined   */
+                         Add_SubroutineArgument_Var_1($3);
+                         Add_FunctionType_Var_1($2);
+                         /* in the second step we should write the head of    */
+                         /*    the subroutine sub_loop_<subroutinename>       */
+                         writeheadnewsub_0(2);
+                      }
+                      strcpy(nameinttypename,"");
+
+                   }
+      ;
+before_function : TOK_FUNCTION
+                   {
+                       functiondeclarationisdone = 1;
+                   }
+                   ;
+
+before_parameter : TOK_PARAMETER
+                   {
+                      VariableIsParameter = 1;
+                      pos_curparameter = setposcur()-9;
+                   }
+before_data : TOK_DATA
+                   {
+                      pos_curdata = setposcur()-strlen($1);
+                      Init_List_Data_Var();
+                   }
+data : TOK_NAME TOK_SLASH datavallist TOK_SLASH
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+/*                      if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+/*                      sprintf(ligne,"%s",$3);*/
+                      createstringfromlistname(ligne,$3);
+                      if (firstpass == 1)
+                      Add_Data_Var_1(&List_Data_Var,$1,ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
+                      }
+                   }
+      | data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /*if ( aftercontainsdeclare == 1 ) strcpy(ligne,"");
+                      else */
+                      /*sprintf(ligne,"%s",$5);   */
+                      createstringfromlistname(ligne,$5);                      
+                      if (firstpass == 1)                      
+                      Add_Data_Var_1(&List_Data_Var,$3,ligne);
+                      else
+                      Add_Data_Var_1(&List_Data_Var_Cur,$3,ligne);                      
+                      }
+                   }
+      | datanamelist TOK_SLASH datavallist TOK_SLASH
+                   {
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       /*******************************************************/
+                       if (firstpass == 1)
+                       Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
+                       else
+                       Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
+                   }
+      ;
+datavallist : expr_data
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         $$ = Insertname(NULL,$1,0);
+                      }
+                   }
+      | expr_data ',' datavallist
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         $$ = Insertname($3,$1,1);
+                      }
+                   }
+      ;
+
+save :  before_save varsave
+      | before_save  comblock varsave
+      | save opt_comma comblock opt_comma varsave
+      | save ',' varsave
+      ;
+before_save : TOK_SAVE
+                  {
+                     pos_cursave = setposcur()-4;
+                  }
+      ;
+varsave :
+      | TOK_NAME dims
+                  {
+                     if ( couldaddvariable == 1 ) Add_Save_Var_1($1,$2);
+                  }
+      ;
+datanamelist : TOK_NAME
+		{
+		$$=Insertname(NULL,$1,0);
+		}
+      | TOK_NAME '(' expr ')'
+      {
+      printf("INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n");
+      exit(0);
+      }
+      | datanamelist ',' datanamelist
+      {
+      $$ = concat_listname($1,$3);
+      }
+      ;
+expr_data : opt_signe simple_const
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      | expr_data '+' expr_data
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s+%s",$1,$3);}
+      | expr_data '-' expr_data
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s-%s",$1,$3);}
+      | expr_data '*' expr_data
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s*%s",$1,$3);}
+      | expr_data '/' expr_data
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s/%s",$1,$3);}
+      ;
+opt_signe :
+                   {if ( couldaddvariable == 1 ) strcpy($$,"");}
+      | signe
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+namelist :  namelist_action after_namelist
+      ;
+namelist_action : TOK_NAMELIST  ident
+      | TOK_NAMELIST  comblock ident
+      | namelist_action opt_comma comblock opt_comma ident
+      | namelist_action ',' ident
+      ;
+after_namelist :
+      ;
+interface : TOK_INTERFACE opt_name
+	{
+	ininterfacedeclare = 1 ;
+	printf("INTEFACE entree\n");
+	}
+      | TOK_ENDINTERFACE opt_name
+      {
+      ininterfacedeclare = 0;
+      }
+      ;
+before_dimension : TOK_DIMENSION
+                   {
+                      positioninblock=0;
+                      pos_curdimension = setposcur()-9;
+                   }
+
+dimension :  before_dimension opt_comma TOK_NAME dims lengspec
+      {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar($3,$4);
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar(NULL,curvar);
+            /*                                                                */
+            $$=settype("",curlistvar);
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      }
+      | dimension ',' TOK_NAME dims lengspec
+      {
+         if ( couldaddvariable == 1 )
+         {
+            /*                                                                */
+            curvar=createvar($3,$4);
+            /*                                                                */
+            CreateAndFillin_Curvar("",curvar);
+            /*                                                                */
+            curlistvar=insertvar($1,curvar);
+            /*                                                                */
+            $$=curlistvar;
+            /*                                                                */
+            strcpy(vallengspec,"");
+         }
+      }
+      ;
+private : TOK_PRIVATE '\n'
+      | TOK_PRIVATE opt_sep use_name_list
+      ;
+public : TOK_PUBLIC '\n'
+        {
+        $$=(listname *)NULL;
+        }
+      | TOK_PUBLIC opt_sep use_name_list
+         {
+          $$=$3;
+         }
+      ;
+use_name_list : TOK_NAME
+           {
+           $$ = Insertname(NULL,$1,0);
+           }
+      | use_name_list ',' TOK_NAME
+          {
+          $$ = Insertname($1,$3,0);
+          }
+      ;
+common : before_common var_common_list
+                   {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcommon,
+                                                  pos_end-pos_curcommon);
+                   }
+      | before_common comblock var_common_list
+                   {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",$2);
+                            Add_NameOfCommon_1($2,subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   }
+      | common opt_comma comblock opt_comma var_common_list
+                   {
+                         if ( couldaddvariable == 1 )
+                         {
+                            sprintf(charusemodule,"%s",$3);
+                            Add_NameOfCommon_1($3,subroutinename);
+                            pos_end = setposcur();
+                            RemoveWordSET_0(fortranout,pos_curcommon,
+                                                       pos_end-pos_curcommon);
+                         }
+                   }
+      ;
+before_common : TOK_COMMON
+                   {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6;
+                   }
+      | TOK_GLOBAL TOK_COMMON
+                   {
+                      positioninblock=0;
+                      pos_curcommon = setposcur()-6-7;
+                   }
+      ;
+var_common_list : var_common
+                   {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   }
+
+     | var_common_list ',' var_common
+                   {
+                      if ( couldaddvariable == 1 ) Add_Common_var_1();
+                   }
+var_common : TOK_NAME dims
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         positioninblock = positioninblock + 1 ;
+                         strcpy(commonvar,$1);
+                         commondim = $2;
+                      }
+                   }
+      ;
+comblock : TOK_DSLASH
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy($$,"");
+                         positioninblock=0;
+                         strcpy(commonblockname,"");
+                      }
+                   }
+      | TOK_SLASH TOK_NAME TOK_SLASH
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         strcpy($$,$2);
+                         positioninblock=0;
+                         strcpy(commonblockname,$2);
+                      }
+                   }
+      ;
+opt_comma :
+      | ','
+      ;
+paramlist : paramitem
+                   {
+                      if ( couldaddvariable == 1 ) $$=insertvar(NULL,$1);
+                   }
+      | paramlist ',' paramitem
+                   {
+                      if ( couldaddvariable == 1 ) $$=insertvar($1,$3);
+                   }
+      ;
+paramitem : TOK_NAME '=' expr
+                   {
+                     if ( couldaddvariable == 1 )
+                     {
+                         curvar=(variable *) malloc(sizeof(variable));
+                         /*                                                   */
+                         Init_Variable(curvar);
+                         /*                                                   */
+                         curvar->v_VariableIsParameter=1;
+                         strcpy(curvar->v_nomvar,$1);
+                         Save_Length($1,4);
+                         strcpy(curvar->v_subroutinename,subroutinename);
+                         Save_Length(subroutinename,11);
+                         strcpy(curvar->v_modulename,curmodulename);
+                         Save_Length(curmodulename,6);
+                         strcpy(curvar->v_initialvalue,$3);
+                         Save_Length($3,14);
+                         strcpy(curvar->v_commoninfile,mainfile);
+                         Save_Length(mainfile,10);
+                         $$=curvar;
+                      }
+                   }
+      ;
+module_proc_stmt : TOK_PROCEDURE proc_name_list
+      ;
+proc_name_list : TOK_NAME
+      | proc_name_list ',' TOK_NAME
+      ;
+implicit : TOK_IMPLICIT TOK_NONE
+                    {
+                       if ( insubroutinedeclare == 1 )
+                       {
+                          Add_ImplicitNoneSubroutine_1();
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_end-13,
+                                                             13);
+                       }
+                    }
+      | TOK_IMPLICIT TOK_REAL8
+      ;
+opt_retour :
+      ;
+dcl : options opt_retour TOK_NAME dims lengspec initial_value
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         /*                                                   */
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar($3,curdim);
+                            GlobalDeclarationType == 0;
+                         }
+                         else
+                         {
+                            curvar=createvar($3,$4);
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar(DeclType,curvar);
+                         /*                                                   */
+                         curlistvar=insertvar(NULL,curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         $$=settype(DeclType,curlistvar);
+                      }
+                      strcpy(vallengspec,"");
+                   }
+      | dcl ',' opt_retour TOK_NAME dims lengspec initial_value
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         if (dimsgiven == 1)
+                         {
+                            curvar=createvar($4,curdim);
+                         }
+                         else
+                         {
+                            curvar=createvar($4,$5);
+                         }
+                         /*                                                   */
+                         CreateAndFillin_Curvar($1->var->v_typevar,curvar);
+                         /*                                                   */
+                         strcpy(curvar->v_typevar,($1->var->v_typevar));
+                         Save_Length($1->var->v_typevar,3);
+                         /*                                                   */
+                         curlistvar=insertvar($1,curvar);
+                         if (!strcasecmp(DeclType,"character"))
+                         {
+                            if (c_selectorgiven == 1)
+                            {
+                               strcpy(c_selectordim.first,"1");
+                               strcpy(c_selectordim.last,c_selectorname);
+                               Save_Length(c_selectorname,1);
+                               change_dim_char
+                                     (insertdim(NULL,c_selectordim),curlistvar);
+                            }
+                         }
+                         $$=curlistvar;
+                      }
+                      strcpy(vallengspec,"");
+                   }
+      ;
+nodimsgiven :       {dimsgiven=0;}
+      ;
+type : typespec selector
+                   {strcpy(DeclType,$1);}
+      | before_character c_selector
+                   {
+                      strcpy(DeclType,"CHARACTER");
+                   }
+      | typename '*' TOK_CSTINT
+                   {
+                      strcpy(DeclType,$1);
+                      strcpy(nameinttypename,$3);
+                   }
+      | before_typepar attribute ')'
+                   {
+                      strcpy(DeclType,"TYPE");
+                      GlobalDeclarationType = 1
+                   }
+      ;
+before_typepar : TOK_TYPEPAR
+                   {
+                 /*     if ( couldaddvariable == 1 ) VarTypepar = 1 ;
+                      couldaddvariable = 0 ;
+                      pos_cur_decl = setposcur()-5;*/
+                   pos_cur_decl = setposcur()-5;
+                   }
+      ;
+c_selector :
+      | '*' TOK_CSTINT
+                   {c_selectorgiven=1;strcpy(c_selectorname,$2);}
+      | '*' '(' c_attribute ')' {c_star = 1;}
+      | '(' c_attribute ')'
+      ;
+c_attribute : TOK_NAME clause opt_clause
+      | TOK_NAME '=' clause opt_clause
+      | clause opt_clause
+      ;
+before_character : TOK_CHARACTER
+                   {
+                      pos_cur_decl = setposcur()-9;
+                   }
+      ;
+typespec : typename {strcpy($$,$1);}
+      ;
+typename : TOK_INTEGER
+                   {
+                      strcpy($$,"INTEGER");
+                      pos_cur_decl = setposcur()-7;
+                   }
+      | TOK_REAL   {
+                      strcpy($$,"REAL");
+                      pos_cur_decl = setposcur()-4;
+                   }
+      | TOK_COMPLEX
+                   {strcpy($$,"COMPLEX");
+                   pos_cur_decl = setposcur()-7;}
+      | TOK_DOUBLEPRECISION
+                   {
+                      pos_cur_decl = setposcur()-16;
+                      strcpy($$,"REAL");
+                      strcpy(nameinttypename,"8");
+                   }
+      | TOK_DOUBLECOMPLEX
+                   {strcpy($$,"DOUBLE COMPLEX");}
+      | TOK_LOGICAL
+                   {
+                      strcpy($$,"LOGICAL");
+                      pos_cur_decl = setposcur()-7;
+                   }
+      ;
+lengspec :
+      | '*' proper_lengspec {strcpy(vallengspec,$2);}
+      ;
+proper_lengspec : expr {sprintf($$,"*%s",$1);}
+      | '(' '*' ')'{strcpy($$,"*(*)");}
+      ;
+selector :
+      | '*' proper_selector
+      | '(' attribute ')'
+      ;
+proper_selector : expr
+      | '(' '*' ')'
+      ;
+attribute : TOK_NAME clause
+      | TOK_NAME '=' clause
+                   {
+                      if ( strstr($3,"0.d0") )
+                      {
+                         strcpy(nameinttypename,"8");
+                         sprintf(NamePrecision,"");
+                      }
+                      else sprintf(NamePrecision,"%s = %s",$1,$3);
+                   }
+      | TOK_NAME
+                   {
+                      strcpy(NamePrecision,$1);
+                   }
+      | TOK_CSTINT
+                   {
+                      strcpy(NamePrecision,$1);
+                   }
+      ;
+clause : expr       {strcpy(CharacterSize,$1);
+                    strcpy($$,$1);}
+      | '*'        {strcpy(CharacterSize,"*");
+                    strcpy($$,"*");}
+      ;
+opt_clause :
+      | ',' TOK_NAME clause
+      ;
+options :
+      | ':' ':'
+      | ',' attr_spec_list ':' ':'
+      ;
+attr_spec_list : attr_spec
+      | attr_spec_list ',' attr_spec
+      ;
+attr_spec : TOK_PARAMETER
+                   {
+                      VariableIsParameter = 1;
+                   }
+      | access_spec
+      | TOK_ALLOCATABLE
+                   {Allocatabledeclare = 1;}
+      | TOK_DIMENSION dims
+                   {
+                      dimsgiven=1;
+                      curdim=$2;
+                   }
+      | TOK_EXTERNAL
+                   {ExternalDeclare = 1;}
+      | TOK_INTENT '(' intent_spec ')'
+                   {strcpy(IntentSpec,$3);}
+      | TOK_INTRINSIC
+      | TOK_OPTIONAL{optionaldeclare = 1 ;}
+      | TOK_POINTER {pointerdeclare = 1 ;}
+      | TOK_SAVE    {
+/*                       if ( inmodulemeet == 1 )
+                       {*/
+                          SaveDeclare = 1 ;
+                     /*  }*/
+                    }
+      | TOK_TARGET
+      				{Targetdeclare = 1;}
+      ;
+intent_spec : TOK_IN {strcpy($$,$1);}
+      | TOK_OUT     {strcpy($$,$1);}
+      | TOK_INOUT   {strcpy($$,$1); }
+      ;
+access_spec : TOK_PUBLIC
+                   {PublicDeclare = 1;}
+      | TOK_PRIVATE
+                   {PrivateDeclare = 1;}
+      ;
+dims :              {if ( created_dimensionlist == 1 )
+                       {
+                           $$=(listdim *)NULL;
+                       }
+                   }
+      | '(' dimlist ')'
+                   {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) $$=$2;}
+      ;
+dimlist :   dim     {if ( created_dimensionlist == 1 ||
+                         agrif_parentcall      == 1 ) $$=insertdim(NULL,$1);}
+      | dimlist ',' dim
+                   {if ( couldaddvariable == 1 )
+                         if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);}
+      ;
+dim : ubound         {
+                      strcpy($$.first,"1");
+                      strcpy($$.last,$1);
+                      Save_Length($1,1);
+                   }
+      | ':'        {
+                      strcpy($$.first,"");
+                      strcpy($$.last,"");
+                   }
+      | expr ':'   {
+                      strcpy($$.first,$1);
+                      Save_Length($1,2);
+                      strcpy($$.last,"");
+                   }
+      | ':' expr   {
+                      strcpy($$.first,"");
+                      strcpy($$.last,$2);
+                      Save_Length($2,1);
+                   }
+      | expr ':' ubound
+                   {
+                      strcpy($$.first,$1);
+                      Save_Length($1,2);
+                      strcpy($$.last,$3);
+                      Save_Length($3,1);
+                   }
+      ;
+ubound :  '*'       {strcpy($$,"*");}
+      | expr       {strcpy($$,$1);}
+      ;
+expr :  uexpr       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | '(' expr ')'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s)",$2);}
+      | complex_const
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | predefinedfunction
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+
+predefinedfunction : TOK_SUM minmaxlist ')'
+                   {sprintf($$,"SUM(%s)",$2);}
+      | TOK_MAX minmaxlist ')'
+                   {sprintf($$,"MAX(%s)",$2);}
+      | TOK_TANH '(' minmaxlist ')'
+                   {sprintf($$,"TANH(%s)",$3);}
+      | TOK_MAXVAL '(' minmaxlist ')'
+                   {sprintf($$,"MAXVAL(%s)",$3);}
+      | TOK_MIN minmaxlist ')'
+                   {sprintf($$,"MIN(%s)",$2);}
+      | TOK_MINVAL '(' minmaxlist ')'
+                   {sprintf($$,"MINVAL(%s)",$3);}
+      | TOK_TRIM '(' expr ')'
+                   {sprintf($$,"TRIM(%s)",$3);}
+      | TOK_SQRT expr ')'
+                   {sprintf($$,"SQRT(%s)",$2);}
+      | TOK_REAL '(' minmaxlist ')'
+                   {sprintf($$,"REAL(%s)",$3);}
+      | TOK_NINT '(' expr ')'
+                   {sprintf($$,"NINT(%s)",$3);}
+      | TOK_FLOAT '(' expr ')'
+                   {sprintf($$,"FLOAT(%s)",$3);}
+      | TOK_EXP '(' expr ')'
+                   {sprintf($$,"EXP(%s)",$3);}
+      | TOK_COS '(' expr ')'
+                   {sprintf($$,"COS(%s)",$3);}
+      | TOK_COSH '(' expr ')'
+                   {sprintf($$,"COSH(%s)",$3);}
+      | TOK_ACOS '(' expr ')'
+                   {sprintf($$,"ACOS(%s)",$3);}
+      | TOK_SIN '(' expr ')'
+                   {sprintf($$,"SIN(%s)",$3);}
+      | TOK_SINH '(' expr ')'
+                   {sprintf($$,"SINH(%s)",$3);}
+      | TOK_ASIN '(' expr ')'
+                   {sprintf($$,"ASIN(%s)",$3);}
+      | TOK_LOG '(' expr ')'
+                   {sprintf($$,"LOG(%s)",$3);}
+      | TOK_TAN '(' expr ')'
+                   {sprintf($$,"TAN(%s)",$3);}
+      | TOK_ATAN '(' expr ')'
+                   {sprintf($$,"ATAN(%s)",$3);}
+      | TOK_ABS expr ')'
+                   {sprintf($$,"ABS(%s)",$2);}
+      | TOK_MOD '(' minmaxlist ')'
+                   {sprintf($$,"MOD(%s)",$3);}
+      | TOK_SIGN '(' minmaxlist ')'
+                   {sprintf($$,"SIGN(%s)",$3);}
+      | TOK_MINLOC '(' minmaxlist ')'
+                   {sprintf($$,"MINLOC(%s)",$3);}
+      | TOK_MAXLOC '(' minmaxlist ')'
+                   {sprintf($$,"MAXLOC(%s)",$3);}
+      ;
+minmaxlist : expr {strcpy($$,$1);}
+      | minmaxlist ',' expr
+                   {if ( couldaddvariable == 1 )
+                   { strcpy($$,$1);strcat($$,",");strcat($$,$3);}}
+      ;
+uexpr :  lhs        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | simple_const
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | vec
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | expr operation
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      | signe expr %prec '*' 
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      | TOK_NOT expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      ;
+signe : '+'        {if ( couldaddvariable == 1 ) strcpy($$,"+");}
+      | '-'        {if ( couldaddvariable == 1 ) strcpy($$,"-");}
+      ;
+operation : '+' expr %prec '+'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"+%s",$2);}
+      |  '-' expr %prec '+'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"-%s",$2);}
+      |  '*' expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"*%s",$2);}
+      |  TOK_DASTER expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_EQ expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_EQV expr %prec TOK_EQV
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
+      |  TOK_GT expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  '>' expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$," > %s",$2);}
+      |  TOK_LT expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  '<' expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$," < %s",$2);}
+      |  TOK_GE expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  '>''=' expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$," >= %s",$3);}
+      |  TOK_LE expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  '<''=' expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$," <= %s",$3);}
+      |  TOK_NE expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_NEQV expr %prec TOK_EQV
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}                   
+      |  TOK_XOR expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_OR expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_AND expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      |  TOK_SLASH after_slash
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
+      |  '=' after_equal
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
+
+after_slash : {strcpy($$,"");}
+      | expr
+                   {sprintf($$,"/%s",$1);}
+      | '=' expr %prec TOK_EQ
+                   {sprintf($$,"/= %s",$2);}
+      | TOK_SLASH expr
+                   {sprintf($$,"//%s",$2);}
+      ;
+after_equal : '=' expr %prec TOK_EQ
+                   {if ( couldaddvariable == 1 ) sprintf($$,"==%s",$2);}
+      | expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"= %s",$1);}
+      ;
+
+lhs : ident         {if ( couldaddvariable == 1 )
+						{
+						printf("ident = %s\n",$1);
+						strcpy($$,$1);}
+						}
+      | structure_component
+                   {if ( couldaddvariable == 1 ) {
+                   printf("struct = %s\n",$1);
+                   strcpy($$,$1);}
+                   }
+      | array_ele_substring_func_ref
+                   {if ( couldaddvariable == 1 ) {
+                   printf("arrayref = %s\n",$1);
+                   strcpy($$,$1);
+                   }}
+      ;
+beforefunctionuse : {
+                      agrif_parentcall =0;
+                      if (!strcasecmp(identcopy,"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                      if ( Agrif_in_Tok_NAME(identcopy) == 1 )
+                      {
+                         inagrifcallargument = 1;
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                      }
+                   }
+      ;
+array_ele_substring_func_ref : begin_array
+                   {
+                     strcpy($$,$1);
+                     if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   }
+      | begin_array substring
+                   {if ( couldaddvariable == 1 ) sprintf($$," %s %s ",$1,$2);}
+      | structure_component '(' funarglist ')'
+                   {if ( couldaddvariable == 1 )
+                                                sprintf($$," %s ( %s )",$1,$3);}
+      | structure_component '(' funarglist ')' substring
+                   {if ( couldaddvariable == 1 )
+                                         sprintf($$," %s ( %s ) %s ",$1,$3,$5);}
+      ;
+begin_array : ident '(' funarglist ')'
+                   {
+                      if ( couldaddvariable == 1 )
+                      {
+                         sprintf($$," %s ( %s )",$1,$3);
+                         ModifyTheAgrifFunction_0($3);
+                         agrif_parentcall =0;
+                      }
+                   }
+      ;
+structure_component : lhs '%' lhs
+                   {
+                      sprintf($$," %s %% %s ",$1,$3);
+                      if ( incalldeclare == 0 ) inagrifcallargument = 0;
+                   }
+      ;
+vec :  TOK_LEFTAB outlist TOK_RIGHTAB
+                   {sprintf($$,"(/%s/)",$2);}
+      ;
+funarglist : beforefunctionuse    {strcpy($$," ");}
+      | beforefunctionuse funargs
+                   {strcpy($$,$2);}
+      ;
+funargs : funarg     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | funargs ',' funarg
+                    {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      ;
+funarg : expr       {strcpy($$,$1);}
+      | triplet    {strcpy($$,$1);}
+      ;
+triplet : expr ':' expr
+                    {if ( couldaddvariable == 1 ) sprintf($$,"%s :%s",$1,$3);}
+      | expr ':' expr ':' expr
+                    {if ( couldaddvariable == 1 )
+                                               sprintf($$,"%s :%s :%s",$1,$3,$5);}
+      | ':' expr ':' expr
+                    {if ( couldaddvariable == 1 ) sprintf($$,":%s :%s",$2,$4);}
+      | ':' ':' expr{if ( couldaddvariable == 1 ) sprintf($$,": : %s",$3);}
+      | ':' expr    {if ( couldaddvariable == 1 ) sprintf($$,":%s",$2);}
+      | expr ':'    {if ( couldaddvariable == 1 ) sprintf($$,"%s :",$1);}
+      | ':'         {if ( couldaddvariable == 1 ) sprintf($$,":");}
+      ;
+ident : TOK_NAME    {
+                       if ( couldaddvariable == 1 && afterpercent == 0)
+                       {
+                       if ( Vartonumber($1) == 1 )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if (!strcasecmp($1,"Agrif_Parent") )
+                                                            agrif_parentcall =1;
+                       if ( VariableIsNotFunction($1) == 0 )
+                       {
+                       printf("var = %s\n",$1);
+                          if ( inagrifcallargument == 1 )
+                          {
+                             if ( !strcasecmp($1,identcopy) )
+                             {
+                                strcpy(sameagrifname,identcopy);
+                                sameagrifargument = 1;
+                             }
+                          }
+                          strcpy(identcopy,$1);
+                          pointedvar=0;
+                          strcpy(truename,$1);
+                          if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1));
+
+                          if ( VarIsNonGridDepend(truename) == 0 &&
+                               Variableshouldberemove(truename) == 0 )
+                          {                      
+                             if ( inagrifcallargument == 1 ||
+                                  varispointer_0(truename) == 1 )
+                             {
+                             printf("var2 = %s\n",$1);
+                            if ((IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1))
+                             {
+                              if (varistyped_0(truename) == 0)
+                                 {
+                                 ModifyTheVariableName_0(truename,strlen($1));
+                                 }
+                                 }
+                             }
+                             printf("ici3\n");
+                             if ( inagrifcallargument != 1 ||
+                                  sameagrifargument ==1 )
+                                  {
+                                  printf("ici5 %s\n",truename);
+                                  Add_UsedInSubroutine_Var_1(truename);
+                          }
+                          }
+                          NotifyAgrifFunction_0(truename);
+                       }
+                       }
+                       else
+                       {
+                       afterpercent = 0;
+                    }
+                    }
+      ;
+simple_const : TOK_TRUE
+                     {if ( couldaddvariable == 1 ) strcpy($$,".TRUE.");}
+      | TOK_FALSE    {if ( couldaddvariable == 1 ) strcpy($$,".FALSE.");}
+      | TOK_CSTINT   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | TOK_CSTREAL  {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | TOK_CSTREALDP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | TOK_CSTREALQP{if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | simple_const TOK_NAME
+                     {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
+      | string_constant opt_substring
+      ;
+string_constant : TOK_CHAR_CONSTANT
+                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | string_constant TOK_CHAR_CONSTANT
+      | TOK_CHAR_MESSAGE
+                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | TOK_CHAR_CUT
+                     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+opt_substring :      {if ( couldaddvariable == 1 ) strcpy($$," ");}
+      | substring   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+substring : '(' optexpr ':' optexpr ')'
+                    {if ( couldaddvariable == 1 ) sprintf($$,"(%s :%s)",$2,$4);}
+      ;
+optexpr :           {if ( couldaddvariable == 1 ) strcpy($$," ");}
+      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+opt_expr : '\n'          {if ( couldaddvariable == 1 ) strcpy($$," ");}
+      | expr        {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+initial_value :      {   strcpy(InitialValueGiven," ");}
+      | before_initial '=' expr
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,$3);
+                          strcpy(InitialValueGiven,"=");
+                       }
+                    }
+      | before_initial TOK_POINT_TO expr
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                          strcpy(InitValue,$3);
+                          strcpy(InitialValueGiven,"=>");
+                       }
+                    }
+      ;
+before_initial : {pos_curinit = setposcur();}
+      ;
+complex_const : '(' uexpr ',' uexpr ')'
+                    {sprintf($$,"(%s,%s)",$2,$4);}
+      ;
+use_stat : word_use  module_name
+                    {
+                      if ( couldaddvariable == 1 )
+                      {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuse_0($2);
+                      }
+                      sprintf(charusemodule,"%s",$2);
+                      Add_NameOfModuleUsed_1($2);
+
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    }
+      | word_use  module_name ',' rename_list
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      if (insubroutinedeclare == 1)
+                      {
+                         Add_CouplePointed_Var_1($2,$4);
+                      }
+                      if ( firstpass == 1 )
+                      {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            coupletmp = $4;
+                            strcpy(ligne,"");
+                            while ( coupletmp )
+                            {
+                               strcat(ligne,coupletmp->c_namevar);
+                               strcat(ligne," => ");
+                               strcat(ligne,coupletmp->c_namepointedvar);
+                               coupletmp = coupletmp->suiv;
+                               if ( coupletmp ) strcat(ligne,",");
+                            }
+                            sprintf(charusemodule,"%s",$2);
+                         }
+                         Add_NameOfModuleUsed_1($2);
+                      }
+                      if ( inmoduledeclare == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curuse,
+                                               pos_end-pos_curuse);
+                      }
+                      }
+                    }
+      | word_use  module_name ',' TOK_ONLY ':' '\n'
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                      /* if variables has been declared in a subroutine       */
+                      if (insubroutinedeclare == 1)
+                      {
+                         copyuseonly_0($2);
+                      }
+                      sprintf(charusemodule,"%s",$2);
+                      Add_NameOfModuleUsed_1($2);
+
+                       if ( inmoduledeclare == 0 )
+                       {
+                          pos_end = setposcur();
+                          RemoveWordSET_0(fortranout,pos_curuse,
+                                                pos_end-pos_curuse);
+                       }
+                       }
+                    }
+      | word_use  module_name ',' TOK_ONLY ':' only_list
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if variables has been declared in a subroutine      */
+                       if (insubroutinedeclare == 1)
+                       {
+                          Add_CouplePointed_Var_1($2,$6);
+                       }
+                       if ( firstpass == 1 )
+                       {
+                         if ( insubroutinedeclare == 1 )
+                         {
+                             coupletmp = $6;
+                             strcpy(ligne,"");
+                             while ( coupletmp )
+                             {
+                                strcat(ligne,coupletmp->c_namevar);
+                               if ( strcasecmp(coupletmp->c_namepointedvar,"") )
+                                                           strcat(ligne," => ");
+                                strcat(ligne,coupletmp->c_namepointedvar);
+                                coupletmp = coupletmp->suiv;
+                                if ( coupletmp ) strcat(ligne,",");
+                             }
+                             sprintf(charusemodule,"%s",$2);
+                          }
+                          Add_NameOfModuleUsed_1($2);
+                       }
+                       if ( firstpass == 0 )
+                       {
+                          if ( inmoduledeclare == 0 )
+                          {
+
+                            pos_end = setposcur();
+                             RemoveWordSET_0(fortranout,pos_curuse,
+                                                   pos_end-pos_curuse);
+                       if (oldfortranout) 
+                         variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold);
+                        
+                          }
+                          else
+                          {
+
+                             /* if we are in the module declare and if the    */
+                             /* onlylist is a list of global variable         */
+                             variableisglobalinmodule($6, $2, fortranout,pos_curuse);
+                          }
+                       }
+                       }
+                    }
+      ;
+word_use : TOK_USE
+                   {
+                      pos_curuse = setposcur()-strlen($1);
+                     if (firstpass == 0 && oldfortranout) {
+                     pos_curuseold = setposcurname(oldfortranout);
+                     }
+                   }
+      ;
+module_name : TOK_NAME
+                    {strcpy($$,$1);}
+      ;
+rename_list : rename_name
+                    {
+                       if ( couldaddvariable == 1 ) $$ = $1;
+                    }
+      | rename_list ',' rename_name
+                    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        $3->suiv = $1;
+                        $$ = $3;
+                        }
+                    }
+      ;
+rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
+                    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,$1);
+                       Save_Length($1,21);
+                       strcpy(coupletmp->c_namepointedvar,$3);
+                       Save_Length($3,22);
+                       coupletmp->suiv = NULL;
+                       $$ = coupletmp;
+                     }
+      ;
+only_list : only_name
+                    {
+                       if ( couldaddvariable == 1 ) $$ = $1;
+                    }
+      | only_list ',' only_name
+                    {
+                        if ( couldaddvariable == 1 )
+                        {
+                        /* insert the variable in the list $1                 */
+                        $3->suiv = $1;
+                        $$ = $3;
+                        }
+                    }
+      ;
+only_name : TOK_NAME TOK_POINT_TO TOK_NAME
+                    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,$1);
+                       Save_Length($1,21);
+                       strcpy(coupletmp->c_namepointedvar,$3);
+                       Save_Length($3,22);
+                       coupletmp->suiv = NULL;
+                       $$ = coupletmp;
+                       pointedvar=1;
+                       Add_UsedInSubroutine_Var_1($1);
+                    }
+      | TOK_NAME    {
+                       coupletmp =(listcouple *)malloc(sizeof(listcouple));
+                       strcpy(coupletmp->c_namevar,$1);
+                       Save_Length($1,21);
+                       strcpy(coupletmp->c_namepointedvar,"");
+                       coupletmp->suiv = NULL;
+                       $$ = coupletmp;
+                     }
+      ;
+exec : iffable
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
+                     {
+                         Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
+                     {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                         curmodulename);
+                                                         inallocate = 0;
+                     }
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | word_endunit /* end                                                   */
+                    {
+                       GlobalDeclaration = 0 ;
+                       if ( firstpass == 0 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                          if ( module_declar && insubroutinedeclare == 0 )
+                          {
+                              fclose(module_declar);
+                          }
+                       }
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       if ( inmodulemeet == 1 )
+                       {
+                         /* we are in a module                                */
+                         if ( insubroutinedeclare == 1 )
+                         {
+                            /* it is like an end subroutine <name>            */
+                            insubroutinedeclare = 0 ;
+                            /*                                                */
+                            pos_cur = setposcur();
+                            closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                         }
+                         else
+                         {
+                            /* it is like an end module <name>                */
+                            inmoduledeclare = 0 ;
+                            inmodulemeet = 0 ;
+                         }
+                       }
+                       else
+                       {
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+                          pos_cur = setposcur();                        
+                          closeandcallsubloopandincludeit_0(2);
+                            functiondeclarationisdone = 0;
+                          if ( firstpass == 0 )
+                          {
+                             if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                             else fprintf(paramout,"C\n");
+                             fclose(paramout);
+                           }
+                        }
+                      }
+                      strcpy(subroutinename,"");
+                    }
+      | word_endprogram opt_name
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();                      
+                       closeandcallsubloopandincludeit_0(3);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    }
+      | word_endsubroutine opt_name
+                    {
+                       if ( couldaddvariable == 1 &&
+                            strcasecmp(subroutinename,"") )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+                                             
+                       closeandcallsubloopandincludeit_0(1);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    }
+      | word_endfunction opt_name
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       insubroutinedeclare = 0;
+                       /*                                                     */
+                       pos_cur = setposcur();
+
+                       closeandcallsubloopandincludeit_0(0);
+                            functiondeclarationisdone = 0;
+                      if ( firstpass == 0 )
+                      {
+                         if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                         else fprintf(paramout,"C\n");
+                         fclose(paramout);
+                      }
+                      strcpy(subroutinename,"");
+                      }
+                    }
+      | TOK_ENDMODULE opt_name
+                    {
+                       if ( couldaddvariable == 1 )
+                       {
+                       /* if we never meet the contains keyword               */
+                      Remove_Word_end_module_0(strlen($2));
+                       if ( inmoduledeclare == 1 )
+                       {
+                          if ( aftercontainsdeclare == 0 )
+                          {
+                             Write_GlobalParameter_Declaration_0();
+                             Write_NotGridDepend_Declaration_0();
+                             Write_GlobalType_Declaration_0();
+                             if ( module_declar_type )
+                             {
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                             Write_Alloc_Subroutine_For_End_0();
+                          }
+                       }
+                                           
+                       inmoduledeclare = 0 ;
+                       inmodulemeet = 0 ;
+
+                      Write_Word_end_module_0();
+                      strcpy(curmodulename,"");
+                      aftercontainsdeclare = 1;
+                      if ( firstpass == 0 )
+                      {
+                         if ( module_declar && insubroutinedeclare == 0)
+                         {
+                           fclose(module_declar);
+                         }
+                         if ( module_declar_type && insubroutinedeclare == 0)
+                         {
+                          fclose(module_declar_type);
+                          module_declar_type = 0;
+                         }
+                      }
+                      GlobalDeclaration = 0 ;
+                      }
+                  }
+      | boucledo
+      | logif iffable
+      | TOK_WHERE '(' expr ')' opt_expr
+      | TOK_ELSEWHERE
+      | TOK_ENDWHERE
+      | logif TOK_THEN
+      | TOK_ELSEIF  '(' expr ')' TOK_THEN
+      | TOK_ELSE
+      | TOK_ENDIF opt_name
+      | TOK_CASE caselist ')'
+      | TOK_SELECTCASE '(' expr ')'
+      | TOK_CASEDEFAULT
+      | TOK_ENDSELECT
+      | TOK_CONTAINS
+                   {
+                      if (inmoduledeclare == 1 )
+                      {
+                         Remove_Word_Contains_0();
+                         Write_GlobalParameter_Declaration_0();
+                         Write_GlobalType_Declaration_0();
+                             if ( module_declar_type)
+                             {                         
+                             strcpy (ligne, "\n#include \"Module_DeclarType_");
+                             strcat (ligne, curmodulename);
+                             strcat (ligne, ".h\"\n");
+                             tofich(fortranout,ligne,1); 
+                             }
+                         Write_NotGridDepend_Declaration_0();
+                         Write_Alloc_Subroutine_0();
+                         inmoduledeclare = 0 ;
+                         aftercontainsdeclare = 1;
+                      }
+                      else
+                      {
+                      incontainssubroutine = 1;
+                      strcpy(previoussubroutinename,subroutinename);
+                       if ( couldaddvariable == 1 )
+                       {
+                          if ( firstpass == 1 ) List_ContainsSubroutine =
+                                                Addtolistnom(subroutinename,
+                                                     List_ContainsSubroutine,0);
+                          insubroutinedeclare = 0;
+                          /*                                                  */
+
+                          closeandcallsubloop_contains_0();
+                            functiondeclarationisdone = 0;
+                         if ( firstpass == 0 )
+                         {
+                            if ( retour77 == 0 ) fprintf(paramout,"!\n");
+                            else fprintf(paramout,"C\n");
+                            fclose(paramout);
+                         }
+                         }
+                         strcpy(subroutinename,"");
+                      }
+                   }
+      ;
+word_endsubroutine : TOK_ENDSUBROUTINE
+                    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy($$,$1);
+                       pos_endsubroutine = setposcur()-strlen($1);
+                       functiondeclarationisdone = 0;
+                       }
+                    }
+      ;
+word_endunit : TOK_ENDUNIT
+                    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy($$,$1);
+                       pos_endsubroutine = setposcur()-strlen($1);
+                       }
+                    }
+      ;
+word_endprogram :  TOK_ENDPROGRAM
+                    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy($$,$1);
+                       pos_endsubroutine = setposcur()-strlen($1);
+                       }
+                    }
+      ;
+word_endfunction : TOK_ENDFUNCTION
+                    {
+                      if ( couldaddvariable == 1 )
+                      {
+                       strcpy($$,$1);
+                       pos_endsubroutine = setposcur()-strlen($1);
+                       }
+                    }
+      ;
+caselist : expr
+      | caselist ',' expr
+      | caselist ':' expr
+      ;
+boucledo : worddo opt_int do_arg
+      | wordwhile expr
+      | TOK_ENDDO optname
+      ;
+do_arg :
+      | do_var '=' expr ',' expr
+      | do_var '=' expr ',' expr ',' expr
+opt_int :
+      | TOK_CSTINT opt_comma
+      ;
+opt_name : '\n'  {strcpy($$,"");}
+      | TOK_NAME {strcpy($$,$1);}
+      ;
+optname :
+      | TOK_NAME
+      ;
+worddo :  TOK_PLAINDO
+      ;
+wordwhile :TOK_DOWHILE
+      ;
+
+dotarget :
+      | TOK_CSTINT
+      ;
+
+iffable : TOK_CONTINUE
+      | ident_dims after_ident_dims
+      | goto
+      | io
+      | call
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
+                     {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
+                     {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                                                        inallocate = 0;
+                     }
+      | TOK_EXIT optexpr
+      | TOK_RETURN opt_expr
+      | TOK_CYCLE opt_expr
+      | stop opt_expr
+      | int_list
+      ;
+before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;}
+ident_dims : ident before_dims dims dims
+              {
+                  created_dimensionlist = 1;
+                  if  ( agrif_parentcall == 1 )
+                  {
+                      ModifyTheAgrifFunction_0($3->dim.last);
+                      agrif_parentcall =0;
+                      fprintf(fortranout," = ");
+                  }
+              }
+      | ident_dims '%' ident before_dims dims dims
+      {created_dimensionlist = 1;}
+int_list : TOK_CSTINT
+      | int_list ',' TOK_CSTINT
+      ;
+after_ident_dims : '=' expr
+      | TOK_POINT_TO expr
+      ;
+call : keywordcall opt_call
+                   {
+                      inagrifcallargument = 0 ;
+                      incalldeclare=0;
+                      if ( oldfortranout &&
+                           !strcasecmp(meetagrifinitgrids,subroutinename) &&
+                           firstpass == 0 &&
+                           callmpiinit == 1)
+                      {
+                      /*   pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+                         fprintf(oldfortranout,"      Call MPI_Init (%s) \n"
+                                                                   ,mpiinitvar);*/
+                      }
+                      if ( oldfortranout           &&
+                           callagrifinitgrids == 1 &&
+                           firstpass == 0 )
+                      {
+                         pos_end = setposcur();
+                         RemoveWordSET_0(fortranout,pos_curcall,
+                                               pos_end-pos_curcall);
+
+                         strcpy(subofagrifinitgrids,subroutinename);
+                      }
+                      Instanciation_0(sameagrifname);
+                   }
+      ;
+opt_call :
+      | '(' opt_callarglist  ')'
+      ;
+opt_callarglist :
+      | callarglist
+      ;
+keywordcall : before_call TOK_NAME
+                    {
+                       if (!strcasecmp($2,"MPI_Init") )
+                       {
+                          callmpiinit = 1;
+                       }
+                       else
+                       {
+                          callmpiinit = 0;
+                       }
+                       if (!strcasecmp($2,"Agrif_Init_Grids") )
+                       {
+                          callagrifinitgrids = 1;
+                          strcpy(meetagrifinitgrids,subroutinename);
+                       }
+                       else callagrifinitgrids = 0;
+                       if ( !strcasecmp($2,"Agrif_Open_File") )
+                       {
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                       if ( Vartonumber($2) == 1 )
+                       {
+                          incalldeclare=1;
+                          inagrifcallargument = 1 ;
+                          Add_SubroutineWhereAgrifUsed_1(subroutinename,
+                                                        curmodulename);
+                       }
+                    }
+      ;
+before_call : TOK_CALL
+                    {pos_curcall=setposcur()-4;}
+callarglist :  callarg
+      | callarglist ',' callarg
+      ;
+
+callarg :  expr {
+                  if ( callmpiinit == 1 )
+                  {
+                     strcpy(mpiinitvar,$1);
+                     if ( firstpass == 1 )
+                     {
+                        Add_UsedInSubroutine_Var_1 (mpiinitvar);
+/*                        curvar=createvar($1,NULL);
+                        curlistvar=insertvar(NULL,curvar);
+                        List_Subr outineArgument_Var = AddListvarToListvar
+                         (curlistvar,List_SubroutineAr gument_Var,1);*/
+                     }
+                  }
+               }
+      | '*' label
+      ;
+
+stop : TOK_PAUSE
+      | TOK_STOP
+      ;
+
+io : iofctl ioctl
+      | read option_read
+      | write ioctl
+      | write ioctl outlist
+      | TOK_REWIND after_rewind
+      | TOK_FORMAT
+      ;
+opt_CHAR_INT :
+      | TOK_CSTINT TOK_NAME
+      ;
+idfile : '*'
+      | TOK_CSTINT
+      | ident
+      ;
+option_print :
+      | ',' outlist
+      ;
+option_inlist :
+      | inlist
+      ;
+option_read : ioctl option_inlist
+      | infmt opt_inlist
+      ;
+opt_outlist :
+      | outlist
+      ;
+opt_inlist :
+      | ',' inlist
+      ;
+ioctl :  '(' ctllist ')'
+      | '(' fexpr ')'
+      ;
+after_rewind :  '(' ident ')'
+      | '(' TOK_CSTINT ')'
+      | TOK_CSTINT
+      | '(' uexpr ')'
+      | TOK_NAME
+      ;
+ctllist : ioclause
+      | ctllist ',' ioclause
+      ;
+ioclause : fexpr
+      | '*'
+      | TOK_DASTER
+      | ident expr dims      
+      | ident expr
+      | ident expr '%' ident_dims
+      | ident '(' triplet ')'
+      | ident '*'
+      | ident TOK_DASTER
+      ;
+iofctl : TOK_OPEN
+      | TOK_CLOSE
+      ;
+infmt :  unpar_fexpr
+      | '*'
+      ;
+
+read :TOK_READ
+      | TOK_INQUIRE
+      | TOK_PRINT
+      ;
+
+write : TOK_WRITE
+      ;
+
+fexpr : unpar_fexpr
+      | '(' fexpr ')'
+      ;
+unpar_fexpr : lhs
+      | simple_const
+      | fexpr addop fexpr %prec '+'
+      | fexpr '*' fexpr
+      | fexpr TOK_SLASH fexpr
+      | fexpr TOK_DASTER fexpr
+      | addop fexpr %prec '*'
+      | fexpr TOK_DSLASH fexpr
+      | TOK_FILE expr
+      | TOK_EXIST expr
+      | TOK_ERR expr
+      | TOK_END expr
+      | TOK_NAME '=' expr
+      | predefinedfunction
+      ;
+addop : '+'
+      | '-'
+      ;
+inlist : inelt
+      | inlist ',' inelt
+      ;
+opt_lhs :
+      | lhs
+      ;
+inelt : opt_lhs opt_operation
+      | '(' inlist ')' opt_operation
+      | predefinedfunction opt_operation
+      | simple_const opt_operation
+      | '(' inlist ',' dospec ')'
+      ;
+opt_operation :
+      | operation
+      | opt_operation operation
+      ;
+outlist : uexpr    {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | other      {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | out2       {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+out2: uexpr ',' expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | uexpr ',' other
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | other ',' expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | other ',' other
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | out2 ',' expr
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | out2 ',' other
+                   {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
+      | uexpr     {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | predefinedfunction {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      ;
+other :  complex_const
+                   {if ( couldaddvariable == 1 ) strcpy($$,$1);}
+      | '(' expr ')'
+                   {if ( couldaddvariable == 1 ) sprintf($$," (%s)",$2);}
+      | '(' uexpr ',' dospec ')'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
+      | '(' other ',' dospec ')'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
+      | '(' out2 ',' dospec ')'
+                   {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
+      ;
+
+dospec : TOK_NAME '=' expr ',' expr
+                   {if ( couldaddvariable == 1 )
+                                              sprintf($$,"%s=%s,%s)",$1,$3,$5);}
+      | TOK_NAME '=' expr ',' expr ',' expr
+                   {if ( couldaddvariable == 1 )
+                                        sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
+      ;
+labellist : label
+      | labellist ',' label
+      ;
+label : TOK_CSTINT
+      ;
+goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
+      | TOK_PLAINGOTO label
+      ;
+allocation_list : allocate_object
+      | ident_dims
+      | allocation_list ',' allocate_object
+      ;
+allocate_object : ident
+                   {Add_Allocate_Var_1($1,curmodulename);}
+      | structure_component
+      | array_element
+      ;
+array_element : ident '(' funargs ')'
+                   {Add_Allocate_Var_1($1,curmodulename);}
+      ;
+subscript_list : expr
+      | subscript_list ',' expr
+      ;
+
+allocate_object_list :allocate_object
+      | allocate_object_list ',' allocate_object
+      ;
+opt_stat_spec :
+      | ',' TOK_STAT '=' ident
+      ;
+pointer_name_list : ident
+      | pointer_name_list ',' ident
+      ;
+opt_construct_name :
+      | TOK_NAME
+      ;
+opt_construct_name_colon :
+      | TOK_CONSTRUCTID ':'
+      ;
+logif : TOK_LOGICALIF expr ')'
+      ;
+do_var : ident {strcpy($$,$1);}
+      ;
+%%
+
+void processfortran(char *fichier_entree)
+{
+   extern FILE *fortranin;
+   extern FILE *fortranout;
+   char nomfile[LONG_C];
+   int c;
+   int confirmyes;
+
+/*   fortrandebug = 1;*/
+   if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
+/******************************************************************************/
+/*  1-  Open input and output files                                           */
+/******************************************************************************/
+   strcpy(nomfile,commondirin);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   fortranin=fopen( nomfile,"r");
+   if (! fortranin)
+   {
+      printf("Error : File %s does not exist\n",nomfile);
+      exit(1);
+   }
+
+   strcpy(curfile,nomfile);
+   strcpy(nomfile,commondirout);
+   strcat(nomfile,"/");
+   strcat(nomfile,fichier_entree);
+   strcpy(nomfileoutput,nomfile);
+   Save_Length(nomfileoutput,31);
+   if (firstpass == 1)
+   {
+      if (checkexistcommon == 1)
+      {
+         if (fopen(nomfile,"r"))
+         {
+            printf("Warning : file %s already exist\n",nomfile);
+            confirmyes = 0;
+            while (confirmyes==0)
+            {
+               printf("Override file %s ? [Y/N]\n",nomfile);
+               c=getchar();
+               getchar();
+               if (c==79 || c==110)
+               {
+                  printf("We stop\n");
+                  exit(1);
+               }
+               if (c==89 || c==121)
+               {
+                  confirmyes=1;
+               }
+            }
+         }
+      }
+   }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+   line_num_fortran_common=1;
+   line_num_fortran=1;
+   PublicDeclare = 0;
+   PrivateDeclare = 0;
+   ExternalDeclare = 0;
+   SaveDeclare = 0;
+   pointerdeclare = 0;
+   optionaldeclare = 0;
+   incalldeclare = 0;
+   VarType = 0;
+   VarTypepar = 0;
+   Allocatabledeclare = 0 ;
+   Targetdeclare = 0 ;
+   strcpy(NamePrecision," ");
+   VariableIsParameter =  0 ;
+   strcpy(NamePrecision,"");
+   c_star = 0 ;
+   functiondeclarationisdone = 0;
+   insubroutinedeclare = 0 ;
+   ininterfacedeclare = 0 ;   
+   strcpy(subroutinename," ");
+   isrecursive = 0;
+   strcpy(InitialValueGiven," ");
+   strcpy(EmptyChar," ");
+   inmoduledeclare = 0;
+   incontainssubroutine = 0;
+   module_declar_type = 0;
+   GlobalDeclarationType = 0;
+   colnum=0;
+   incom=0;
+   couldaddvariable=1;
+   afterpercent = 0;
+   aftercontainsdeclare = 1;
+   strcpy(nameinttypename,"");
+   /* Name of the file without format                                         */
+   tmp = strchr(fichier_entree, '.');
+   strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
+   Save_Length(curfilename,30);
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+   if (firstpass == 0 )
+   {
+      fortranout=fopen(nomfileoutput,"w");
+
+/*      NewModule_Creation_0();*/
+   }
+
+   fortranparse();
+
+   if (firstpass == 0 )
+   {
+   NewModule_Creation_0();
+   }
+   
+   strcpy(curfile,mainfile);
+
+   if (firstpass == 0 )
+   {
+   fclose(fortranout);
+   }
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.yy.c	(revision 3437)
@@ -0,0 +1,5248 @@
+#line 2 "fortran.yy.c"
+
+#line 4 "fortran.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer fortran_create_buffer
+#define yy_delete_buffer fortran_delete_buffer
+#define yy_flex_debug fortran_flex_debug
+#define yy_init_buffer fortran_init_buffer
+#define yy_flush_buffer fortran_flush_buffer
+#define yy_load_buffer_state fortran_load_buffer_state
+#define yy_switch_to_buffer fortran_switch_to_buffer
+#define yyin fortranin
+#define yyleng fortranleng
+#define yylex fortranlex
+#define yylineno fortranlineno
+#define yyout fortranout
+#define yyrestart fortranrestart
+#define yytext fortrantext
+#define yywrap fortranwrap
+#define yyalloc fortranalloc
+#define yyrealloc fortranrealloc
+#define yyfree fortranfree
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE fortranrestart(fortranin  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t fortranleng;
+
+extern FILE *fortranin, *fortranout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortrantext. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up fortrantext again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via fortranrestart()), so that the user can continue scanning by
+	 * just pointing fortranin at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when fortrantext is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t fortranleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow fortranwrap()'s to do buffer switches
+ * instead of setting up a fresh fortranin.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void fortranrestart (FILE *input_file  );
+void fortran_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran_create_buffer (FILE *file,int size  );
+void fortran_delete_buffer (YY_BUFFER_STATE b  );
+void fortran_flush_buffer (YY_BUFFER_STATE b  );
+void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortranpop_buffer_state (void );
+
+static void fortranensure_buffer_stack (void );
+static void fortran_load_buffer_state (void );
+static void fortran_init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran_scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran_scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran_scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortranalloc (yy_size_t  );
+void *fortranrealloc (void *,yy_size_t  );
+void fortranfree (void *  );
+
+#define yy_new_buffer fortran_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        fortranensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        fortranensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran_create_buffer(fortranin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *fortranin = (FILE *) 0, *fortranout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int fortranlineno;
+
+int fortranlineno = 1;
+
+extern char *fortrantext;
+#define yytext_ptr fortrantext
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up fortrantext.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	fortranleng = (size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 176
+#define YY_END_OF_BUFFER 177
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[1162] =
+    {   0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,  177,  176,  165,  161,  164,  175,  152,  151,
+      155,  167,  152,  154,  154,  154,  157,  153,  137,  150,
+      156,  159,  158,  160,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  165,  161,  164,  175,  150,  145,  145,  145,
+      145,  145,  145,  176,  176,  173,  176,  176,  176,  161,
+      161,  154,  145,    0,    0,  165,    0,  166,    0,  164,
+      175,  175,  175,    0,  141,    0,    0,  167,  167,  167,
+      167,    0,    0,    0,  140,    0,    0,  132,   26,    0,
+
+      146,    0,    0,    0,    0,    0,    0,    0,  133,    0,
+      150,   25,    0,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+       43,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,   85,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  165,  163,    0,  163,    0,    0,    0,    0,
+        0,    0,  166,  162,  163,    0,  175,  174,  175,  175,
+      175,  163,  150,    4,  145,  145,  145,  145,   85,  145,
+
+      145,    0,  173,    0,    0,    0,    0,    0,    0,    0,
+      169,   26,    0,    0,    4,    0,  145,  145,  145,  145,
+      145,  145,    0,    0,    0,  175,  175,    0,    0,  167,
+      167,    0,    0,    0,    0,  139,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,  149,  146,    0,    0,    0,  142,    0,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  115,  145,  145,  145,    0,  145,  145,  145,  145,
+      145,   16,  145,  145,  145,  114,  145,  145,  145,  145,
+      145,    0,  145,    0,   96,  145,  145,  145,  145,  145,
+
+      121,  145,  145,  126,  145,  145,  145,  145,  145,  145,
+      145,   89,  145,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  118,  145,  145,  145,
+      145,  145,  122,  145,  145,  145,  145,  145,  165,  163,
+        0,  166,    0,    0,    0,    0,    0,    0,    0,    0,
+      163,    0,  163,  175,  175,  175,  150,    4,    4,    4,
+        4,  145,  145,  145,  145,  145,  145,  145,    0,    0,
+        0,    0,  170,    0,    0,  169,    0,    0,    4,    4,
+        4,    4,  142,    0,  145,  145,    0,  145,  145,  145,
+      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
+
+        0,    0,    0,    0,  147,    0,  146,    0,  148,    0,
+       28,    0,   30,   29,   32,   31,   34,    0,    0,   36,
+        0,  146,    0,  147,    0,  146,    0,  148,    0,  142,
+        0,  125,  117,  145,  145,  120,  123,  145,  145,   22,
+      145,  145,  145,  145,  145,  116,  145,  145,  145,    0,
+      145,  145,  145,   94,    0,  108,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,    0,  109,  145,  145,  145,
+      145,  145,  145,  145,    0,   88,  145,  145,  145,  145,
+      145,  145,  145,    0,   98,  145,  145,    0,  111,  145,
+      145,  145,  145,  112,   21,  145,   60,   74,  145,  145,
+
+      145,  145,  145,  145,  145,  145,   79,   44,  145,  145,
+      145,  145,   69,  145,  127,  119,  145,   72,   54,  145,
+        0,   97,   99,  145,   92,  101,  145,  145,  165,  163,
+      166,    0,    0,    0,    0,    0,    0,    0,  163,    0,
+      163,  175,  175,  175,  150,    4,    4,  145,  145,  145,
+      145,  145,  145,   18,    0,    0,    0,    0,    0,  170,
+        0,    0,    4,    4,    0,  142,    0,  145,  145,  145,
+      145,    0,    0,    0,  175,  175,    0,    0,  167,  167,
+        0,    0,   38,   27,    0,   35,   37,    0,  142,    0,
+      142,  145,  145,  145,  145,  145,   49,  145,  145,  145,
+
+      124,  145,  145,    0,  145,  145,  145,    0,  145,  145,
+        0,    0,    0,    0,    0,    0,    0,    0,   42,  145,
+       95,  145,  145,  145,  145,  145,  145,  145,  145,   76,
+       76,   76,   76,  145,    0,  107,  113,  145,  145,   88,
+      145,  145,   90,  145,  145,  145,  145,  145,  145,  145,
+      145,  145,  145,  145,  145,  145,  145,   52,  145,   77,
+      145,  145,  145,    0,  145,  145,  145,  145,  145,  102,
+      145,  145,   55,   81,  165,  163,  166,    0,    0,    0,
+        0,    0,    0,  163,    0,  163,  175,  175,  175,  150,
+        4,    3,    0,  104,  145,  145,   86,  145,  145,   70,
+
+       71,   70,    0,    0,    0,    0,    4,    3,    0,  142,
+        0,  142,  145,   49,  145,  124,    0,   23,    0,  175,
+       23,    0,   23,   23,  167,   23,    0,   23,   23,   23,
+       33,  145,  145,   23,   23,   23,  145,  145,   63,  145,
+      145,  145,  145,    0,  145,  145,  138,    0,    0,   93,
+      145,   42,    0,   95,    0,    0,    0,    0,    0,    0,
+      145,  145,  145,  145,  145,  145,  145,  145,    0,  110,
+      145,  145,  145,  145,  145,  145,  145,   66,  145,  145,
+      129,  100,  128,  130,   39,  145,  145,  145,  145,  145,
+      145,  145,   83,    0,  145,   11,   75,   19,  145,  145,
+
+       82,  165,  163,  166,    0,    0,    0,    0,  163,  175,
+      175,   23,    4,    3,    3,  145,  145,  145,  145,    0,
+        0,    0,   23,    4,    3,    3,  145,   23,   23,   23,
+       24,    0,  168,   24,   24,   24,   24,   24,   24,   24,
+       24,   24,   24,  145,  145,  145,   58,  145,  145,  145,
+        0,    0,  145,  145,   40,   93,    0,  145,    0,    0,
+        0,    0,    0,    0,    0,  145,  145,  145,  145,  145,
+       73,  145,  145,  145,    0,    0,  145,  145,   17,   50,
+       45,  145,   46,    0,  145,  145,    9,  145,  145,   67,
+       84,    7,    0,    0,  145,    0,  145,  145,    0,    0,
+
+        0,    0,  175,   24,    4,  145,  145,   64,  145,    0,
+        0,   24,    4,   24,   24,   24,  145,    8,  145,  145,
+       87,  145,  145,   40,    0,    0,  145,  145,    0,  145,
+        0,    0,    0,    0,    0,   73,    0,  145,  145,  145,
+      145,  145,   56,  145,   65,    0,    0,    0,    0,  134,
+       12,   20,  145,    0,  145,   80,   68,  145,    0,  145,
+        0,  145,  145,    0,    0,    0,  175,    4,  145,   59,
+      145,    0,    0,    4,  145,  131,   47,  145,   51,    0,
+        0,  145,  145,    0,   57,    0,    0,    0,    0,    0,
+       56,  145,   41,  145,  106,  145,  145,    0,    0,    0,
+
+        0,    0,  134,   91,    0,  145,   61,    0,   62,    0,
+      145,  145,    0,   59,    0,  175,    4,    4,  145,  143,
+        0,    0,    4,    4,  145,   10,    0,    0,  145,  145,
+       57,    0,   41,    0,  106,    0,  145,   14,  145,  145,
+        0,    0,    0,  145,    0,    0,  103,    6,    0,  143,
+      175,    4,    4,  145,    0,    0,    4,    4,   48,    0,
+        0,  145,  145,    0,   14,    0,   15,  145,   53,    0,
+        0,    0,  145,    0,  103,    0,  175,    4,    2,  105,
+        0,    0,    4,    2,    0,    0,  145,  145,   15,    0,
+      145,    0,    0,    0,  145,    0,  105,  175,    4,    0,
+
+        0,    4,    0,    0,  136,  145,    0,   13,    0,    0,
+        0,  145,    0,  175,    1,    0,    0,  144,    1,  136,
+        0,  145,   13,    0,    0,    0,    0,  145,    0,  175,
+        0,    0,  135,    0,    0,    0,   78,    5,  175,    0,
+      135,   78,  175,    0,  175,    0,  175,    0,  175,    0,
+      175,    0,  175,  171,    0,    0,    0,    0,    0,  172,
+        0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
+       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
+       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
+       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
+       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
+
+       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
+       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
+       87,   88,   89,   89,   89,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[90] =
+    {   0,
+        1,    2,    3,    2,    1,    4,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    5,    1,    6,
+        6,    6,    6,    6,    6,    6,    6,    6,    6,    1,
+        1,    1,    1,    1,    7,    8,    8,    9,    9,    5,
+       10,   11,    8,    8,    8,   10,   10,   10,    7,    8,
+        9,   10,   10,    5,   10,    8,   12,    8,    8,    8,
+        1,    1,    8,    7,    8,    8,    9,    9,    5,   10,
+       11,    8,    8,   10,   10,   10,    7,    8,    9,   10,
+       10,    5,   10,    8,   12,    8,    8,    8,    4
+    } ;
+
+static yyconst flex_int16_t yy_base[1215] =
+    {   0,
+        0,   88,    0,    0,    0,    0, 1215,   93, 1196,   91,
+        0,    0, 1179,   64,   97,  117,  132,   87,  124,   98,
+       99,  142,  173,  154,  108,  135,  134,  254,  172,  179,
+      175,  178,  219,  180,  323,  388,  384,  318,  386,  319,
+      186,  128,  250,  256,  392,  404,  438,  428,  204,  455,
+      432,  465,  544,  120,  537,  548,  627,  624,  622,  544,
+      644,  658,  251, 9159, 1175, 9159,  267,   99,  162,  569,
+      572,  620,  745,  164,  107,  262,  307,  335,  376,  522,
+        0,  167,  157, 1162, 9159,  278,  321, 1160, 1118,  372,
+      304,  532,  593,  567, 9159,  633,  832, 9159, 9159,  911,
+
+      798,  318,  319,  450,  799,  552,  320,  354, 9159,  978,
+      834, 9159,  865,  860,  862,  866,  914,  863,  973,  980,
+      974, 1013, 1024, 1045,  869, 1049, 1075, 1095, 1098, 1101,
+     1182, 1177, 1161, 1181, 1214, 1212, 1237, 1239, 1235, 1270,
+     1290, 1316, 1325, 1293, 1346, 1323, 1366, 1368, 1391, 1399,
+     1403, 1429, 1430, 1455, 1452, 1478, 1498, 1482, 1523, 1521,
+     1554, 1548, 1579, 1586, 1606, 1629, 1649, 1675, 1681, 1698,
+     1707, 1729,  871, 1114, 1109,  140, 1023,  187,  372,  403,
+      553,  401, 1095,  565, 1792, 1818, 1083, 9159,  643,  669,
+      589, 1844, 1870, 1580, 1865, 1867, 1868, 1905, 1926, 1922,
+
+     1925, 1078, 9159,  837,  437,  677,  249,  660, 1072,  712,
+     9159, 1062,  844,  625, 1874, 1993, 2022, 1042,  864,  473,
+      904,  621,  506,  651,  721,  798,  791,  890,  912,  936,
+      907,  725, 1029, 1143,  729, 9159, 1114, 1179, 2097, 2112,
+     2127,  229,  937, 1033, 1012, 1006,  994,  943,  883,  974,
+      891, 9159, 1476, 2142, 2157, 2172, 2182, 2202, 2178, 2180,
+     2200, 2203, 2223, 2243, 2246, 2244, 2276, 2269, 2299, 2307,
+     2301, 2324, 2344, 2351, 2377,  901, 1018, 2374, 2394, 2397,
+     2414, 2495, 2434, 2440, 2465, 2472, 2518, 2521, 2515, 2548,
+     2556, 1138, 2564,  968, 9159, 2581, 2597, 2604, 2627, 2649,
+
+     2650, 2690, 2693, 2686, 2726, 2738, 2746, 2747, 2763, 2783,
+     2799, 2800, 2803, 2820, 2840, 2843, 2870, 2891, 2895, 2903,
+     2926, 2928, 2935, 2961, 2981, 2958, 2984, 2978, 3004, 3011,
+     3027, 3052, 3048, 3059, 3085, 3068, 3105, 3111,  196,  203,
+      976,  383,  974,  988, 1018, 1014, 1025, 1029, 1042,  253,
+     3174, 3200, 3226, 1067, 1182, 1172, 3252,    0,  418,  288,
+     1096, 3228, 3229, 3231, 3251, 3267, 3287, 3290, 1188, 1566,
+      973,  740, 9159,  938,  866, 9159, 1268, 1178,  931, 1170,
+     1241, 1299, 3354, 3381,    0,  903, 3408, 1148, 1116, 1177,
+     1322, 1145,  410, 1415, 1235,  460, 1292, 1218, 1323, 1022,
+
+      963, 1520, 1662, 3418, 3430, 3440, 3450, 3460, 3470,  889,
+     9159,  865, 9159, 9159, 9159, 9159, 9159, 1239,  853, 9159,
+      846, 2472, 3480, 3490, 3500, 3510, 3520, 3530, 3545, 3555,
+     3575, 9159, 3289, 3553, 3573, 3551, 3574, 3590, 3596, 3612,
+     3628, 3634, 3635, 3655, 3671, 3651, 3687, 3688, 3696,  459,
+     3728, 3736, 3740, 3784, 3868, 9159, 3780, 3776, 3807, 3811,
+     3850, 3912, 3872, 3920, 3921, 1351, 9159, 3828, 4005, 4060,
+     4095, 3904, 4063, 4069, 1258, 4096, 4104, 4126, 4134, 4156,
+     4165, 4196, 4205, 1409, 9159, 4208, 4197, 1476, 9159, 4235,
+     4241, 4257, 4261, 4273, 4284, 4293, 4305, 4309, 4332, 4336,
+
+     4353, 4316, 4359, 4362, 4384, 4407, 4385, 4416, 4423, 4448,
+     4455, 4456, 4486, 4494, 4488, 4511, 4527, 4519, 4531, 4554,
+     1498, 9159, 4552, 4575, 4584, 4587, 4607, 4610,  493,  529,
+      551,  476, 1287,  816,  953, 1119, 1293,  841, 4678, 4704,
+     4730, 1607, 1346, 1458, 4756, 1362, 1397, 4733, 4732, 4759,
+     4627, 4768, 4817,  733, 1619, 1594, 1406,  728, 1537, 9159,
+     1571, 1651, 1625, 1613, 4839, 4867, 4894, 1627, 1658, 1686,
+     1714, 1394,    0, 1756, 1574,    0, 1668,  724, 1709,  724,
+     1763, 1775, 9159, 9159,  708, 9159, 9159, 4904, 4916, 4926,
+     4936, 4771, 4931, 5013, 4934, 5068, 5069, 5071, 5075, 5072,
+
+     5120, 5121, 5123, 1725, 5127, 5153, 5176, 1832, 5175, 5179,
+     1458, 1493, 1739, 1516, 1519, 1873, 1592, 1739, 5201, 5224,
+     5202, 5241, 5240, 5257, 5278, 5280, 5301, 5284, 5352, 9159,
+     5351, 5346, 5349, 5353, 1802, 9159, 5355, 5385, 5401, 9159,
+     5405, 5408, 5412, 5428, 5449, 5451, 5458, 5460, 5495, 5501,
+     5531, 5527, 5539, 5571, 5564, 5575, 5591, 5602, 5623, 5614,
+     5634, 5635, 5660,  693, 5666, 5667, 5692, 5703, 5715, 9159,
+     5723, 5719, 5740, 5746,  846, 1103, 1234, 1788, 1768, 1386,
+     1788, 1615, 1847, 1854,  236,  590, 1781, 1913,  715, 5809,
+     1790, 1645, 2264, 9159, 5785, 5805, 1690, 5806, 5807, 2344,
+
+     9159, 1951, 1858, 1924, 2256,  679, 1930, 1879, 5870, 5880,
+     5907, 5917, 1811,  658, 5946,  624,    0, 9159, 6034,    0,
+        0,  613,  609, 9159,  604,  586, 2245, 2364, 2389, 9159,
+     9159, 6063, 6118, 6139, 6138, 6134, 6135, 6141, 6161, 6173,
+     6184, 6209, 6217, 1654, 6260, 6248, 6216, 1844, 1864, 6239,
+     6280, 9159, 1689, 9159, 1930, 1750, 1763, 1934, 1933, 2077,
+     6300, 6292, 6317, 6337, 6338, 6344, 6369, 6376, 2212, 9159,
+     6360, 6413, 6392, 6412, 6424, 6433, 6456, 6435, 6465, 6476,
+     6488, 6497, 6508, 6509, 6552, 6529, 6540, 6549, 6560, 6585,
+     6593, 6605, 6628, 2392, 6636, 6637, 6648, 6659, 6694, 6685,
+
+     6686, 6775, 2286,  518, 2092, 2103, 1938, 2148, 2420, 2303,
+      472,  442, 2196,    0, 1803, 6692, 6717, 6768, 6756, 2424,
+     2334,  426,  422, 2432,  378, 1883, 6858, 6945, 6974,  337,
+     9159, 1922, 9159,    0,  328, 9159,  314, 2481, 2510, 9159,
+     6929, 6757, 7029, 7031, 7037, 7040, 7033, 7077, 7070, 7086,
+     2264, 2842, 7093, 7097, 7118, 9159, 2372, 7129, 2384, 2060,
+     2411, 2418, 2078, 2421, 2139, 7138, 7149, 7170, 7179, 7195,
+     7201, 7227, 7234, 7236, 2483, 3160, 7259, 7257, 7279, 7280,
+     7282, 7302, 7318, 2564, 7325, 7319, 7345, 7356, 7377, 7357,
+     7368, 7388, 2513, 2467, 7400, 2603, 7389, 7425, 2468, 2371,
+
+     2235, 2479,  361,  296,  182, 7409, 7432, 2249, 7455,  622,
+     2529,  227, 1008, 7505,    0,  207, 7482, 7503, 7505, 7514,
+     7535, 7536, 7544, 9159, 2413, 2526, 7567, 7571, 2546, 7593,
+     2547, 2562, 2567, 2526, 2575, 9159, 2526, 7587, 7625, 7594,
+     7631, 7632, 7648, 7657, 7668, 3179, 3203, 2672, 3229, 3335,
+     7684, 7688, 7709, 2597, 7705, 7725, 7732, 7736,  178, 7758,
+     2596, 7775, 7769, 2619, 2617, 2641, 2696, 2668, 7795, 7801,
+     7807, 2677, 2720, 3150, 7827, 7818, 7834, 7867, 7850, 2625,
+     2685, 7870, 7890, 2688, 7859, 2699, 2731, 2741, 2661, 2665,
+     9159, 7911, 7907, 7910, 7927, 7933, 7963, 2822, 3360, 3384,
+
+     3411, 4103, 4220, 7959, 2702, 7970, 7966, 2741, 7986, 2738,
+     8003, 8019, 2758, 9159, 2765, 2781, 2809, 2818, 8030, 8026,
+     2900, 2883, 2903, 2951, 8042, 8051, 2820, 2829, 8063, 8086,
+     9159, 2838, 9159, 2846, 9159, 2846, 8088, 8090, 8113, 8134,
+     3067, 4430, 2880, 8136,  175, 2911, 8125, 8156, 2877, 9159,
+     1190, 2938, 2908, 8157, 3034, 3081, 3049, 3028, 8173, 2959,
+     2985, 8189, 8182, 3029, 9159, 3039, 8205, 8212, 8214, 3241,
+     4684, 3056, 8235, 3049, 9159, 3056, 3212, 3072,    0, 8237,
+     1210, 3169, 3157,  144, 3103, 3103, 8257, 8260, 9159, 3110,
+     8283, 3255, 4708, 3110, 8290,  123, 9159, 3235, 3207, 3329,
+
+     3387, 3558, 3232, 3256, 8306, 8313, 3278, 8315, 8396, 4870,
+     3259, 8391, 3280, 3664,    0, 3349, 3414, 9159,  103, 9159,
+     3346, 8392, 9159, 3745, 4900, 8473, 3347, 8450,   90, 1237,
+     1328, 3570, 8470, 4973, 4977, 3380, 8471, 9159, 3676, 3645,
+     9159, 9159, 3693, 3608, 3764, 3684, 3616, 1433, 3705, 3782,
+     3810, 3774, 3875, 9159, 3852, 3697, 3910, 3892, 3896, 9159,
+     9159, 8553, 8565, 8577, 8589, 8601, 8613, 8621, 8623, 8635,
+     8647, 8659, 8671, 8678, 8687, 8699, 8711, 8723, 8735, 8747,
+     8754, 8762, 8774, 8786, 8798, 8810, 8822, 8834, 8846, 8858,
+     8870, 8882, 8894, 8906, 8918, 8930, 8942, 8954, 8966, 8978,
+
+     8990, 9002, 9014, 9026, 9038, 9050, 9062, 9074, 9086, 9098,
+     9110, 9122, 9134, 9146
+    } ;
+
+static yyconst flex_int16_t yy_def[1215] =
+    {   0,
+     1161,    1, 1162, 1162,    1,    2, 1163, 1163,    1,    2,
+        1,    2, 1161, 1161, 1161, 1161, 1161, 1164, 1165, 1161,
+     1161, 1166, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1168,
+     1161, 1161, 1161, 1161, 1169, 1169,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36, 1161, 1161,   53, 1170, 1161,   36,   36,   36,
+       36,   36,   36, 1161, 1171, 1161, 1171, 1171, 1171, 1161,
+     1161, 1172, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1164, 1164, 1164, 1165, 1161, 1165, 1165, 1166, 1161, 1166,
+     1166, 1167, 1173, 1167, 1161, 1167, 1167, 1161, 1161, 1161,
+
+     1174, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1175,
+     1161, 1161, 1161,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1169,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   53,  173, 1176, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161,  173, 1161,  173, 1161, 1170, 1161, 1170, 1170,
+     1170, 1161, 1161, 1177,   36,   36,   36,   36,   36,   36,
+
+       36, 1171, 1161, 1171, 1171, 1171, 1171, 1178, 1179, 1179,
+     1161, 1179, 1179, 1179, 1180, 1179, 1161,  217,  217,  217,
+      217,  217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166,
+     1166, 1173, 1173, 1173, 1173, 1161, 1167, 1167, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1181, 1161, 1161, 1161, 1161, 1161,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36, 1182,  131,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36, 1161,   36, 1161, 1161,   36,   36,   36,   36,   36,
+
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,  173,  173,
+     1161,  173, 1176, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+      185, 1161, 1161, 1170, 1170, 1170, 1161, 1177, 1177, 1177,
+     1177,   36,   36,   36,   36,   36,   36,   36, 1171, 1171,
+     1183, 1183, 1161, 1179, 1179, 1161, 1179, 1179, 1180, 1180,
+     1180, 1180, 1179, 1179,  217,  217, 1179,  217,  217,  217,
+      217, 1161, 1161, 1161, 1164, 1164, 1165, 1165, 1166, 1166,
+
+     1173, 1167, 1167, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1181, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
+       36,   36,   36,   36, 1161, 1161,   36,   36,   36,   36,
+       36,   36,   36,   36,   36, 1161, 1161,   36, 1161,   36,
+       36,   36,   36,   36, 1161,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161, 1161,   36,   36, 1161, 1161,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1161, 1161,   36,   36,   36,   36,   36,   36,  173,  173,
+      173, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  185, 1161,
+     1161, 1170, 1170, 1170, 1161, 1177, 1177,   36,   36,   36,
+       36,   36,   36, 1161, 1171, 1171, 1171, 1183, 1183, 1161,
+     1179, 1179, 1180, 1180, 1179, 1179, 1179,  217,  217,  217,
+      217, 1161, 1184, 1161, 1164, 1185, 1165, 1186, 1187, 1188,
+     1189, 1190, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+
+       36,   36,   36, 1161,   36,   36,   36, 1161,   36,   36,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36, 1161,
+     1161,   36,   36,   36, 1161, 1161,   36,   36,   36, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36, 1161,
+       36,   36,   36,   36,  173,  173,  173, 1161, 1161, 1161,
+     1161, 1161, 1161,  173, 1161, 1161, 1170, 1170, 1191, 1161,
+     1177, 1192, 1161, 1161,   36,   36, 1161,   36,   36, 1161,
+
+     1161, 1161, 1171, 1171, 1179, 1193, 1180, 1194, 1179, 1179,
+     1179, 1179,  217,  217, 1161,  217, 1195, 1161, 1161, 1196,
+     1197, 1198, 1199, 1161, 1200, 1201, 1202, 1203, 1203, 1161,
+     1161, 1161,   36, 1161,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36, 1161, 1161,   36,
+       36, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36, 1161, 1161,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+
+       36, 1161,  802,  802, 1161, 1161, 1161, 1161,  802, 1204,
+     1205, 1204, 1206, 1207, 1207,   36,   36,   36,   36, 1208,
+     1208, 1209, 1210, 1211, 1212, 1212, 1161, 1210, 1161,  829,
+     1161, 1161, 1161, 1197, 1199, 1161, 1201, 1203, 1203, 1161,
+     1161,   36,   36,   36,   36,   36,   36,   36,   36,   36,
+     1161, 1161,   36,   36,   36, 1161, 1161,   36, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,   36,
+       36,   36,   36,   36, 1161, 1213,   36,   36,   36,   36,
+       36,   36,   36, 1161,   36,   36,   36,   36,   36,   36,
+       36,   36, 1161, 1161,   36, 1161,   36,   36, 1161, 1161,
+
+     1161, 1161, 1204, 1204, 1206,   36,   36, 1161,   36, 1208,
+     1208, 1210, 1211, 1210,  829,  829,   36,   36,   36,   36,
+       36,   36,   36, 1161, 1161, 1161,   36,   36, 1161,   36,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,
+       36,   36,   36,   36,   36, 1213, 1213, 1161, 1214, 1213,
+       36,   36,   36, 1161,   36,   36,   36,   36, 1161,   36,
+     1161,   36,   36, 1161, 1161, 1161, 1204, 1206,   36,   36,
+       36, 1208, 1208, 1211,   36,   36,   36,   36,   36, 1161,
+     1161,   36,   36, 1161,   36, 1161, 1161, 1161, 1161, 1161,
+     1161,   36,   36,   36,   36,   36,   36, 1161, 1214, 1214,
+
+     1213, 1214, 1214,   36, 1161,   36,   36, 1161,   36, 1161,
+       36,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,   36,
+     1208, 1208, 1211, 1211,   36,   36, 1161, 1161,   36,   36,
+     1161, 1161, 1161, 1161, 1161, 1161,   36,   36,   36,   36,
+     1161, 1213, 1161,   36, 1161, 1161,   36,   36, 1161, 1161,
+     1204, 1206, 1206,   36, 1208, 1208, 1211, 1211,   36, 1161,
+     1161,   36,   36, 1161, 1161, 1161,   36,   36,   36, 1161,
+     1213, 1161,   36, 1161, 1161, 1161, 1204, 1206, 1206,   36,
+     1208, 1208, 1211, 1211, 1161, 1161,   36,   36, 1161, 1161,
+       36, 1161, 1213, 1161,   36, 1161, 1161, 1204, 1206, 1208,
+
+     1208, 1211, 1161, 1161,   36,   36, 1161,   36, 1161, 1213,
+     1161,   36, 1161, 1204, 1206, 1208, 1208, 1161, 1211, 1161,
+     1161,   36, 1161, 1161, 1213, 1213, 1161,   36, 1161, 1204,
+     1208, 1161,   36, 1213, 1214, 1161,   36, 1161, 1204, 1208,
+     1161, 1161, 1204, 1208, 1204, 1208, 1204, 1208, 1204, 1208,
+     1204, 1208, 1204, 1161, 1208, 1208, 1208, 1208, 1208, 1161,
+        0, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161
+    } ;
+
+static yyconst flex_int16_t yy_nxt[9249] =
+    {   0,
+       14,   15,   16,   17,   18,   19,   14,   20,   21,   22,
+       23,   24,   25,   26,   25,   27,   25,   28,   29,   30,
+       30,   30,   30,   30,   30,   30,   30,   30,   30,   25,
+       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
+       42,   49,   50,   51,   42,   42,   52,   42,   42,   42,
+       25,   25,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
+       50,   51,   42,   42,   52,   42,   42,   42,   14,   53,
+       54,   55,   56,   71,   67,   66,   67,   68,   76,   77,
+
+       78,  203, 1138,   74,   72,  211,  206,   57,   57,   57,
+       57,   57,   57,   57,   57,   57,   57,   75,   79,   77,
+       79,   79,   77,   79,   58,   59,   82,   73,   60,   85,
+       61,   69,   74,   78,   77,   80,   74,   74,   74, 1113,
+       83,   62,   63,  176,   89,   75,  211,   74,   99,  176,
+       75,   75,   75,   58,   59,   82,   73,   60,  224,   61,
+       69,   75,  115,   86,  203,   74,   74,   74,   83,   62,
+       63,   74,   98,   74,   74,   93,   74,   87,   75,   75,
+       75,   90,   94,   95,  109,   75,  224,   75,   75,   75,
+     1074,  115,   86,   74, 1008,   91,  110,  529,  223,  530,
+
+       74,  226,   74,   74,  531,   87,  530,   75,  227,  207,
+       90,   74,   96,   75,   74,   75,   75,   74,   74,   74,
+      115,  346,   74,   91,  387,   75,   97,  223,   75,  211,
+      226,   75,   75,   75,  142,   75,  227,  207,  115,  176,
+       74,   96,  161,   74,  968,  176,   74,   74,   74,  115,
+      346,  203,  112,   75,   97,  100,   75,  100,   74,   75,
+       75,   75,  142,   76,   77,   78,  410,  115,  204,  203,
+      204,  161,   75,  101,  101,  101,  101,  101,  101,  101,
+      101,  101,  101,   85,  115,  115,  370,   74,  102,  143,
+      115,  538,  103,   74,  104,  410,  144,  145,  188,  105,
+
+       75,  106,  107,  201,  146,  205,   89,   75,   79,   77,
+       79,  108,  228,  115,  115,  370,   89,  102,  143,  115,
+      538,  103,   74,  104,  144,  145,   85,  105,  546,  106,
+      107,  201,  146,   85,  205,   75,   78,   77,   78,  108,
+      113,  228,  114,  114,  114,  114,  114,  114,  114,  114,
+      114,  114,  115,  115,  387,  231,  129,  546,  116,  117,
+      130,  138,  118,  188,  139,  242,  131,  140,  119,  243,
+      132,  250,  229,  141,   89,  120,  121,  225,   77,  225,
+      211,  115,  115,  231,  531,  129,  530,  116,  117,  130,
+      138,  118,  139,  242,  131,  140,  119,  243,  132,  250,
+
+      229,  141,  251,  120,  121,  113,  230,  114,  114,  114,
+      114,  114,  114,  114,  114,  114,  114,  347,  124,  359,
+      115,  359,  122,  967,  211,  125,  147,  118,  211,  126,
+      251,  133,  127,  134,  148,  230,  135,  136,  150,  203,
+      149,  123,  128,  137,  188,  347,  151,  124,  573,  115,
+      348,  122,  152,  350,  125,  147,  118,  126,  153,  133,
+      127,  134,  157,  148,  135,  136,  168,  150,  149,  123,
+      128,  137,  115,  169,  188,  151,  158,  573,  348,  159,
+      152,  350,  160,  170,  207,  154,  153,  155,  244,  162,
+      387,  157,  156,  163,  675,  168,  676,  164,  576,  115,
+
+      604,  115,  169,  245,  158,  165,  171,  159,  166,  167,
+      160,  170,  207,  154,  678,  155,  172,  244,  162,  804,
+      156,  389,  163,   78,   77,   80,  164,  576,  115,  604,
+      677,  245,  676,  165,   93,  171,  166,  167,  183,  184,
+      185,   94,   95,  678,  172,  173,   77,  174,  175,  389,
+      188,  392,  677,  176,  676,  189,  186,  186,  186,  186,
+      186,  186,  186,  186,  186,  186,   79,   77,   79,   93,
+       79,   77,   79,   79,   77,   79,   94,   95,  115,  392,
+      177,  178,  208,   74,  179,  208,  180,  190,   89,  198,
+      248,  188,  142,  176,  233,  234,  233,  181,  182,  176,
+
+      249,  191,  235,  236,  224,  208,   89,  115,  208,  177,
+      178,  349,   74,  179,   85,  180,  190,  198,  836,  248,
+      142,  210,  211,  210,  203,  181,  182,  211,  249,  191,
+      192,  194,  224,  212,  208,   93,  176,  208,  387,  349,
+      356,  387,   94,   95,  110,  188,  193,  193,  193,  193,
+      193,  193,  193,  193,  193,  193,  197,  391,  195,  213,
+      129,  372,  373,  372,  130,  125,   74,  237,  356,  126,
+      131,  188,  196,  214,  132,  387,  378,  354,  115,  203,
+       75,  211,  128,  143,  972,  197,  391,  195,  213,  129,
+      144,  199,  168,  130,  125,   74,  237,  126,  131,  169,
+
+      196,  214,  132,  355,  378,  393,  354,  115,   75,  170,
+      128,  369,  143,  375,  376,  375,  200,  188,  144,  199,
+      794,  168,  394,   77,  394,  731,   89,  234,  169,  724,
+      373,  234,  355,  393,  401,  236,  554,  170,  401,  236,
+      369,  559,  560,  559,  200,  209,  210,  211,  210,  209,
+      209,  209,  215,  209,  209,  209,  209,  209,  209,  209,
+      209,  209,  216,  209,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  209,  209,  209,  209,  209,  195,
+      218,  218,  218,  218,  219,  218,  125,  218,  218,  218,
+      220,  218,  218,  196,  218,  218,  218,  218,  221,  218,
+
+      218,  218,  218,  222,  218,  209,  209,  218,  195,  218,
+      218,  218,  218,  219,  218,  125,  218,  218,  220,  218,
+      218,  196,  218,  218,  218,  218,  221,  218,  218,  218,
+      218,  222,  218,  209,   93,  239,  240,  246,  204,  203,
+      204,   94,   95,  395,  554,  396,  211,  802,  241,  803,
+      680,  110,  247,  111,  111,  111,  111,  111,  111,  111,
+      111,  111,  111,  587,  239,  240,  246,  375,  376,  375,
+      586,  395,  339,  396,  340,  205,  241,  258,  377,  680,
+      247,  387,  584,  238,  257,  257,  257,  257,  257,  257,
+      257,  257,  257,  257,  115,   85,  115,  261,  388,  115,
+
+      115,  115,  115,  268,  205,  115,  583,  377,  115,   89,
+     1161,  238,  100,  115,  100,  115,  115,   85,  259,  115,
+      387,  387,  115,  115,  341,  115,  261,  388,  115,  115,
+      115,  115,  268,  211,  115,  397,  419,  115,   89, 1161,
+      211,  115,  421,  115,  115,  102,  259,  115,  115,  103,
+      115,  104,  341,  115,  411,  390,  105,  450,  106,  107,
+      417,  400,  260,  397,  419,  234,  398,  115,  108,  294,
+      421,  294,  401,  236,  102,  373,  188,  115,  103,  295,
+      104,  399,  115,  390,  105,  450,  106,  107,  681,  400,
+      260,  420,  412,  418,  398,  115,  108,  253,  253,  253,
+
+      253,  253,  253,  253,  253,  253,  253,  115,  264,  399,
+      211,  416,  115,  115,  115,  254,  255,  681,  262,  115,
+      412,  418,  263,  415,   89,  265,  115,  115,  256,  414,
+      233,  234,  233,  115,  349,  258,  115,  264,  235,  236,
+      532,  115,  115,  115,  254,  255,  262,  115,  115,  266,
+      413,  263,  115,  265,  115,  115,  256,  344,  115,  387,
+      580,  115,  349,  115,  211,  533,  115,  534,  532,  188,
+      974,  345,  115,  535,  211,  265,  115,  115,  266,  115,
+      203,  115,  536,  115,  115,  188,  344,  115,  115,  580,
+      267,  537,  115,  533,  115,  534,  342,  269,  115,  345,
+
+      115,  535,  115,  265,  804,  115,  803,  542,  115,  115,
+      536,  188,  115,  115,  115,  342,   93,  115,  267,  537,
+       89,  270,  271,   94,   95,  269,  115,  272,  115,  115,
+      115,  273,  274,  387,  115,  115,  542,  115,  115,  292,
+      115,  292,  547,  115,  233,  234,  233,  275,  115,  270,
+      271,  115,  235,  236,  115,  272,  115,  682,  115,  402,
+      273,  274,   89,  115,  115,  387,  115,   85,  569,  115,
+      547,  380,  211,  380,  188,  275,  115,  203, 1161,  115,
+      211,   93,  115,  276,  188,  276,  682,  402,   94,   95,
+      203,  475,  188,  568,  387,  115,  569,  572,   70,  113,
+
+      115,  277,  277,  277,  277,  277,  277,  277,  277,  277,
+      277,  115,  203,  281,  115,  115,  115,   66,  282,  475,
+      115,  568,  280,   85,  115,  572,  544,  543,  555,  115,
+      115,  570,  562,  403,  115,  804,  278,  803,  279,  188,
+      115,  281,  115,  211,  115,  115,  115,  282,  115,  115,
+      280,  115, 1077,  115,  544,  543,  578,  555,  115,  570,
+      562,  403,  115,  284,  278,  115,  279,  115,  283,  115,
+      211,  115, 1100,  115,  115,  115,  115,  115,  115,  285,
+      115,  563,  115,  289,  288,  578,  286,  575,  115, 1161,
+      287,  284,  115,  115,  585,  115,  283,   85,  115, 1139,
+
+      115,  211,  115,  115,  115,  115,  640,  115,  285,  115,
+      563,  289,  288,  561,  286,  575,  115,  292,  287,  292,
+      115,  290,  585,  115,  115,   89,  294,  115,  294,  115,
+      203,  683,  115,  115,  640, 1161,  295,  291,  115,  387,
+      679,  561,  296,  115,  577,  564,  115, 1161,  188,  290,
+      115,  115,  466,  115,  466,  115,  115,  115,  115,  261,
+      683,  115,  115,  301,  115,  291, 1161,  571,  679,  293,
+      296,  115,  577,  564,  115,  579,  115, 1161,  115,  115,
+      115, 1161,  297,  467,  115,  115,  115,  697,  261,  697,
+     1140,  115,  301,  115,  298,  571,  299,  293,  688,  300,
+
+      115, 1161,  115,  579,  115,  115,  115,  115,  203,  115,
+      484,  297,  484,  691,  115,  303,  574,   77,  574,  115,
+      485,  115,  298,  302,  299,  115,  688,  300,  304,  115,
+      115,  115,  717,  115,  115,  203,  115,  115,  115, 1161,
+     1161,  691,  115,  303,  115,  305,  692,  115, 1161,  115,
+      306,  302,  115,  704,  115, 1161,  115,  304, 1161,  115,
+      188,  717,  115,  115,  115, 1161,  115,  115,  115,  115,
+     1161,  115,  115,  305,  692,  308,  307,  488,  306,  488,
+      115,  704,  115,  115,  115, 1161,  115,  489, 1161,  115,
+      310,  115,  115,  115,  115, 1150,  689,  115,  115,  521,
+
+      309,  521, 1161,  308,  307,  311,  752, 1161,  115,  522,
+      115,  115,  115,  239,  240,  115,  115,  115,  115,  310,
+      115,  115,   93,  115,  315,  689,  241, 1161,  309,   94,
+       95,  312,  115,  311,  752,  115,  115,  115,  559,  560,
+      559,  115,  239,  240, 1161,  115,  115,  753, 1161,  313,
+      115,  115,  314,  315,  241,  115,  318,  115, 1161,  312,
+      115,  115,  115,  115,  755,  316,  115,  556,  203,  556,
+      756,  317,  581,  211,  115,  753,  115,  313, 1161,  115,
+      314,  359,  115,  359,  115,  318,  115,  115,  319,  115,
+      320,  115,  755,  115,  316,  556,  203,  556,  756,  317,
+
+      581,  115,  115,  324,  115, 1161,  321,  322,  557,  188,
+      323,  115,  720,  115,  360,  211,  115,  319,  115,  320,
+      115,  203,  115,  705,  325,  115,  326,  211,  361,  115,
+     1161,  324,  115,  327,  321,  322,  557,  557,  323,  115,
+      115,  720,  115,  360,  387,  115,  815,  115,  815,  115,
+      759,  705,  325,  211,  115,  326,  361,  328,  687,  115,
+      115,  327,  708,  329,   93,  557,  808,  115,  115,  115,
+      703,   94,   95,   85,  115,  387,  707,  330,  759,  713,
+      265, 1161,  115,  115,  331,  328,  687,  115,  115,  706,
+      708,  697,  329,  697,  808,  332,  714,  115,  703,  851,
+
+      582, 1161,  115,  387,  707,  330,  722,  713,  265,  115,
+      115,   89,  115,  331,  115,  115, 1161,  115,  706,  335,
+      115, 1161,  333,  332,  715,  714,  334,  851,  115,  582,
+      115,  387,  115, 1161,  115,  722,  859,  115,  115, 1161,
+      336,  115, 1161,  115,  115,  337,  115,  725,  335,  115,
+      333,  115,  716,  715,  334, 1161,  115,  719,   77,  719,
+      115,  115,  115,  115,  859,   93,  115,  744,  115,  336,
+      115,  338,   94,   95,  337,  115,  725,   93,  754,  115,
+      760,  716,  115,  188,  729,  730, 1161, 1161,  115,  693,
+     1161,  693,  115,  342,  184,  351,  744,  115,  861,  694,
+
+      338,  727,  806,  635,  815,  635,  815,  754,  862,  760,
+      115,  352,  352,  352,  352,  352,  352,  352,  352,  352,
+      352,  353,  807,  810, 1161,  805,  861,  176,  387, 1161,
+      727,  806,  813,  608,  636,  608,  862,  352,  352,  352,
+      352,  352,  352,  352,  352,  352,  352,  353,  700,  827,
+      700,  807,  810,  176,  805,  804,  184,  809,  701, 1161,
+      203,  813,  702,  352,  352,  352,  352,  352,  352,  352,
+      352,  352,  352,  353,  748,  380,  211,  380,  827,  176,
+      826,  211,  826,  856,  826,  211,  826,  110,  749,  357,
+      357,  357,  357,  357,  357,  357,  357,  357,  357,  115,
+
+      820,  115,  115,  748,  115,  857,  115,  115,  381, 1161,
+      267,  757,  856,  270,  363,  188,  749,  362,  115,  272,
+      115,  364,  382,  832,   77,  832,  203,  758,  115,  820,
+      115,  115,  211,  115,  857,  115,  115,  381,  267,  115,
+      757,  270,  363, 1161,  115,  362,  115,  272,  115,  364,
+      382,  811,  702,  365,  702,  758,  115, 1161,  115,  115,
+      115,  115,  297,  368,  115,  115,  702,  860,  115,  863,
+     1161,  367,  824,  115,  298,  115,  299,  821,  115,  366,
+      811,  365,  864,  901, 1161,  115,  115, 1161,  115,  115,
+      115,  297,  368,  115,  115,  211,  860, 1161,  863,  367,
+
+     1161,  824,  298,  115,  299,  821,  115,  366, 1161, 1161,
+      864,  901,  383,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  374,  374,  211,  374,  374,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  384,
+      374,  385,  385,  385,  385,  385,  385,  385,  385,  385,
+      385,  374,  374,  374,  374,  374,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  374,  374,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      374,  404, 1161,  404,  932,  865,  405,  405,  405,  405,
+      405,  405,  405,  405,  405,  405,  406, 1161,  406,  935,
+      899,  407,  407,  407,  407,  407,  407,  407,  407,  407,
+      407,  408,  932,  408,  865,  900,  409,  409,  409,  409,
+      409,  409,  409,  409,  409,  409,  423,  935,  423,  899,
+     1161,  424,  424,  424,  424,  424,  424,  424,  424,  424,
+      424,  425, 1161,  425,  900, 1161,  426,  426,  426,  426,
+      426,  426,  426,  426,  426,  426,  427,  902,  427,  432,
+      937,  428,  428,  428,  428,  428,  428,  428,  428,  428,
+
+      428,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      257, 1161,  115,  769,  115,  769,  902,  115,  937,  115,
+      429,  430,  430,  430,  430,  430,  430,  430,  430,  430,
+      430,  115,  433,  115,  115,  905,  908,  115,  908,  115,
+      431,  115,  115,  115,  770,  434,  115,   93,  115,  429,
+      908,  435,  908,  115,  839,  840,  115,  115,  211,  115,
+      433,  115,  115,  115,  905,  693,  115,  693,  115,  431,
+      436,  115, 1161,  434, 1161,  694,  115,  115,  115,  435,
+      115,  115,  115,  115,  115,  115,  115,  804,  439,  803,
+      437,  115, 1161, 1161,  822,  176,  115,  115,  436,  115,
+
+      438,  805,  924,  115,  115,  188,  115,  115,  115,  115,
+      115,  115,  115, 1161,  115,  115,  439, 1161,  437, 1161,
+      441,  440,  115,  822,  115,  115, 1161,  115,  438,  115,
+      805,  924,  115,  115, 1161,  115,  203,  115,  115,  115,
+      115,  115,  903, 1161,  115,  700,  115,  700,  441,  440,
+      115,  442,  115,  443,  445,  701,  444,  115,  115,  702,
+      115, 1161,  115,  115,  115,  446,   93,  115, 1161,  115,
+      115,  903,  911,   94,   95,  115, 1161,  115,  115,  442,
+      115,  443,  445,  115,  444,  115, 1161,  115,  115,  447,
+      115,   93,  115,  893,  446,  893,  448,  115,   94,   95,
+
+     1161,  911, 1161,  894,  115,  115, 1161,  115,  115,  451,
+      929,  115,  115,  115,  115,  449,  115,  447,  965,  115,
+      931,  804,  184,  809,  448,  115,  203,  115,  115,  176,
+      115,  453,  115,  115,  211,  452,  115,  115,  451,  929,
+      115,  466,  115,  466,  449,  115,  965,  115,  115,  931,
+      115,  933,  454,  115, 1161,  115,  934,  115,  115,  936,
+      453,  980,  115,  910,  452,  115, 1161,  115,  115, 1161,
+     1161,  913,  467,  115,  115,  115,  465,  115,  115,  115,
+      933,  454,  115,   93,  875,  934,  875,  115,  936,  980,
+       94,   95,  910,  115,  876,  115,  455,  115,  455,  115,
+
+      913,  959,  115,  115,  115,  465,  115,  964,  115,  239,
+      240,  115,   93,  966,  893,  115,  893,  468,  469,   94,
+       95,  115,  241, 1161,  894,  115, 1161,  456,  115,  115,
+      959,  203,  457,  115,  458,  115,  964,  459,  239,  240,
+      115,  460,  966, 1161,  461,  468,  469,  462,  463,  472,
+      241,  464,  115,  115,  115,  115,  470,  115,  115,  471,
+      115,  457,  989,  458,  991,  884,  459,  884,  115,  460,
+     1161,  115,  461, 1161,  115,  462,  463,  981,  472,  464,
+      973,  115,  115,  115,  115,  470,  115,  115,  471,  115,
+      115,  989,  474,  991,  473,  115,  115,  984,  115,  115,
+
+      986,  115,  115,  115,  896,  981,  896,  987,  973,  115,
+     1161,  115,  476,  954, 1161,  115,  115,  115,  988,  115,
+      115,  474,  473,  990,  115,  984,  477,  115,  986,  115,
+     1010,  115,  115, 1161,  115,  987,  115,  115,  115,  961,
+      476,  954,  478,  115,  115,  115,  988, 1161, 1005,  115,
+      115,  990, 1161, 1013,  477, 1161, 1161,  115,  479, 1010,
+      115,  115,  115, 1161, 1161,  115,  115,  115,  961, 1014,
+      478, 1027,  115,  998,  948,  998, 1005, 1015,  115,  203,
+      115,  480, 1013,  115,  115,  115,  479,  481,  115,  115,
+      115,  484,  483,  484,  488,  115,  488, 1014,  188, 1027,
+
+      482,  485,  115,  115,  489, 1017, 1015, 1018,  115,  480,
+     1161, 1161,  115,  115, 1035, 1021,  481,  115,  115, 1036,
+      115,  483,  203, 1028,  115,  115, 1031,  115,  482,  115,
+      115,  115,  115, 1016, 1017,  486, 1018, 1161,  490,  115,
+      492, 1032, 1035,  115, 1021,  487,  115, 1036,  491,  115,
+     1043, 1161, 1028,  115,  115, 1031,  115, 1161,  115, 1022,
+      115,  115, 1016,  486,  493,  115,  490,  115,  492, 1033,
+     1032,  115,  115,  487,  115, 1034,  491,  115, 1043,  115,
+      115,  115, 1045,  188,  495,  115,  115, 1161, 1022,  115,
+     1046,  494,  496,  493,  115, 1161, 1161,  115, 1033,  115,
+
+      115,  115,  115, 1050, 1034, 1161,  115,  115, 1161,  115,
+      115, 1045, 1049,  495,  115,  115,  115,  115, 1046,  494,
+      496,  497,  115, 1041,  948, 1041,  115,  115,  115, 1051,
+      498,  115, 1050,  115,  115, 1161,  115,  500,  115,  115,
+     1049,  499,  115,  852,  115,  852,  115, 1052, 1161,  497,
+     1161,  115,  115,  115,  115, 1161,  115, 1051,  498,  115,
+     1053, 1161,  115,  115,  115, 1061,  500,  115,  115, 1060,
+      499,  115,  501,  115,  115, 1161, 1052,  115,  925,  115,
+      115,  115,  115,  115,  115,  203, 1064,  502,  115, 1053,
+      503,  926, 1065,  115, 1061, 1161,  115, 1060,  504, 1066,
+
+      501,  115,  203,  115,  115,  211,  115,  925,  115,  115,
+      505,  115, 1161, 1161, 1064,  502, 1072, 1056,  503,  926,
+     1065,  115, 1076,  115,  115,  115,  504, 1066, 1161,  115,
+      115, 1161,  507,  115,  115, 1161,  506,  115,  115,  505,
+      508, 1057,  115, 1161,  115, 1072, 1056, 1055,  115, 1075,
+     1076,  115, 1161,  211,  115, 1079,  115,  509,  115,  115,
+      115,  507,  115,  115,  506,  115,  115,  115,  508,  115,
+     1057,  115,  115, 1078,  115, 1055,  115,  512, 1075,  115,
+      510,  115,  511, 1079,  115,  509, 1161, 1161,  115,  115,
+     1161,  115,  115, 1058,  115,  115,  115,  115,  115,  513,
+
+      115, 1161, 1078,  115, 1085,  515,  512,  115,  510,  115,
+      511,  115,  115, 1161,  115,  115,  115,  115,  115,  514,
+      115,  115, 1058,  115,  115,  516,  115, 1086,  513,  115,
+      211,  517, 1085,  515,  115, 1161,  203,  115,  115,  115,
+     1161,  115,  115,  115,  115,  115,  115,  115,  514,  115,
+      115,  211,  115,  521,  516,  521, 1086,  518, 1161,  517,
+      519,  115,  115,  522,  115,  115,  115,  115, 1070,  948,
+     1070, 1081,  115, 1161,  115, 1084, 1089, 1161,  520,  115,
+      115, 1090,  115,  203, 1083,  518,  115,  115,  519,  523,
+      115,  115,  115,  115, 1094,  115, 1161, 1096,  115,  524,
+
+     1081,  115,  115, 1084, 1089,  115,  520,  115,  115, 1097,
+     1090,  115,  115, 1083,  526,  115,  115, 1082,  523,  115,
+      115,  115,  115, 1094,  115, 1096, 1099,  115,  524,  115,
+     1161,  115,  525,  115, 1161, 1161,  115, 1097,  115,  115,
+      115, 1103,  526, 1161,  115,  115, 1082, 1111,  115,  115,
+      115, 1161,  211,  115, 1099, 1104,  527, 1107,  115,  211,
+      525,  947,  948,  947,  528, 1161,  115, 1161,  115,  949,
+     1103,  203,  950,  115,  115,  531, 1111,  539, 1161,  115,
+      947,  948,  947, 1104,  527, 1107,  115, 1023,  949, 1024,
+     1161,  950,  528,  540,  540,  540,  540,  540,  540,  540,
+
+      540,  540,  540,  541,  947,  948,  947, 1101, 1161,  176,
+     1161, 1102,  949, 1161,  188,  950, 1023, 1161, 1024,  540,
+      540,  540,  540,  540,  540,  540,  540,  540,  540,  541,
+     1000, 1001, 1000, 1161, 1161,  176, 1101,  188, 1002, 1102,
+     1161, 1003, 1092,  948, 1092,  540,  540,  540,  540,  540,
+      540,  540,  540,  540,  540,  541, 1109,  948, 1109, 1098,
+     1115,  176,  115,  115, 1161,  550,  548,  115,  115,  110,
+      115,  545,  545,  545,  545,  545,  545,  545,  545,  545,
+      545,  115,  549, 1114,  115,  115,  551, 1098, 1115, 1120,
+      115,  115,  115,  554,  550,  548,  115,  115, 1121,  115,
+
+     1161,  115, 1161, 1161,  115,  552,  115, 1161, 1161,  115,
+      549, 1114,  115, 1127,  115,  551, 1123, 1120,  482,  115,
+      115,  115, 1161,  115,  115,  553,  115, 1121,  115,  115,
+      115,  203,  115, 1161,  552,  115,  947,  948,  947, 1129,
+      115, 1127,  115,  115,  949, 1123,  482,  950,  115, 1161,
+      115,  203,  115,  115,  553,  115,  211,  115,  115, 1161,
+     1161, 1000, 1001, 1000, 1161, 1161, 1116, 1129,  115, 1002,
+      115,  115, 1003,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  211, 1161, 1000, 1001, 1000, 1117, 1118,
+     1117, 1161,  565, 1002, 1132, 1116, 1003, 1131, 1136, 1161,
+
+      566,  566,  566,  566,  566,  566,  566,  566,  566,  566,
+      211, 1161, 1042, 1001, 1042, 1117, 1118, 1117, 1142,  567,
+      949,  565, 1132,  950, 1161, 1131, 1136,  383,  383,  383,
+      383,  383,  383,  383,  383,  383,  383,  405,  405,  405,
+      405,  405,  405,  405,  405,  405,  405, 1142,  567,  405,
+      405,  405,  405,  405,  405,  405,  405,  405,  405,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  424,
+
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  424,
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  588,
+      211,  588, 1161, 1161,  589,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  430,  430,  430,  430,  430,  430,
+      430,  430,  430,  430, 1161,  115, 1161,  115, 1161,  590,
+      115,  590,  115,  429,  591,  591,  591,  591,  591,  591,
+
+      591,  591,  591,  591,  115,  592,  115,  115,  115,  593,
+      203, 1119,  115,  115,  115, 1161,  115, 1141,  188,  115,
+     1161,  115,  429, 1161,  115, 1161,  115,  115,  594,  115,
+      115, 1161,  115,  592,  115,  115,  115,  115,  593, 1119,
+     1161,  115,  115,  115, 1161, 1141,  115,  203,  595,  115,
+     1149,  115, 1161,  115,  115,  115, 1146,  594,  115,  115,
+     1161, 1161,  596, 1161,  115,  115,  188,  115,  115,  115,
+     1161,  115,  597,  115,  115,  115,  595,  115,  188, 1149,
+      115,  115, 1161,  598, 1146,  115,  203,  115,  115,  115,
+      115,  596, 1144,  115,  115,  188,  115,  115,  115,  203,
+
+      599,  597,  115,  115,  115,  115, 1161,  188,  115,  115,
+      115,  598, 1161,  600,  115,  115,  115, 1130,  115,  115,
+     1144,  115,  115,  115,  115,  601,  115,  115,  599, 1143,
+      115, 1157,  115,  602,  115,  115,  115, 1148, 1161,  115,
+      115,  115,  600,  603, 1145, 1130, 1124,  948, 1124,  115,
+      115,  115,  115, 1161,  601,  115,  115, 1143, 1151,  115,
+     1157,  602,  115, 1161,  115, 1148,  188,  115,  115,  115,
+      115,  603, 1145,  605,  115,  115,  203,  115,  606,  115,
+     1161,  115, 1161, 1161,  203,  608, 1151,  608, 1161,  115,
+     1161,  115,  607,  115, 1161, 1161,  115, 1161, 1161,  115,
+
+     1161,  605, 1147,  115,  115, 1161, 1161,  606,  115,  115,
+      115, 1153, 1154, 1153,  115,  115, 1161,  115,  115,  115,
+      607,  115, 1161,  115, 1161, 1155,  609, 1161,  619,  115,
+      620, 1147, 1161,  115, 1161, 1152, 1161,  115, 1161,  115,
+      610,  115, 1161,  115,  115,  115,  621,  115,  115, 1161,
+      115, 1161,  115, 1155,  203,  609,  619,  115,  620,  622,
+      115,  115,  115, 1152,  115,  115, 1161,  115,  610,  455,
+      115,  455, 1161, 1161,  115,  621, 1153, 1154, 1153,  115,
+     1161,  629, 1161, 1161,  115, 1161, 1161,  622,  115,  115,
+     1156,  115,  115, 1159, 1160, 1159,  115, 1159, 1160, 1159,
+
+      456,  623, 1161,  115, 1161,  611,  115,  612, 1161,  629,
+      613,  115,  203,  115,  614, 1161, 1161,  615,  115, 1156,
+      616,  617, 1161, 1161,  618,  115, 1161, 1161, 1161,  623,
+      626,  115, 1161, 1161,  611,  115,  612, 1161,  115,  613,
+      115, 1161,  614,  115, 1161,  615,  115, 1161,  616,  617,
+      624,  115,  618,  115,  115,  115, 1161,  637,  626,  115,
+      115,  627, 1161, 1158, 1161,  115,  625,  115, 1161, 1161,
+     1161, 1161,  115,  115,  115,  115,  628, 1161, 1161,  624,
+      115, 1161, 1161,  115,  115,  637, 1161, 1161,  115,  115,
+      627, 1158, 1161,  115,  625, 1161, 1161, 1161, 1161, 1161,
+
+     1161,  115,  115, 1161,  628,  630,  630,  630,  630,  630,
+      630,  630,  630,  630,  630,  630, 1161,  630,  630,  630,
+      630,  630,  631,  630,  632,  632,  632,  632,  632,  632,
+      632,  632,  632,  632,  630,  630,  630,  630,  630,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  630,  630,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  633,  633,  633,  633,  633,  633,  633,
+      633,  633,  633,  630,  115, 1161,  635,  638,  635,  115,
+
+     1161, 1161,  115,  115, 1000, 1001, 1000, 1161,  115, 1161,
+     1161,  634, 1002,  115, 1161, 1003,  115, 1161, 1161, 1161,
+     1161, 1161,  639,  115, 1161, 1161,  638,  636,  115,  115,
+      115,  115,  115, 1161,  115,  115, 1161,  115,  115,  634,
+     1161,  115, 1161,  115,  115, 1161,  641, 1161,  115,  115,
+      639, 1161, 1161, 1161, 1161, 1161, 1161,  115,  115,  115,
+      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
+     1161, 1161,  115,  115, 1161,  641,  115,  115, 1161,  115,
+      642, 1161, 1161, 1161, 1161,  115, 1161,  643, 1161,  115,
+      115, 1161, 1161, 1161,  115,  115, 1161,  115,  644,  115,
+
+     1161, 1161,  115, 1161,  115,  645, 1161,  115,  642,  115,
+     1161, 1161,  646, 1161, 1161,  643, 1161, 1161,  115,  115,
+     1161, 1000, 1001, 1000,  115, 1161, 1161,  644,  115, 1002,
+      115,  650, 1003,  115,  645,  115,  115,  115,  647,  115,
+      646,  648,  115, 1161,  115, 1161,  115,  115, 1161,  115,
+      115, 1161, 1161, 1161, 1161, 1161,  649, 1161,  115,  115,
+      650,  115, 1161, 1161,  115,  115, 1161,  647,  115,  115,
+      648,  115, 1161,  115,  115,  652,  115,  115,  115, 1161,
+      115, 1161, 1161,  651,  649, 1161,  115, 1161,  115,  115,
+     1161,  115, 1161, 1161,  115,  115,  115, 1161,  115, 1161,
+
+      115, 1161,  653,  115,  652, 1161,  654,  115, 1161,  115,
+      115,  651,  115, 1161,  115, 1161,  115, 1161,  115, 1161,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
+      653, 1161,  115, 1161,  654,  655,  115,  115,  115,  115,
+     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
+      115, 1161,  115, 1161,  115,  115,  115, 1161,  115, 1161,
+     1161,  115,  115, 1161,  655,  115,  115, 1161,  115,  659,
+      115,  115,  115,  115,  115,  115, 1161,  115, 1161,  115,
+      656, 1161,  657, 1161,  115,  115,  115,  115, 1161,  115,
+      115,  658,  115,  115, 1161,  115,  661,  659,  115,  115,
+
+      115,  115, 1161, 1161,  115, 1161,  115, 1161,  656, 1161,
+      657, 1161,  660,  115, 1161,  115,  115,  115,  115,  115,
+      658,  115,  115,  115,  115,  661, 1161,  115, 1161,  664,
+      115, 1071,  948, 1071,  115,  662, 1161,  115,  115,  949,
+      660,  115,  950,  115, 1161, 1161,  115,  115,  115,  663,
+      115, 1161,  115,  115, 1161,  115, 1161,  115, 1161, 1161,
+      115, 1161,  115,  662, 1161,  115,  115, 1161, 1161,  115,
+      115, 1161, 1161, 1161,  665,  115,  115, 1161,  663,  115,
+     1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,  115,
+      115,  115, 1161,  666,  115,  115, 1161,  115, 1161, 1161,
+
+     1161,  115,  665,  668,  115, 1161,  667, 1161,  115,  115,
+     1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
+      115,  666,  115,  115,  115,  115, 1161,  115,  115,  115,
+      669,  668, 1161,  115,  667, 1161,  115,  115,  670,  115,
+     1161,  115, 1161, 1161, 1161,  115, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  115, 1161,  115,  115,  115,  669,
+     1161,  115,  115, 1161,  115,  115,  115,  115, 1161,  115,
+      115, 1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161,  115, 1161,  115, 1161,  115,  115,  115, 1161,
+      115,  115,  115,  115,  115,  115, 1161, 1161, 1161,  115,
+
+      115, 1161,  671, 1161, 1161,  115, 1161,  115,  115,  115,
+     1161, 1161,  115,  672,  115,  115, 1161,  115,  115, 1161,
+      115,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
+      671, 1161, 1161,  115, 1161,  115, 1161,  115,  115, 1161,
+      115,  115,  672,  115,  115,  673,  115,  115,  674,  115,
+      115, 1161,  115, 1161, 1161,  115,  115, 1161, 1161, 1161,
+      115,  698, 1161,  115, 1161,  115,  115, 1161,  115, 1161,
+      115, 1161, 1161,  115,  673,  115, 1161,  674,  115,  677,
+      115,  684, 1161, 1161, 1161, 1093,  948, 1093,  115, 1161,
+      698,  115, 1161,  949, 1161,  115,  950,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  686,  115, 1110,
+      948, 1110, 1161,  176, 1161, 1161, 1161,  949, 1161, 1161,
+      950, 1161, 1161,  685,  685,  685,  685,  685,  685,  685,
+      685,  685,  685,  686,  693, 1161,  693, 1161, 1161,  176,
+     1161, 1161, 1161, 1161,  694, 1161, 1161, 1161, 1161,  685,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  686,
+      697, 1161,  697, 1161, 1161,  176,  696,  115, 1161, 1161,
+      695,  115,  115,  110,  600,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  115,  115, 1161, 1161, 1161,
+     1161, 1161, 1161,  115, 1161,  696,  115, 1161,  115,  695,
+
+      115,  115,  115,  600, 1161,  115, 1161,  115,  645,  732,
+      115, 1161,  115,  115,  115,  646, 1161, 1161,  700,  699,
+      700,  115,  115, 1161,  115, 1161, 1161,  115,  701, 1161,
+     1161,  115,  702, 1161,  115, 1161,  115,  645,  732,  115,
+      115,  211, 1161,  646, 1161, 1161, 1161,  699, 1161,  115,
+     1161,  115,  115,  709, 1161,  709,  115, 1161,  710,  710,
+      710,  710,  710,  710,  710,  710,  710,  710, 1161,  211,
+      115, 1126,  948, 1126, 1161, 1161, 1161, 1161, 1161,  949,
+      115, 1161,  950, 1161, 1161,  115,  566,  566,  566,  566,
+      566,  566,  566,  566,  566,  566,  211, 1161,  115, 1161,
+
+     1161,  947,  948,  947, 1161,  565, 1161, 1161,  711,  949,
+      711, 1161,  950,  712,  712,  712,  712,  712,  712,  712,
+      712,  712,  712,  589,  589,  589,  589,  589,  589,  589,
+      589,  589,  589, 1161,  565,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  589,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  733, 1161, 1161,  115, 1161,
+      115, 1161, 1161,  115,  947,  948,  947, 1161, 1000, 1001,
+     1000, 1161,  949,  737,  115,  950, 1002,  115, 1161, 1003,
+     1161, 1161, 1161, 1161,  733, 1161, 1161,  115, 1161,  115,
+
+     1161, 1161,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,  737,  115,  718,  718,  115,  718,  718,  718,  718,
+      718,  718,  718,  718,  718,  718,  718,  718,  718,  718,
+      734,  718,  735,  735,  735,  735,  735,  735,  735,  735,
+      735,  735,  718,  718,  718,  718,  718,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  718,  718,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+      736,  736,  736,  736,  736,  736,  736,  736,  736,  736,
+
+      736,  718,  115,  115,  738,  115,  115,  115,  115,  115,
+      115,  115, 1161,  740,  115, 1161, 1161, 1161,  739,  741,
+     1161,  115,  115, 1161,  115,  115, 1161, 1161,  115, 1161,
+     1161,  115,  115,  738,  115,  115,  115,  115,  115,  115,
+      115, 1161,  740,  115, 1161, 1161,  739,  741, 1161,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161,  115,
+      115,  115,  115, 1161, 1161,  745,  115, 1161, 1161,  742,
+     1161, 1161, 1161,  115,  115,  743,  115, 1161, 1161, 1161,
+      115, 1161, 1161,  115,  115, 1161,  115,  115,  115,  115,
+      115,  115,  115, 1161,  745,  115, 1161,  742,  746, 1161,
+
+     1161,  115,  115,  743,  115, 1161,  115, 1161,  115,  115,
+      115, 1161, 1161,  115,  750,  115,  115,  747,  115, 1161,
+      751,  115, 1161, 1161, 1161, 1161,  746, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+      115,  115,  115,  750,  115, 1161,  747,  115, 1161,  751,
+     1161, 1161, 1161, 1161,  115,  115,  115,  115,  115, 1161,
+      115, 1161, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
+      115,  761, 1161, 1161,  115,  115, 1161,  115,  762,  115,
+      115, 1161,  115,  115, 1161, 1161, 1161,  115,  763, 1161,
+     1161,  115,  115,  115,  115, 1161,  115, 1161, 1161,  761,
+
+     1161, 1161,  764,  115,  115,  115, 1161,  762,  115,  115,
+      115, 1161,  115,  765,  115, 1161,  763,  115,  768,  115,
+      115,  115,  115,  115, 1161,  115, 1161, 1161, 1161,  766,
+      764,  115, 1161,  115, 1161,  115, 1161,  115,  115,  767,
+      115,  115,  765,  115, 1161, 1161,  115,  768,  115, 1161,
+     1161, 1161,  115,  769,  115,  769, 1161,  766, 1161,  115,
+     1161,  115, 1161,  258,  115,  115, 1161, 1161,  767,  115,
+      257,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      115, 1161,  115,  115,  770,  115,  115,  115,  115,  115,
+     1161,  115,  115, 1161,  115, 1161, 1161, 1161, 1161,  115,
+
+      771, 1161,  115, 1161, 1161,  115,  115, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
+      115,  115, 1161,  115,  115, 1161, 1161,  115,  771, 1161,
+      115, 1161, 1161,  115,  115,  115,  115, 1161,  772,  115,
+      115,  774,  115,  773,  115,  775,  115,  115,  115, 1161,
+     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115, 1161,
+     1161,  115,  115, 1161,  115,  115,  772,  115,  115,  115,
+      774,  115,  773,  115,  775,  115,  115, 1161, 1161,  776,
+      115,  115,  115,  115, 1161,  115,  115,  777,  115,  115,
+      115,  115,  115,  115,  780, 1161,  115,  115, 1161,  115,
+
+     1161, 1161,  115, 1161,  778,  779, 1161,  776, 1161,  115,
+     1161,  115,  115,  115,  115, 1161,  777,  115, 1161,  115,
+     1161,  115, 1161,  780, 1161, 1161,  115, 1161,  115,  115,
+      115,  781,  778,  779,  115,  115, 1161, 1161, 1161,  115,
+      115,  115, 1161, 1161, 1161, 1161,  782, 1161,  115, 1161,
+     1161, 1161, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
+      781,  115, 1161,  115,  115,  115,  115,  783, 1161,  115,
+      115, 1161,  784,  115,  782, 1161,  115,  785,  115, 1161,
+      115, 1161,  115, 1161,  115, 1161, 1161, 1161, 1161, 1161,
+      115, 1161,  115, 1161,  115,  115,  783, 1161,  115,  115,
+
+      784, 1161,  115,  787, 1161,  115,  785,  115,  115,  115,
+      115, 1161,  115,  786,  115, 1161, 1161,  115, 1161, 1161,
+      115, 1161,  788, 1161,  115,  115, 1161,  115,  115,  789,
+      115, 1161,  787, 1161,  115, 1161,  115, 1161,  115,  115,
+     1161,  115,  786,  115,  115,  115, 1161, 1161,  115, 1161,
+      788, 1161,  115,  115,  115,  115,  115,  115,  789,  115,
+     1161,  790,  115, 1161, 1161,  115, 1161,  115,  115,  792,
+      115, 1161,  115,  115,  115, 1161,  115,  115, 1161, 1161,
+     1161, 1161,  115,  115, 1161, 1161,  115,  791,  115, 1161,
+      790,  115, 1161, 1161,  115,  115,  793,  115,  792,  115,
+
+      115,  115,  115,  115,  115,  115,  115, 1161, 1161, 1161,
+     1161, 1161, 1161,  115, 1161,  791,  115, 1161,  795,  115,
+      796, 1161, 1161,  115, 1161,  793,  115, 1161,  115,  115,
+      115,  115, 1161, 1161,  115,  115, 1161,  115, 1161,  797,
+      798,  115,  115, 1161, 1161,  115,  795,  115,  796,  115,
+     1161, 1161, 1161,  115,  115,  115,  115,  115,  115, 1161,
+      115, 1161,  115, 1161, 1161, 1161,  115,  797,  799,  798,
+     1161,  115,  801,  115,  115, 1161,  115,  800,  115,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1161, 1161,
+     1161,  115, 1161,  115, 1161, 1161,  799, 1161, 1161,  115,
+
+      801, 1161, 1161,  115,  115,  800, 1161, 1161,  115,  115,
+     1161, 1161,  176, 1161,  115, 1161, 1161, 1161,  176,  115,
+     1161,  115, 1161,  816,  115, 1161,  110,  115,  111,  111,
+      111,  111,  111,  111,  111,  111,  111,  111,  115,  115,
+      115,  115, 1161, 1161,  115,  115,  819,  817,  115, 1161,
+     1161,  818,  816,  115, 1161, 1161, 1161, 1161,  115,  115,
+      115, 1161, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,
+      115, 1161,  211,  115,  115,  819,  817, 1161, 1161,  818,
+     1161, 1161,  211, 1161, 1161, 1161,  115,  115,  115,  710,
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  710,
+
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  211,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,  211,
+     1161, 1161, 1161, 1161, 1161, 1161,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  823,  823,  211,  823,
+      823,  823,  823,  823,  823,  823,  823,  823,  823,  823,
+      823,  823,  823,  828,  823,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  823,  823,  823,  823,  823,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+
+      830,  830,  830,  830,  830,  830,  823,  823,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  830,  830,  830,  830,  830,  830,
+      830,  830,  830,  830,  823,  832,   77,  832, 1161, 1161,
+      833,  833, 1161,  833, 1161, 1161, 1161,  833,  833, 1161,
+     1161,  833, 1161, 1161,  833,  833,  833,  833,  833,  833,
+      833,  833,  833,  831,  831, 1161,  831,  831,  831,  831,
+      831,  831,  831,  831,  831,  831,  831,  831,  831,  831,
+      841,  831,  842,  842,  842,  842,  842,  842,  842,  842,
+      842,  842,  831,  831,  831,  831,  831,  843,  843,  843,
+
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  831,  831,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  843,  843,  843,  843,  843,  843,  843,  843,  843,
+      843,  831,  115, 1161, 1161,  258, 1161,  115,  257,  257,
+      257,  257,  257,  257,  257,  257,  257,  257,  115,  845,
+     1161,  844,  115,  115,  115,  115, 1161,  115, 1161, 1161,
+      115,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+     1161,  115, 1161, 1161,  846,  115, 1161,  115,  845,  844,
+
+      115,  115,  115,  115,  115, 1161,  115,  115, 1161,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+     1161, 1161,  846,  115,  115, 1161,  115, 1161, 1161,  115,
+      847, 1161, 1161, 1161, 1161, 1161,  115,  115,  848, 1161,
+     1161,  115,  115,  115, 1161,  849, 1161,  115,  115, 1161,
+      115,  115,  115, 1161,  115,  115,  115, 1161,  847,  850,
+     1161,  852,  115,  852, 1161,  115,  848, 1161, 1161,  115,
+      115, 1161,  115,  115,  849, 1161, 1161,  115,  115,  115,
+      115, 1161,  115, 1161,  115,  115,  855,  115,  850, 1161,
+      115, 1161,  115, 1161,  115, 1161,  853,  115,  115,  115,
+
+     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  854,
+     1161,  115, 1161,  115,  115,  855,  115, 1161,  858,  115,
+      115, 1161, 1161,  115, 1161,  853,  115, 1161,  115,  115,
+     1161,  115, 1161,  115,  115, 1161,  866,  854, 1161,  115,
+     1161,  115, 1161,  115, 1161,  115,  867,  858,  115, 1161,
+     1161,  115, 1161,  115, 1161,  115,  115,  868, 1161, 1161,
+      115,  115, 1161,  115, 1161,  866, 1161, 1161,  115, 1161,
+      115,  115,  115,  115,  867,  869,  115,  115,  115, 1161,
+      115,  115,  871,  115, 1161,  115,  868, 1161, 1161,  870,
+      115,  115, 1161, 1161,  874, 1161, 1161,  115,  115,  115,
+
+      115,  115, 1161,  115,  869,  115,  115,  115,  115, 1161,
+      115,  871,  115,  115,  875,  115,  875,  870,  115,  115,
+      872,  873,  115,  874,  876,  115,  115, 1161,  115,  115,
+     1161,  115,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      877,  115, 1161, 1161,  115,  115,  115,  115,  872,  873,
+      115,  115,  115, 1161,  878,  115, 1161,  115,  115, 1161,
+      115, 1161,  879,  115, 1161,  115,  115,  115,  877,  115,
+     1161,  880,  115,  115,  115,  115,  115,  115, 1161, 1161,
+      115,  115, 1161,  878, 1161, 1161,  115,  115,  115, 1161,
+      115,  879,  115,  115,  115,  115,  115, 1161,  115,  115,
+
+      880,  115, 1161,  115,  115,  115, 1161,  881, 1161,  115,
+      115, 1161, 1161, 1161,  115,  115,  115,  882,  115,  115,
+     1161,  883,  115, 1161,  115, 1161, 1161,  115,  115,  115,
+     1161,  115, 1161,  115, 1161,  881,  115,  115, 1161,  115,
+     1161,  115,  115,  115,  115,  882,  115,  115,  115,  883,
+      115,  115, 1161,  884, 1161,  884,  115,  115, 1161, 1161,
+      115,  115,  115,  115, 1161,  115, 1161, 1161,  115,  115,
+     1161,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
+     1161,  886,  115,  888, 1161, 1161,  115, 1161,  115,  115,
+      115,  115,  115,  115,  115, 1161, 1161,  115,  887,  115,
+
+     1161,  885,  115,  115, 1161,  115, 1161, 1161,  115,  886,
+      115, 1161,  888,  889, 1161,  115, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  115, 1161,  887,  115,  115,  885,
+      115,  891,  115,  115, 1161, 1161,  890, 1161,  115,  115,
+     1161,  889, 1161, 1161,  115, 1161,  115, 1161,  115, 1161,
+     1161,  892, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
+      891,  115,  115, 1161,  890, 1161,  115,  115,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1161,  895,  892,
+     1161,  115,  115, 1161, 1161, 1161,  115,  115, 1161,  115,
+      115,  115, 1161,  115, 1161,  896,  115,  896,  115,  115,
+
+      115,  115, 1161, 1161,  115,  115, 1161,  895, 1161,  115,
+     1161,  115,  115, 1161, 1161, 1161,  115,  115,  115,  115,
+      115, 1161,  115, 1161,  115,  115,  115,  115,  115,  115,
+      897,  906, 1161,  115, 1161, 1161, 1161, 1161,  898,  115,
+      115, 1161, 1161, 1161, 1161,  115, 1161,  115,  115,  115,
+     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  897,
+      906, 1161,  115, 1161,  907, 1161,  898,  115, 1161,  908,
+      115,  908, 1161,  115,  258,  115,  802,   77,  804,  175,
+      115, 1161, 1161, 1161, 1161,  115, 1161, 1161, 1161, 1161,
+      909,  115,  907, 1161, 1161,  115,  115, 1161,  115, 1161,
+
+     1161, 1161,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      115,  177,  178, 1161, 1161,  179, 1161,  180, 1161,  909,
+      115,  115, 1161, 1161,  115,  115, 1161, 1161,  341,  182,
+     1161,  115, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+      177,  178, 1161, 1161,  179, 1161,  180, 1161, 1161,  115,
+     1161, 1161, 1161, 1161, 1161, 1161,  341,  182,  912,  912,
+      211,  912,  912,  912,  912,  912,  912,  912,  912,  912,
+      912,  912,  912,  912,  912,  914,  912,  915,  915,  915,
+      915,  915,  915,  915,  915,  915,  915,  912,  912,  912,
+      912,  912,  916,  916,  916,  916,  916,  916,  916,  916,
+
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  916,  916,  912,  912,
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  916,  916,  916,  916,
+      916,  916,  916,  916,  916,  916,  912,  211,  257,  257,
+      257,  257,  257,  257,  257,  257,  257,  257, 1161, 1161,
+     1161, 1161, 1161, 1161,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  383,  374,  374,  211,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
+      374,  384,  374,  385,  385,  385,  385,  385,  385,  385,
+
+      385,  385,  385,  374,  374,  374,  374,  374,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  374,  374,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  386,  386,  386,  386,  386,  386,  386,  386,
+      386,  386,  374,  115, 1161,  917, 1161,  115,  115,  918,
+      115,  115,  115,  919,  115, 1161,  115, 1161,  920,  115,
+     1161, 1161,  115, 1161,  115, 1161,  115, 1161, 1161, 1161,
+      115, 1161,  115,  115,  917, 1161,  115,  115,  918,  115,
+
+      115,  115,  919,  115,  922,  115, 1161,  920,  115,  115,
+      115,  115,  115, 1161,  115,  921,  115, 1161,  115, 1161,
+      115,  115, 1161,  115, 1161,  115, 1161,  115, 1161, 1161,
+      115,  115,  115,  922,  923, 1161,  115, 1161,  115,  115,
+      115,  927, 1161, 1161,  921,  115,  115, 1161,  928,  115,
+      115,  115,  115, 1161,  115, 1161,  115,  115,  115, 1161,
+      115,  115,  923,  115, 1161,  115, 1161,  115,  115,  927,
+     1161,  115,  115, 1161,  115, 1161,  928,  115,  115, 1161,
+      930,  115,  115,  115, 1161, 1161,  115, 1161,  115, 1161,
+     1161,  938,  115, 1161,  939, 1161, 1161,  115, 1161,  115,
+
+     1161,  115,  115, 1161,  115, 1161,  115, 1161,  930,  115,
+      115, 1161,  115,  115, 1161,  941, 1161,  115,  115,  938,
+     1161,  940,  939,  115, 1161, 1161, 1161, 1161, 1161,  115,
+      115, 1161,  115,  115,  115,  115, 1161, 1161,  115, 1161,
+      115, 1161,  115,  942,  941, 1161, 1161,  115,  115,  940,
+     1161,  115, 1161, 1161,  115, 1161, 1161, 1161,  115, 1161,
+      115,  115, 1161,  115,  115,  943,  115, 1161,  115,  115,
+      115,  942,  944,  115, 1161,  115,  115, 1161, 1161, 1161,
+      115,  945,  115, 1161, 1161, 1161, 1161,  115, 1161,  115,
+      115,  115, 1161,  115,  943,  115,  115,  115,  115,  115,
+
+     1161,  944,  115, 1161,  115, 1161,  951, 1161,  115,  945,
+      952, 1161,  115,  115,  115,  115,  115,  115,  115,  115,
+      115,  115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,
+     1161, 1161,  115,  115,  951,  115,  115, 1161,  952, 1161,
+      115,  115,  115,  115,  953,  115, 1161,  115,  115, 1161,
+      115, 1161,  115,  115, 1161,  115, 1161,  115,  115,  115,
+      115,  115, 1161,  115,  115,  115, 1161, 1161, 1161, 1161,
+      115,  115,  956,  953, 1161, 1161,  955, 1161,  115,  115,
+     1161,  115,  115,  115,  115, 1161,  115,  115,  115, 1161,
+      115,  115, 1161,  115, 1161,  115,  115, 1161,  115,  115,
+
+      956,  957,  115, 1161,  955, 1161,  115,  115,  115,  115,
+      115,  115, 1161,  115, 1161,  958,  115, 1161, 1161,  115,
+      115,  115,  115,  962,  115,  115,  115,  115,  115,  957,
+      115,  115, 1161, 1161,  115, 1161,  115,  115,  115,  115,
+      115,  115,  115,  969,  958,  115, 1161, 1161,  115,  115,
+     1161,  115,  962,  115, 1161,  960,  115,  115,  115,  115,
+     1161, 1161,  115,  115,  115, 1161,  115,  963,  115,  115,
+      115,  115,  969, 1161, 1161, 1161, 1161,  115,  115, 1161,
+     1161,  115, 1161,  960,  970,  115, 1161, 1161,  115,  115,
+      115,  971, 1161,  115,  115,  115,  963, 1161, 1161, 1161,
+
+      115, 1161, 1161, 1161, 1161, 1161,  115,  211,  115, 1161,
+     1161, 1161,  970,  115, 1161, 1161,  115,  975,  115, 1161,
+      971,  115, 1161,  115,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  383, 1161,  115,  115,  115, 1161,  115,
+     1161, 1161,  115,  976,  115,  115,  975, 1161,  115, 1161,
+      115, 1161, 1161,  115, 1161, 1161,  115, 1161,  115, 1161,
+     1161, 1161, 1161,  115, 1161,  977,  115,  115,  115,  115,
+      115,  115,  976,  115,  115,  115, 1161,  115,  115, 1161,
+     1161, 1161,  115,  115,  115, 1161,  115, 1161,  115,  978,
+     1161,  979, 1161,  977, 1161,  115, 1161,  115,  115,  115,
+
+     1161,  115, 1161,  115,  115,  115,  115,  115, 1161,  983,
+      115, 1161,  115,  982, 1161, 1161,  115,  978, 1161,  979,
+      115,  115, 1161, 1161,  115,  115,  115,  115,  994,  992,
+      115,  985,  115,  115,  115,  115, 1161, 1161,  983,  115,
+      115,  982, 1161, 1161, 1161, 1161,  115,  115,  115, 1161,
+      115, 1161,  115, 1161, 1161,  115,  115,  994,  992,  115,
+      985,  115,  115,  993,  115,  115,  115, 1161,  115, 1161,
+      115,  115, 1161, 1161,  115,  115, 1161, 1161,  115, 1161,
+     1161, 1161,  115, 1161,  995,  115,  996,  115,  115, 1161,
+     1161,  115,  993,  115,  115,  115,  115, 1161, 1161,  115,
+
+      115,  115,  115, 1161,  997, 1161,  115,  115, 1161, 1161,
+      115,  115,  995,  115,  996, 1161,  115, 1161,  115, 1161,
+      115,  115,  115,  115, 1161,  115, 1161,  115, 1161,  115,
+     1161,  115,  997, 1161, 1161, 1161,  115,  115,  115,  115,
+     1161,  115, 1161,  115,  115, 1004, 1161,  115,  115,  115,
+     1161,  115,  115, 1006, 1161, 1161,  115, 1161,  115,  115,
+     1161, 1161,  115, 1161,  115,  115,  115, 1161,  115,  115,
+      115,  115,  115,  115, 1004,  115, 1161,  115,  115, 1161,
+     1161, 1006, 1161, 1161, 1161,  115,  115, 1007,  115,  115,
+      115, 1161,  115,  115, 1161,  115, 1009,  115, 1161,  115,
+
+      115, 1161, 1161,  115,  115, 1161,  115, 1161,  115,  115,
+     1161,  115, 1161,  115,  115, 1007, 1012,  115, 1161, 1161,
+     1161,  115,  115, 1161, 1161, 1009,  115, 1011,  115,  115,
+     1161, 1161,  115, 1161,  115,  115, 1161,  115,  115,  115,
+      115,  115, 1161,  115, 1012, 1020,  115, 1161,  115, 1019,
+      115, 1161,  115, 1161,  115, 1011,  115,  115,  115, 1161,
+      115,  115, 1161,  115,  115, 1161,  115, 1161,  115,  115,
+      115,  115, 1025,  115, 1020,  115,  115, 1019, 1161, 1161,
+      115,  115,  115, 1161,  115, 1161,  115,  115,  115,  115,
+      115, 1161, 1161,  115, 1161,  115, 1161,  115,  115,  115,
+
+     1025,  115,  115,  115,  115, 1026,  115, 1161,  115,  115,
+     1161, 1161,  115,  115, 1161,  115, 1161, 1161,  115, 1029,
+      115, 1161,  115,  115,  115, 1161, 1030,  115, 1161,  115,
+      115,  115, 1161,  115, 1026,  115, 1161, 1161,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1029,  115,  115,
+      115,  115, 1161,  115, 1161, 1030, 1038, 1161,  115, 1037,
+      115,  115, 1161,  115,  115, 1161,  115,  115, 1161, 1161,
+      115,  115,  115,  115,  115,  115, 1161, 1161,  115,  115,
+      115, 1161, 1161, 1161, 1038, 1161, 1039, 1037,  115, 1161,
+      115,  115,  115,  115, 1161,  115,  115,  115,  115, 1040,
+
+      115,  115,  115, 1161,  115,  115, 1044, 1161,  115,  115,
+     1161, 1161,  115, 1161, 1039, 1161,  115, 1161, 1161,  115,
+      115, 1161,  115,  115, 1161,  115,  115,  115, 1040,  115,
+     1161,  115, 1161,  115,  115, 1044, 1161,  115,  115,  115,
+      115, 1047,  115, 1161,  115, 1161, 1161,  115, 1161,  115,
+     1161,  115, 1161,  115,  115, 1161,  115, 1048,  115, 1161,
+      115, 1161, 1161, 1161,  115,  115,  115,  115, 1161,  115,
+     1047,  115,  115, 1161, 1161, 1054,  115, 1161, 1161,  115,
+     1059,  115,  115,  115,  115,  115, 1048,  115, 1161,  115,
+      115, 1161, 1161,  115,  115,  115, 1161,  115,  115, 1161,
+
+      115, 1161,  115, 1054,  115,  115, 1161,  115, 1062, 1059,
+      115,  115, 1161, 1161,  115, 1161,  115, 1161, 1161,  115,
+      115, 1161,  115,  115,  115,  115,  115,  115, 1063,  115,
+     1161,  115,  115, 1161, 1161, 1067, 1062, 1161, 1161,  115,
+     1161,  115, 1161,  115,  115, 1161, 1161,  115, 1161,  115,
+     1161,  115,  115,  115,  115, 1068,  115, 1063,  115,  115,
+     1161, 1161, 1161, 1067,  115, 1161,  115,  115,  115,  115,
+      115,  115, 1069,  115, 1073,  115,  115, 1161,  115, 1161,
+     1161,  115, 1161, 1161, 1068, 1161, 1161,  115,  115,  115,
+      115,  115, 1161,  115,  115,  115,  115,  115, 1161,  115,
+
+     1161, 1069,  115, 1073,  115, 1161,  115,  115, 1161,  115,
+     1080, 1161,  115, 1161, 1161,  115,  115,  115, 1161,  115,
+      115,  115, 1161,  115,  115,  115,  115, 1087,  115, 1161,
+     1161, 1161, 1161, 1161, 1088,  115,  115,  115, 1080,  115,
+     1161,  115,  115, 1161,  115,  115,  115, 1161,  115, 1161,
+      115,  115,  115,  115,  115, 1161, 1087,  115,  115, 1091,
+     1161, 1161, 1088,  115, 1161,  115, 1161,  115,  115,  115,
+      115,  115, 1095,  115,  115,  115,  115,  115, 1161, 1161,
+      115, 1161,  115, 1161, 1161, 1161,  115, 1091,  115, 1161,
+      115,  115, 1161,  115,  115,  115,  115, 1161,  115,  115,
+
+      115, 1095, 1106,  115, 1161,  115, 1161, 1161, 1161, 1161,
+      115, 1161, 1161,  115, 1105, 1161,  115,  115,  115, 1161,
+      115, 1108,  115,  115,  115,  115, 1161, 1161,  115,  115,
+     1161, 1106, 1161, 1161, 1161, 1161,  115, 1161,  115, 1161,
+      115,  115, 1105,  115, 1112,  115,  115,  115, 1161,  115,
+     1108,  115,  115,  115,  115, 1161, 1161, 1161,  115,  115,
+     1161, 1122, 1161, 1161,  115, 1161,  115, 1161,  115,  115,
+     1161,  115, 1112, 1161,  115, 1161,  115, 1161,  115, 1161,
+     1161,  115, 1161,  115, 1161, 1161, 1161,  115, 1161, 1122,
+     1161, 1161, 1161, 1161,  115, 1161,  115, 1124,  948, 1124,
+
+     1161, 1161, 1125, 1125, 1161, 1125, 1161, 1161, 1161, 1125,
+     1125, 1161, 1161, 1125, 1161, 1161, 1125, 1125, 1125, 1125,
+     1125, 1125, 1125, 1125, 1125,  115,  115, 1161, 1161, 1161,
+      115,  115, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1133,
+     1161, 1161, 1128, 1161,  115,  115, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161, 1161, 1161, 1161, 1161, 1161, 1133, 1161, 1161,
+     1128, 1161,  115,  115,  947,  948,  947, 1161, 1161, 1134,
+     1134, 1161, 1135, 1161,  115,  950, 1134, 1134, 1137,  115,
+     1134, 1161, 1161, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+
+     1134, 1134, 1161,  115,  115,  115, 1161, 1161, 1161,  115,
+      115, 1161, 1161,  115, 1161, 1161, 1161, 1137,  115, 1161,
+     1161, 1161, 1161,  115,  115, 1161, 1161, 1161, 1161, 1161,
+     1161,  115, 1161,  115,  115, 1161, 1161, 1161,  115,  115,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161,  115,  115,   64,   64,   64,   64,   64,   64,   64,
+       64,   64,   64,   64,   64,   65,   65,   65,   65,   65,
+       65,   65,   65,   65,   65,   65,   65,   81,   81, 1161,
+       81,   81,   81,   81,   81,   81,   81,   81,   81,   84,
+       84, 1161,   84,   84,   84,   84,   84,   84,   84,   84,
+
+       84,   88,   88,   88,   88,   88,   88,   88,   88,   88,
+       88,   88,   88,   92,   92,   92,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,  111,  111,  115,  115,  115,
+      115,  115,  115,  115,  115,  187,  187,  187,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  202,  202,  202,
+      202,  202,  202,  202,  202,  202,  202,  202,  202,  209,
+      209,  209,  209,  209,  209, 1161,  209,  209,  209, 1161,
+      209,  232,  232,  232,  232,  232,  232,  232,  232,  232,
+      232,  232,  232,  101, 1161, 1161,  101,  252,  252,  252,
+     1161, 1161,  252, 1161,  252,  252, 1161,  252,  252,  343,
+
+      343,  343,  343,  343,  343,  343,  343,  343,  343,  343,
+      343,  358,  358, 1161,  358,  358,  358,  358,  358,  358,
+      358,  358,  358,  371,  371,  371,  371,  371,  371, 1161,
+      371,  371,  371, 1161,  371,  374,  374,  374,  374,  374,
+      374,  374,  374,  374,  374,  374,  374,  379,  379,  379,
+      379,  379,  379,  379,  379,  379,  379,  379,  379,  422,
+     1161, 1161,  422,  276, 1161, 1161, 1161,  276, 1161, 1161,
+     1161, 1161, 1161,  276,  558,  558,  558,  558,  558,  558,
+      558,  558,  558,  558,  558,  558,  718,  718, 1161,  718,
+      718,  718,  718,  718,  718,  718,  718,  718,  721,  721,
+
+     1161,  721,  721,  721,  721,  721,  721,  721,  721,  721,
+      723,  723, 1161,  723,  723,  723,  723,  723,  723,  723,
+      723,  723,   88,   88,   88,   88,   88,   88,   88,   88,
+       88,   88,   88,   88,  726,  726,  726,  726,  726,  726,
+      726,  726,  726,  726,  726,  726,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,   92,   92,   92,  728,  728,
+      728,  728,  728,  728,  728,  728,  728,  728,  728,  728,
+      812,  812,  812,  812,  812,  812,  812,  812,  812,  812,
+      812,  812,  814,  814, 1161,  814,  814,  814,  814,  814,
+      814,  814,  814,  814,  823,  823,  823,  823,  823,  823,
+
+      823,  823,  823,  823,  823,  823,  825,  825,  825,  825,
+      825,  825,  825,  825,  825,  825,  825,  825,  831,  831,
+     1161,  831,  831,  831,  831,  831,  831,  831,  831,  831,
+      834,  834, 1161,  834,  834,  834,  834,  834,  834,  834,
+      834,  834,   81,   81, 1161,   81,   81,   81,   81,   81,
+       81,   81,   81,   81,  835,  835, 1161,  835,  835,  835,
+      835,  835,  835,  835,  835,  835,   84,   84, 1161,   84,
+       84,   84,   84,   84,   84,   84,   84,   84,  837,  837,
+      837,  837,  837,  837,  837,  837,  837,  837,  837,  837,
+       88,   88,   88,   88,   88,   88,   88,   88,   88,   88,
+
+       88,   88,  838,  838,  838,  838,  838,  838,  838,  838,
+      838,  838,  838,  838,   92,   92,   92,   92,   92,   92,
+       92,   92,   92,   92,   92,   92,  187,  187,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  904,  904,
+      904,  904,  904,  904,  904,  904,  904,  904,  904,  904,
+      358,  358, 1161,  358,  358,  358,  358,  358,  358,  358,
+      358,  358,  814,  814, 1161,  814,  814,  814,  814,  814,
+      814,  814,  814,  814,  202,  202,  202,  202,  202,  202,
+      202,  202,  202,  202,  202,  202,  912,  912,  912,  912,
+      912,  912,  912,  912,  912,  912,  912,  912,  374,  374,
+
+      374,  374,  374,  374,  374,  374,  374,  374,  374,  374,
+      379,  379,  379,  379,  379,  379,  379,  379,  379,  379,
+      379,  379,  825,  825,  825,  825,  825,  825,  825,  825,
+      825,  825,  825,  825,  946,  946,  946,  946,  946,  946,
+      946,  946,  946,  946,  946,  946,  999,  999,  999,  999,
+      999,  999,  999,  999,  999,  999,  999,  999,   13, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+    } ;
+
+static yyconst flex_int16_t yy_chk[9249] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
+        2,    2,    2,   10,    8,    8,    8,    8,   15,   15,
+
+       15,   68, 1129,   14,   10, 1119,   68,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   16,   16,
+       16,   54,   54,   54,    2,    2,   18,   10,    2,   19,
+        2,    8,   14,   17,   17,   17,   15,   20,   21, 1096,
+       18,    2,    2,  176,   22,   14, 1084,   25,   26,  176,
+       15,   20,   21,    2,    2,   18,   10,    2,   75,    2,
+        8,   25,   42,   19,   69,   15,   20,   21,   18,    2,
+        2,   17,   24,   27,   26,   23,   25,   19,   15,   20,
+       21,   22,   23,   23,   29,   17,   75,   27,   26,   25,
+     1045,   42,   19,   24,  959,   22,   30,  339,   74,  339,
+
+       17,   82,   27,   26,  340,   19,  340,   24,   83,   69,
+       22,   29,   23,   17,   31,   27,   26,   32,   30,   34,
+       41,  178,   24,   22,  916,   29,   23,   74,   31,  912,
+       82,   32,   30,   34,   41,   24,   83,   69,   49,  685,
+       29,   23,   49,   31,  905,  685,   32,   30,   34,   41,
+      178,  207,   33,   29,   23,   28,   31,   28,   33,   32,
+       30,   34,   41,   76,   76,   76,  242,   49,   67,   67,
+       67,   49,   33,   28,   28,   28,   28,   28,   28,   28,
+       28,   28,   28,   86,   43,   63,  207,   33,   28,   43,
+       44,  350,   28,   28,   28,  242,   43,   43,  904,   28,
+
+       33,   28,   28,   63,   44,   67,   91,   28,   77,   77,
+       77,   28,   86,   43,   63,  207,  837,   28,   43,   44,
+      350,   28,   28,   28,   43,   43,   87,   28,  360,   28,
+       28,   63,   44,  835,   67,   28,   78,   78,   78,   28,
+       35,   86,   35,   35,   35,   35,   35,   35,   35,   35,
+       35,   35,   38,   40,  830,   91,   38,  360,   35,   35,
+       38,   40,   35,  903,   40,  102,   38,   40,   35,  103,
+       38,  107,   87,   40,   90,   35,   35,   79,   79,   79,
+      825,   38,   40,   91,  342,   38,  342,   35,   35,   38,
+       40,   35,   40,  102,   38,   40,   35,  103,   38,  107,
+
+       87,   40,  108,   35,   35,   36,   90,   36,   36,   36,
+       36,   36,   36,   36,   36,   36,   36,  179,   37,  359,
+       39,  359,   36,  903,  823,   37,   45,   36,  822,   37,
+      108,   39,   37,   39,   45,   90,   39,   39,   46,  205,
+       45,   36,   37,   39,  812,  179,   46,   37,  393,   39,
+      180,   36,   46,  182,   37,   45,   36,   37,   46,   39,
+       37,   39,   48,   45,   39,   39,   51,   46,   45,   36,
+       37,   39,   47,   51,  811,   46,   48,  393,  180,   48,
+       46,  182,   48,   51,  205,   47,   46,   47,  104,   50,
+      220,   48,   47,   50,  529,   51,  529,   50,  396,   52,
+
+      450,   47,   51,  104,   48,   50,   52,   48,   50,   50,
+       48,   51,  205,   47,  532,   47,   52,  104,   50,  804,
+       47,  220,   50,   80,   80,   80,   50,  396,   52,  450,
+      530,  104,  530,   50,   92,   52,   50,   50,   55,   55,
+       55,   92,   92,  532,   52,   53,   53,   53,   53,  220,
+       56,  223,  531,   53,  531,   56,   55,   55,   55,   55,
+       55,   55,   55,   55,   55,   55,  184,  184,  184,   94,
+       70,   70,   70,   71,   71,   71,   94,   94,   60,  223,
+       53,   53,   70,   53,   53,   71,   53,   56,  726,   60,
+      106,  191,   60,  686,   93,   93,   93,   53,   53,  686,
+
+      106,   56,   93,   93,  181,   70,  725,   60,   71,   53,
+       53,  181,   53,   53,  723,   53,   56,   60,  722,  106,
+       60,   72,   72,   72,  910,   53,   53,  214,  106,   56,
+       57,   58,  181,   72,   70,   96,   57,   71,  222,  181,
+      191,  716,   96,   96,   57,  189,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,   57,   59,  222,   58,   72,
+       59,  208,  208,  208,   59,   58,   57,   96,  191,   58,
+       59,  190,   58,   72,   59,  714,  214,  189,   61,  206,
+       57,  706,   58,   61,  910,   59,  222,   58,   72,   59,
+       61,   61,   62,   59,   58,   57,   96,   58,   59,   62,
+
+       58,   72,   59,  190,  214,  224,  189,   61,   57,   62,
+       58,  206,   61,  210,  210,  210,   62,  689,   61,   61,
+      664,   62,  225,  225,  225,  585,  580,  232,   62,  578,
+      558,  235,  190,  224,  232,  232,  554,   62,  235,  235,
+      206,  372,  372,  372,   62,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   97,  101,  101,  105,  204,  204,
+      204,   97,   97,  226,  538,  227,  213,  675,  101,  675,
+      534,  111,  105,  111,  111,  111,  111,  111,  111,  111,
+      111,  111,  111,  421,  101,  101,  105,  375,  375,  375,
+      419,  226,  173,  227,  173,  204,  101,  114,  213,  534,
+      105,  219,  412,   97,  113,  113,  113,  113,  113,  113,
+      113,  113,  113,  113,  114,  228,  115,  118,  219,  114,
+
+      116,  115,  118,  125,  204,  116,  410,  213,  125,  231,
+      173,   97,  100,  114,  100,  115,  118,  229,  116,  116,
+      386,  221,  125,  114,  173,  115,  118,  219,  114,  116,
+      115,  118,  125,  379,  116,  228,  249,  125,  230,  173,
+      374,  114,  251,  115,  118,  100,  116,  116,  117,  100,
+      125,  100,  173,  117,  243,  221,  100,  276,  100,  100,
+      248,  231,  117,  228,  249,  401,  229,  117,  100,  294,
+      251,  294,  401,  401,  100,  371,  343,  117,  100,  294,
+      100,  230,  117,  221,  100,  276,  100,  100,  535,  231,
+      117,  250,  243,  248,  229,  117,  100,  110,  110,  110,
+
+      110,  110,  110,  110,  110,  110,  110,  119,  121,  230,
+      913,  247,  119,  121,  120,  110,  110,  535,  119,  120,
+      243,  248,  120,  246,  400,  121,  119,  121,  110,  245,
+      233,  233,  233,  120,  341,  277,  119,  121,  233,  233,
+      344,  119,  121,  120,  110,  110,  119,  122,  120,  122,
+      244,  120,  122,  121,  119,  121,  110,  177,  123,  218,
+      400,  120,  341,  123,  212,  345,  122,  346,  344,  354,
+      913,  177,  277,  347,  209,  123,  122,  123,  122,  124,
+      202,  122,  348,  126,  124,  187,  177,  123,  126,  400,
+      124,  349,  123,  345,  122,  346,  183,  126,  124,  177,
+
+      277,  347,  126,  123,  676,  123,  676,  354,  124,  127,
+      348,  175,  126,  124,  127,  174,  237,  126,  124,  349,
+       89,  127,  127,  237,  237,  126,  124,  127,  127,  128,
+      126,  128,  129,  389,  128,  130,  354,  129,  127,  292,
+      130,  292,  361,  127,  234,  234,  234,  130,  128,  127,
+      127,  129,  234,  234,  130,  127,  127,  536,  128,  237,
+      128,  129,   88,  128,  130,  388,  129,   84,  389,  130,
+      361,  380,  380,  380,  356,  130,  128,   65,   13,  129,
+      378,  238,  130,  131,  355,  131,  536,  237,  238,  238,
+      369,  292, 1051,  388,  390,  133,  389,  392,    9,  131,
+
+      133,  131,  131,  131,  131,  131,  131,  131,  131,  131,
+      131,  132, 1081,  133,  133,  134,  132,    7,  134,  292,
+      134,  388,  132,  398,  133,  392,  356,  355,  369,  133,
+      132,  390,  378,  238,  134,  677,  131,  677,  131, 1130,
+      132,  133,  133,  381,  134,  132,  136,  134,  135,  134,
+      132,  136, 1051,  135,  356,  355,  398,  369,  132,  390,
+      378,  238,  134,  136,  131,  136,  131,  135,  135,  139,
+      377,  137, 1081,  138,  139,  136,  137,  135,  138,  137,
+      136,  381,  135,  139,  138,  398,  137,  395,  139,    0,
+      137,  136,  138,  136,  418,  135,  135,  397,  139, 1130,
+
+      137,  382,  138,  139,  140,  137,  475,  138,  137,  140,
+      381,  139,  138,  377,  137,  395,  139,  142,  137,  142,
+      138,  140,  418,  140,  141,  399,  143,  144,  143,  141,
+     1131,  537,  144,  140,  475,    0,  143,  141,  140,  391,
+      533,  377,  144,  141,  397,  382,  144,    0,  543,  140,
+      142,  140,  466,  141,  466,  142,  144,  146,  141,  143,
+      537,  144,  146,  146,  143,  141,    0,  391,  533,  142,
+      144,  141,  397,  382,  144,  399,  146,    0,  143,  142,
+      145,    0,  145,  466,  142,  145,  146,  680,  143,  680,
+     1131,  146,  146,  143,  145,  391,  145,  142,  543,  145,
+
+      147,    0,  148,  399,  146,  147,  143,  148,  557,  145,
+      484,  145,  484,  546,  145,  148,  394,  394,  394,  147,
+      484,  148,  145,  147,  145,  149,  543,  145,  149,  147,
+      149,  148,  572,  150,  147, 1148,  148,  151,  150,    0,
+        0,  546,  151,  148,  149,  150,  547,  147,    0,  148,
+      151,  147,  150,  557,  149,    0,  151,  149,    0,  149,
+      544,  572,  150,  152,  153,    0,  151,  150,  152,  153,
+        0,  151,  149,  150,  547,  153,  152,  488,  151,  488,
+      150,  557,  152,  153,  151,    0,  155,  488,    0,  154,
+      155,  155,  152,  153,  154, 1148,  544,  152,  153,  521,
+
+      154,  521,    0,  153,  152,  155,  611,    0,  154,  521,
+      152,  153,  156,  253,  253,  155,  158,  156,  154,  155,
+      155,  158,  402,  154,  158,  544,  253,    0,  154,  402,
+      402,  156,  157,  155,  611,  158,  154,  157,  559,  559,
+      559,  156,  253,  253,    0,  158,  156,  612,    0,  157,
+      158,  157,  157,  158,  253,  160,  160,  159,    0,  156,
+      160,  157,  159,  158,  614,  159,  157,  370,  370,  370,
+      615,  159,  402,  561,  160,  612,  159,  157,    0,  157,
+      157,  194,  162,  194,  160,  160,  159,  162,  161,  160,
+      161,  159,  614,  161,  159,  556,  556,  556,  615,  159,
+
+      402,  162,  160,  162,  159,    0,  161,  161,  370,  542,
+      161,  162,  575,  163,  194,  564,  162,  161,  163,  161,
+      164,  555,  161,  561,  163,  164,  164,  563,  194,  162,
+        0,  162,  163,  164,  161,  161,  556,  370,  161,  164,
+      165,  575,  163,  194,  568,  165,  692,  163,  692,  164,
+      617,  561,  163,  562,  164,  164,  194,  165,  542,  165,
+      163,  164,  564,  166,  403,  556,  682,  164,  166,  165,
+      555,  403,  403,  577,  165,  569,  563,  166,  617,  568,
+      166,    0,  166,  167,  167,  165,  542,  165,  167,  562,
+      564,  697,  166,  697,  682,  167,  569,  166,  555,  744,
+
+      403,    0,  167,  570,  563,  166,  577,  568,  166,  168,
+      166,  579,  167,  167,  168,  169,    0,  167,  562,  169,
+      169,    0,  168,  167,  570,  569,  168,  744,  168,  403,
+      167,  571,  170,    0,  169,  577,  753,  170,  168,    0,
+      170,  171,    0,  168,  169,  171,  171,  579,  169,  169,
+      168,  170,  571,  570,  168,    0,  168,  574,  574,  574,
+      171,  170,  169,  172,  753,  581,  170,  604,  172,  170,
+      171,  172,  581,  581,  171,  171,  579,  582,  613,  170,
+      618,  571,  172,  687,  582,  582,    0,    0,  171,  678,
+        0,  678,  172,  185,  185,  185,  604,  172,  756,  678,
+
+      172,  581,  679,  635,  815,  635,  815,  613,  757,  618,
+      172,  185,  185,  185,  185,  185,  185,  185,  185,  185,
+      185,  186,  681,  687,    0,  678,  756,  186,  713,    0,
+      581,  679,  691,  608,  635,  608,  757,  186,  186,  186,
+      186,  186,  186,  186,  186,  186,  186,  192,  683,  713,
+      683,  681,  687,  192,  678,  684,  684,  684,  683,    0,
+      703,  691,  683,  192,  192,  192,  192,  192,  192,  192,
+      192,  192,  192,  193,  608,  215,  215,  215,  713,  193,
+      708,  708,  708,  748,  826,  826,  826,  193,  608,  193,
+      193,  193,  193,  193,  193,  193,  193,  193,  193,  195,
+
+      703,  196,  197,  608,  195,  749,  196,  197,  215,    0,
+      195,  616,  748,  196,  196,  688,  608,  195,  195,  196,
+      196,  197,  215,  832,  832,  832,  704,  616,  195,  703,
+      196,  197,  707,  195,  749,  196,  197,  215,  195,  198,
+      616,  196,  196,    0,  198,  195,  195,  196,  196,  197,
+      215,  688,  702,  198,  702,  616,  200,    0,  198,  201,
+      199,  200,  199,  201,  201,  199,  702,  755,  198,  758,
+        0,  200,  707,  198,  199,  200,  199,  704,  201,  199,
+      688,  198,  759,  807,    0,  200,  198,    0,  201,  199,
+      200,  199,  201,  201,  199,  216,  755,    0,  758,  200,
+
+        0,  707,  199,  200,  199,  704,  201,  199,    0,    0,
+      759,  807,  216,  216,  216,  216,  216,  216,  216,  216,
+      216,  216,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  239,    0,  239,  860,  760,  239,  239,  239,  239,
+      239,  239,  239,  239,  239,  239,  240,    0,  240,  863,
+      805,  240,  240,  240,  240,  240,  240,  240,  240,  240,
+      240,  241,  860,  241,  760,  806,  241,  241,  241,  241,
+      241,  241,  241,  241,  241,  241,  254,  863,  254,  805,
+        0,  254,  254,  254,  254,  254,  254,  254,  254,  254,
+      254,  255,    0,  255,  806,    0,  255,  255,  255,  255,
+      255,  255,  255,  255,  255,  255,  256,  808,  256,  259,
+      865,  256,  256,  256,  256,  256,  256,  256,  256,  256,
+
+      256,  257,  257,  257,  257,  257,  257,  257,  257,  257,
+      257,    0,  259,  769,  260,  769,  808,  259,  865,  260,
+      257,  258,  258,  258,  258,  258,  258,  258,  258,  258,
+      258,  259,  260,  260,  261,  813,  901,  262,  901,  261,
+      258,  259,  262,  260,  769,  261,  259,  727,  260,  257,
+      908,  262,  908,  261,  727,  727,  262,  263,  705,  259,
+      260,  260,  263,  261,  813,  693,  262,  693,  261,  258,
+      263,  262,    0,  261,    0,  693,  263,  264,  266,  262,
+      265,  261,  264,  266,  262,  265,  263,  803,  266,  803,
+      264,  263,    0,    0,  705,  803,  264,  266,  263,  265,
+
+      265,  693,  851,  268,  263,  810,  264,  266,  268,  265,
+      267,  264,  266,    0,  265,  267,  266,    0,  264,    0,
+      268,  267,  268,  705,  264,  266,    0,  265,  265,  267,
+      693,  851,  268,  269,    0,  271,  821,  268,  269,  267,
+      271,  270,  810,    0,  267,  700,  270,  700,  268,  267,
+      268,  269,  269,  270,  271,  700,  270,  267,  272,  700,
+      270,    0,  269,  272,  271,  272,  728,  269,    0,  271,
+      270,  810,  821,  728,  728,  270,    0,  272,  273,  269,
+      269,  270,  271,  273,  270,  274,    0,  272,  270,  273,
+      274,  729,  272,  794,  272,  794,  274,  273,  729,  729,
+
+        0,  821,    0,  794,  274,  272,    0,  273,  278,  278,
+      857,  275,  273,  278,  274,  275,  275,  273,  900,  274,
+      859,  809,  809,  809,  274,  273,  820,  278,  279,  809,
+      275,  280,  274,  279,  824,  279,  280,  278,  278,  857,
+      275,  284,  278,  284,  275,  275,  900,  279,  281,  859,
+      280,  861,  281,  281,    0,  278,  862,  279,  275,  864,
+      280,  925,  279,  820,  279,  280,    0,  281,  283,    0,
+        0,  824,  284,  283,  284,  279,  283,  281,  280,  284,
+      861,  281,  281,  838,  875,  862,  875,  283,  864,  925,
+      838,  838,  820,  284,  875,  281,  282,  283,  282,  285,
+
+      824,  894,  283,  284,  285,  283,  286,  899,  284,  422,
+      422,  286,  839,  902,  893,  283,  893,  285,  285,  839,
+      839,  284,  422,    0,  893,  286,    0,  282,  285,  282,
+      894,  911,  282,  285,  282,  286,  899,  282,  422,  422,
+      286,  282,  902,    0,  282,  285,  285,  282,  282,  289,
+      422,  282,  287,  286,  289,  288,  287,  287,  282,  288,
+      288,  282,  934,  282,  937,  884,  282,  884,  289,  282,
+        0,  287,  282,    0,  288,  282,  282,  926,  289,  282,
+      911,  287,  290,  289,  288,  287,  287,  290,  288,  288,
+      291,  934,  291,  937,  290,  291,  289,  929,  293,  287,
+
+      931,  290,  288,  293,  896,  926,  896,  932,  911,  291,
+        0,  290,  293,  884,    0,  296,  290,  293,  933,  291,
+      296,  291,  290,  935,  291,  929,  296,  293,  931,  290,
+      961,  297,  293,    0,  296,  932,  297,  291,  298,  896,
+      293,  884,  297,  298,  296,  293,  933,    0,  954,  296,
+      297,  935,    0,  964,  296,    0,    0,  298,  298,  961,
+      297,  299,  296,    0,    0,  297,  299,  298,  896,  965,
+      297,  980,  298,  948,  948,  948,  954,  966,  297,  972,
+      299,  299,  964,  300,  301,  298,  298,  300,  300,  301,
+      299,  302,  301,  302,  303,  299,  303,  965,  967,  980,
+
+      300,  302,  300,  301,  303,  968,  966,  968,  299,  299,
+        0,    0,  300,  301,  989,  972,  300,  300,  301,  990,
+      304,  301,  973,  981,  302,  304,  984,  303,  300,  302,
+      300,  301,  303,  967,  968,  302,  968,    0,  303,  304,
+      304,  986,  989,  302,  972,  302,  303,  990,  303,  304,
+     1005,    0,  981,  302,  304,  984,  303,    0,  302,  973,
+      305,  303,  967,  302,  305,  305,  303,  304,  304,  987,
+      986,  302,  306,  302,  303,  988,  303,  306, 1005,  305,
+      307,  308, 1008, 1016,  307,  307,  308,    0,  973,  305,
+     1010,  306,  308,  305,  305,    0,    0,  309,  987,  307,
+
+      308,  306,  309, 1015,  988,    0,  306,  305,    0,  307,
+      308, 1008, 1013,  307,  307,  308,  309,  310, 1010,  306,
+      308,  309,  310,  998,  998,  998,  309,  307,  308, 1016,
+      310,  309, 1015,  311,  312,    0,  310,  313,  311,  312,
+     1013,  311,  313,  852,  309,  852,  310, 1017,    0,  309,
+        0,  310,  311,  312,  314,    0,  313, 1016,  310,  314,
+     1018,    0,  311,  312,  310, 1028,  313,  311,  312, 1027,
+      311,  313,  314,  314,  315,    0, 1017,  316,  852,  315,
+      311,  312,  316,  314,  313, 1022, 1032,  315,  314, 1018,
+      316,  852, 1034,  315, 1028,    0,  316, 1027,  316, 1036,
+
+      314,  314, 1021,  315,  317, 1023,  316,  852,  315,  317,
+      317,  316,    0,    0, 1032,  315, 1043, 1022,  316,  852,
+     1034,  315, 1049,  317,  316,  318,  316, 1036,    0,  319,
+      318,    0,  319,  317,  319,    0,  318,  320,  317,  317,
+      319, 1023,  320,    0,  318, 1043, 1022, 1021,  319, 1046,
+     1049,  317,    0, 1024,  318, 1053,  320,  320,  319,  318,
+      321,  319,  322,  319,  318,  321,  320,  322,  319,  323,
+     1023,  320,  318, 1052,  323, 1021,  319,  323, 1046,  321,
+      321,  322,  322, 1053,  320,  320,    0,    0,  323,  321,
+        0,  322,  326, 1024,  321,  324,  322,  326,  323,  324,
+
+      324,    0, 1052,  323, 1060,  326,  323,  321,  321,  322,
+      322,  326,  328,    0,  324,  325,  323,  328,  327,  325,
+      325,  326, 1024,  327,  324,  327,  326, 1061,  324,  324,
+     1058,  328, 1060,  326,  325,    0, 1055,  327,  329,  326,
+        0,  328,  324,  329,  325,  330,  328,  327,  325,  325,
+      330, 1057,  327,  332,  327,  332, 1061,  329,    0,  328,
+      330,  331,  325,  332,  330,  327,  331,  329, 1041, 1041,
+     1041, 1055,  329,    0,  330, 1058, 1064,    0,  331,  330,
+      331, 1066,  333, 1056, 1057,  329,  332,  333,  330,  333,
+      331,  332,  330,  334, 1072,  331,    0, 1074,  334,  334,
+
+     1055,  333,  336, 1058, 1064,  332,  331,  336,  331, 1076,
+     1066,  333,  334, 1057,  336,  332,  333, 1056,  333,  335,
+      332,  336,  334, 1072,  335, 1074, 1078,  334,  334,  333,
+        0,  336,  335,  332,    0,    0,  336, 1076,  335,  337,
+      334, 1085,  336,    0,  337,  338, 1056, 1094,  335,  336,
+      338,    0,  974,  335, 1078, 1086,  337, 1090,  337, 1083,
+      335,  876,  876,  876,  338,    0,  335,    0,  337,  876,
+     1085, 1082,  876,  337,  338,  351, 1094,  351,    0,  338,
+      946,  946,  946, 1086,  337, 1090,  337,  974,  946,  974,
+        0,  946,  338,  351,  351,  351,  351,  351,  351,  351,
+
+      351,  351,  351,  352,  947,  947,  947, 1082,    0,  352,
+        0, 1083,  947,    0, 1077,  947,  974,    0,  974,  352,
+      352,  352,  352,  352,  352,  352,  352,  352,  352,  353,
+      949,  949,  949,    0,    0,  353, 1082, 1098,  949, 1083,
+        0,  949, 1070, 1070, 1070,  353,  353,  353,  353,  353,
+      353,  353,  353,  353,  353,  357, 1092, 1092, 1092, 1077,
+     1099,  357,  362,  363,    0,  364,  362,  362,  363,  357,
+      364,  357,  357,  357,  357,  357,  357,  357,  357,  357,
+      357,  362,  363, 1098,  364,  365,  365, 1077, 1099, 1103,
+      365,  362,  363,  368,  364,  362,  362,  363, 1104,  364,
+
+        0,  366,    0,    0,  365,  366,  366,    0,    0,  362,
+      363, 1098,  364, 1111,  365,  365, 1107, 1103,  366,  365,
+      366,  367,    0,  433,  368,  367,  367, 1104,  433,  368,
+      366, 1100,  365,    0,  366,  366,  950,  950,  950, 1113,
+      367, 1111,  433,  368,  950, 1107,  366,  950,  366,    0,
+      367, 1116,  433,  368,  367,  367,  383,  433,  368,    0,
+        0,  999,  999,  999,    0,    0, 1100, 1113,  367,  999,
+      433,  368,  999,  383,  383,  383,  383,  383,  383,  383,
+      383,  383,  383,  384,    0, 1000, 1000, 1000, 1101, 1101,
+     1101,    0,  383, 1000, 1121, 1100, 1000, 1116, 1127,    0,
+
+      384,  384,  384,  384,  384,  384,  384,  384,  384,  384,
+      387,    0, 1001, 1001, 1001, 1117, 1117, 1117, 1136,  384,
+     1001,  383, 1121, 1001,    0, 1116, 1127,  387,  387,  387,
+      387,  387,  387,  387,  387,  387,  387,  404,  404,  404,
+      404,  404,  404,  404,  404,  404,  404, 1136,  384,  405,
+      405,  405,  405,  405,  405,  405,  405,  405,  405,  406,
+      406,  406,  406,  406,  406,  406,  406,  406,  406,  407,
+      407,  407,  407,  407,  407,  407,  407,  407,  407,  408,
+      408,  408,  408,  408,  408,  408,  408,  408,  408,  409,
+      409,  409,  409,  409,  409,  409,  409,  409,  409,  423,
+
+      423,  423,  423,  423,  423,  423,  423,  423,  423,  424,
+      424,  424,  424,  424,  424,  424,  424,  424,  424,  425,
+      425,  425,  425,  425,  425,  425,  425,  425,  425,  426,
+      426,  426,  426,  426,  426,  426,  426,  426,  426,  427,
+      427,  427,  427,  427,  427,  427,  427,  427,  427,  428,
+      428,  428,  428,  428,  428,  428,  428,  428,  428,  429,
+     1102,  429,    0,    0,  429,  429,  429,  429,  429,  429,
+      429,  429,  429,  429,  430,  430,  430,  430,  430,  430,
+      430,  430,  430,  430,    0,  436,    0,  434,    0,  431,
+      436,  431,  434,  430,  431,  431,  431,  431,  431,  431,
+
+      431,  431,  431,  431,  436,  434,  434,  435,  437,  435,
+     1144, 1102,  435,  437,  436,    0,  434, 1132, 1147,  436,
+        0,  434,  430,    0,  438,    0,  435,  437,  438,  438,
+      439,    0,  436,  434,  434,  439,  435,  437,  435, 1102,
+        0,  435,  437,  438,    0, 1132,  440, 1140,  439,  439,
+     1147,  440,    0,  438,  435,  437, 1144,  438,  438,  439,
+        0,    0,  441,    0,  439,  440, 1114,  441,  442,  443,
+        0,  438,  442,  442,  443,  440,  439,  439, 1139, 1147,
+      440,  441,    0,  443, 1144,  446, 1146,  442,  443,  444,
+      446,  441, 1140,  440,  444, 1143,  441,  442,  443, 1156,
+
+      444,  442,  442,  443,  446,  445,    0, 1149,  444,  441,
+      445,  443,    0,  445,  446,  442,  443, 1114,  444,  446,
+     1140,  447,  448,  444,  445,  447,  447,  448,  444, 1139,
+      449, 1156,  446,  448,  445,  449,  444, 1146,    0,  445,
+      447,  448,  445,  449, 1143, 1114, 1124, 1124, 1124,  449,
+      447,  448,  445,    0,  447,  447,  448, 1139, 1149,  449,
+     1156,  448,  451,    0,  449, 1146, 1145,  451,  447,  448,
+      452,  449, 1143,  451,  453,  452, 1152,  449,  452,  453,
+        0,  451,    0,    0, 1150,  454, 1149,  454,    0,  452,
+        0,  451,  453,  453,    0,    0,  451,    0,    0,  452,
+
+        0,  451, 1145,  453,  452,    0,    0,  452,  453,  451,
+      458, 1151, 1151, 1151,  457,  458,    0,  452,  454,  457,
+      453,  453,    0,  454,    0, 1152,  454,    0,  457,  458,
+      458, 1145,    0,  457,    0, 1150,    0,  454,    0,  458,
+      454,  459,    0,  457,  458,  460,  459,  454,  457,    0,
+      460,    0,  454, 1152, 1155,  454,  457,  458,  458,  460,
+      459,  457,  468, 1150,  460,  454,    0,  468,  454,  455,
+      459,  455,    0,    0,  460,  459, 1153, 1153, 1153,  460,
+        0,  468,    0,    0,  461,    0,    0,  460,  459,  461,
+     1155,  468,  460, 1158, 1158, 1158,  468, 1159, 1159, 1159,
+
+      455,  461,    0,  461,    0,  455,  463,  455,    0,  468,
+      455,  463, 1157,  461,  455,    0,    0,  455,  461, 1155,
+      455,  455,    0,    0,  455,  463,    0,    0,    0,  461,
+      463,  461,    0,    0,  455,  463,  455,    0,  472,  455,
+      463,    0,  455,  472,    0,  455,  462,    0,  455,  455,
+      462,  462,  455,  463,  464,  465,    0,  472,  463,  464,
+      465,  464,    0, 1157,    0,  462,  462,  472,    0,    0,
+        0,    0,  472,  464,  465,  462,  465,    0,    0,  462,
+      462,    0,    0,  464,  465,  472,    0,    0,  464,  465,
+      464, 1157,    0,  462,  462,    0,    0,    0,    0,    0,
+
+        0,  464,  465,    0,  465,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,    0,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  469,  469,  469,  469,  469,  469,
+      469,  469,  469,  469,  470,    0,  471,  473,  471,  470,
+
+        0,    0,  473,  474, 1002, 1002, 1002,    0,  474,    0,
+        0,  470, 1002,  470,    0, 1002,  473,    0,    0,    0,
+        0,    0,  474,  470,    0,    0,  473,  471,  470,  471,
+      476,  473,  474,    0,  471,  476,    0,  474,  477,  470,
+        0,  470,    0,  477,  473,    0,  477,    0,  471,  476,
+      474,    0,    0,    0,    0,    0,    0,  477,  471,  476,
+      478,    0,    0,  471,  476,  478,    0,  477,  479,    0,
+        0,    0,  477,  479,    0,  477,  471,  476,    0,  478,
+      478,    0,    0,    0,    0,  477,    0,  479,    0,  478,
+      480,    0,    0,    0,  478,  480,    0,  479,  480,  481,
+
+        0,    0,  479,    0,  481,  481,    0,  478,  478,  480,
+        0,    0,  481,    0,    0,  479,    0,    0,  481,  480,
+        0, 1003, 1003, 1003,  480,    0,    0,  480,  481, 1003,
+      482,  487, 1003,  481,  481,  482,  487,  480,  482,  483,
+      481,  483,  486,    0,  483,    0,  481,  486,    0,  482,
+      487,    0,    0,    0,    0,    0,  486,    0,  483,  482,
+      487,  486,    0,    0,  482,  487,    0,  482,  483,  490,
+      483,  486,    0,  483,  490,  491,  486,  482,  487,    0,
+      491,    0,    0,  490,  486,    0,  483,    0,  490,  486,
+        0,  492,    0,    0,  491,  493,  492,    0,  490,    0,
+
+      493,    0,  492,  490,  491,    0,  493,  494,    0,  491,
+      492,  490,  494,    0,  493,    0,  490,    0,  495,    0,
+      492,    0,  491,  495,  493,  492,  494,  496,    0,  493,
+      492,    0,  496,    0,  493,  496,  494,  495,  492,  497,
+        0,  494,  493,  498,  497,    0,  496,  495,  498,    0,
+      502,    0,  495,    0,  494,  502,  496,    0,  497,    0,
+        0,  496,  498,    0,  496,  495,  499,    0,  497,  502,
+      500,  499,  498,  497,  496,  500,    0,  498,    0,  502,
+      499,    0,  500,    0,  502,  499,  497,  501,    0,  500,
+      498,  501,  501,  503,    0,  499,  504,  502,  503,  500,
+
+      499,  504,    0,    0,  500,    0,  501,    0,  499,    0,
+      500,    0,  503,  499,    0,  504,  501,  500,  505,  507,
+      501,  501,  503,  505,  507,  504,    0,  503,    0,  508,
+      504, 1042, 1042, 1042,  501,  505,    0,  505,  507, 1042,
+      503,  506, 1042,  504,    0,    0,  506,  505,  507,  506,
+      508,    0,  505,  507,    0,  508,    0,  509,    0,    0,
+      506,    0,  509,  505,    0,  505,  507,    0,    0,  508,
+      506,    0,    0,    0,  509,  506,  509,    0,  506,  508,
+        0,    0,  510,    0,  508,    0,  509,  510,  506,  511,
+      512,  509,    0,  510,  511,  512,    0,  508,    0,    0,
+
+        0,  510,  509,  512,  509,    0,  511,    0,  511,  512,
+        0,  510,    0,    0,    0,    0,  510,    0,  511,  512,
+      513,  510,  515,  511,  512,  513,    0,  515,  514,  510,
+      514,  512,    0,  514,  511,    0,  511,  512,  517,  513,
+        0,  515,    0,    0,    0,  516,    0,  514,    0,  513,
+      516,  515,    0,  518,  513,    0,  515,  514,  518,  514,
+        0,  517,  514,    0,  516,  519,  517,  513,    0,  515,
+      519,    0,  518,    0,  516,  514,    0,    0,    0,  516,
+      517,    0,  518,    0,  519,    0,  523,  518,  520,    0,
+      517,  523,  516,  520,  519,  517,    0,    0,    0,  519,
+
+      518,    0,  520,    0,    0,  523,    0,  520,  517,  524,
+        0,    0,  519,  524,  524,  523,    0,  520,  525,    0,
+      523,  526,  520,  525,    0,    0,  526,    0,  524,    0,
+      520,    0,    0,  523,    0,  520,    0,  525,  524,    0,
+      526,  527,  524,  524,  528,  527,  527,  525,  528,  528,
+      526,    0,  525,    0,    0,  526,  524,    0,    0,    0,
+      527,  551,    0,  528,    0,  525,  551,    0,  526,    0,
+      527,    0,    0,  528,  527,  527,    0,  528,  528,  539,
+      551,  539,    0,    0,    0, 1071, 1071, 1071,  527,    0,
+      551,  528,    0, 1071,    0,  551, 1071,  539,  539,  539,
+
+      539,  539,  539,  539,  539,  539,  539,  540,  551, 1093,
+     1093, 1093,    0,  540,    0,    0,    0, 1093,    0,    0,
+     1093,    0,    0,  540,  540,  540,  540,  540,  540,  540,
+      540,  540,  540,  541,  548,    0,  548,    0,    0,  541,
+        0,    0,    0,    0,  548,    0,    0,    0,    0,  541,
+      541,  541,  541,  541,  541,  541,  541,  541,  541,  545,
+      550,    0,  550,    0,    0,  545,  549,  548,    0,    0,
+      548,  549,  548,  545,  549,  545,  545,  545,  545,  545,
+      545,  545,  545,  545,  545,  549,  548,    0,    0,    0,
+        0,    0,    0,  550,    0,  549,  548,    0,  550,  548,
+
+      549,  548,  552,  549,    0,  592,    0,  552,  552,  592,
+      592,    0,  550,  549,  548,  552,    0,    0,  553,  552,
+      553,  552,  550,    0,  592,    0,    0,  550,  553,    0,
+        0,  552,  553,    0,  592,    0,  552,  552,  592,  592,
+      550,  565,    0,  552,    0,    0,    0,  552,    0,  552,
+        0,  553,  592,  565,    0,  565,  553,    0,  565,  565,
+      565,  565,  565,  565,  565,  565,  565,  565,    0,  566,
+      553, 1110, 1110, 1110,    0,    0,    0,    0,    0, 1110,
+      553,    0, 1110,    0,    0,  553,  566,  566,  566,  566,
+      566,  566,  566,  566,  566,  566,  567,    0,  553,    0,
+
+        0, 1125, 1125, 1125,    0,  566,    0,    0,  567, 1125,
+      567,    0, 1125,  567,  567,  567,  567,  567,  567,  567,
+      567,  567,  567,  588,  588,  588,  588,  588,  588,  588,
+      588,  588,  588,    0,  566,  589,  589,  589,  589,  589,
+      589,  589,  589,  589,  589,  590,  590,  590,  590,  590,
+      590,  590,  590,  590,  590,  591,  591,  591,  591,  591,
+      591,  591,  591,  591,  591,  593,    0,    0,  595,    0,
+      593,    0,    0,  595, 1134, 1134, 1134,    0, 1135, 1135,
+     1135,    0, 1134,  595,  593, 1134, 1135,  595,    0, 1135,
+        0,    0,    0,    0,  593,    0,    0,  595,    0,  593,
+
+        0,    0,  595,    0,    0,    0,    0,    0,    0,    0,
+        0,  595,  593,  594,  594,  595,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+      594,  594,  594,  594,  594,  594,  594,  594,  594,  594,
+
+      594,  594,  596,  597,  596,  598,  600,  596,  597,  599,
+      598,  600,    0,  599,  599,    0,    0,    0,  598,  600,
+        0,  596,  597,    0,  598,  600,    0,    0,  599,    0,
+        0,  596,  597,  596,  598,  600,  596,  597,  599,  598,
+      600,    0,  599,  599,    0,    0,  598,  600,    0,  596,
+      597,    0,  598,  600,  601,  602,  599,  603,    0,  601,
+      602,  605,  603,    0,    0,  605,  605,    0,    0,  602,
+        0,    0,    0,  601,  602,  603,  603,    0,    0,    0,
+      605,    0,    0,  601,  602,    0,  603,  606,  601,  602,
+      605,  603,  606,    0,  605,  605,    0,  602,  606,    0,
+
+        0,  601,  602,  603,  603,    0,  606,    0,  605,  609,
+      607,    0,    0,  610,  609,  607,  606,  607,  610,    0,
+      610,  606,    0,    0,    0,    0,  606,    0,  609,  607,
+        0,    0,  610,    0,  606,  619,  621,    0,  609,  607,
+      619,  621,  610,  609,  607,    0,  607,  610,    0,  610,
+        0,    0,    0,    0,  619,  621,  609,  607,  620,    0,
+      610,    0,    0,  620,  619,  621,    0,    0,    0,  619,
+      621,  620,    0,    0,  623,  622,    0,  620,  622,  623,
+      622,    0,  619,  621,    0,    0,    0,  620,  623,    0,
+        0,  624,  620,  623,  622,    0,  624,    0,    0,  620,
+
+        0,    0,  624,  623,  622,  620,    0,  622,  623,  622,
+      624,    0,  625,  625,  626,    0,  623,  625,  628,  626,
+      624,  623,  622,  628,    0,  624,    0,    0,    0,  626,
+      624,  625,    0,  626,    0,  627,    0,  628,  624,  627,
+      627,  625,  625,  626,    0,    0,  625,  628,  626,    0,
+        0,    0,  628,  629,  627,  629,    0,  626,    0,  625,
+        0,  626,    0,  632,  627,  628,    0,    0,  627,  627,
+      631,  631,  631,  631,  631,  631,  631,  631,  631,  631,
+      632,    0,  627,  633,  629,  632,  629,  634,  633,  637,
+        0,  629,  634,    0,  637,    0,    0,    0,    0,  632,
+
+      634,    0,  633,    0,    0,  629,  634,    0,  637,  632,
+        0,    0,  633,    0,  632,  629,  634,  633,  637,  638,
+      629,  634,    0,  637,  638,    0,    0,  632,  634,    0,
+      633,    0,    0,  629,  634,  639,  637,    0,  638,  641,
+      639,  641,  642,  639,  641,  642,  643,  642,  638,    0,
+        0,  643,    0,  638,  639,    0,    0,    0,  641,    0,
+        0,  642,  644,    0,  639,  643,  638,  644,  641,  639,
+      641,  642,  639,  641,  642,  643,  642,    0,    0,  644,
+      643,  644,  639,  645,    0,  646,  641,  645,  645,  642,
+      646,  644,  647,  643,  648,    0,  644,  647,    0,  648,
+
+        0,    0,  645,    0,  646,  647,    0,  644,    0,  644,
+        0,  647,  645,  648,  646,    0,  645,  645,    0,  646,
+        0,  647,    0,  648,    0,    0,  647,    0,  648,  649,
+      645,  649,  646,  647,  649,  650,    0,    0,    0,  647,
+      650,  648,    0,    0,    0,    0,  650,    0,  649,    0,
+        0,    0,    0,    0,  650,    0,    0,    0,  649,    0,
+      649,  652,    0,  649,  650,  651,  652,  651,    0,  650,
+      651,    0,  652,  653,  650,    0,  649,  653,  653,    0,
+      652,    0,  650,    0,  651,    0,    0,    0,    0,    0,
+      652,    0,  653,    0,  651,  652,  651,    0,  655,  651,
+
+      652,    0,  653,  655,    0,  654,  653,  653,  652,  656,
+      654,    0,  651,  654,  656,    0,    0,  655,    0,    0,
+      653,    0,  656,    0,  654,  657,    0,  655,  656,  657,
+      657,    0,  655,    0,  654,    0,  658,    0,  656,  654,
+        0,  658,  654,  656,  657,  655,    0,    0,  660,    0,
+      656,    0,  654,  660,  657,  658,  656,  659,  657,  657,
+        0,  659,  659,    0,    0,  658,    0,  660,  661,  662,
+      658,    0,  657,  661,  662,    0,  659,  660,    0,    0,
+        0,    0,  660,  658,    0,    0,  659,  661,  662,    0,
+      659,  659,    0,    0,  663,  660,  663,  661,  662,  663,
+
+      665,  666,  661,  662,  659,  665,  666,    0,    0,    0,
+        0,    0,    0,  663,    0,  661,  662,    0,  665,  665,
+      666,    0,    0,  663,    0,  663,  667,    0,  663,  665,
+      666,  667,    0,    0,  665,  666,    0,  668,    0,  667,
+      668,  663,  668,    0,    0,  667,  665,  665,  666,  669,
+        0,    0,    0,  672,  669,  667,  668,  671,  672,    0,
+      667,    0,  671,    0,    0,    0,  668,  667,  669,  668,
+        0,  668,  672,  667,  673,    0,  671,  671,  669,  673,
+      674,    0,  672,  669,  668,  674,  671,  672,    0,    0,
+        0,  671,    0,  673,    0,    0,  669,    0,    0,  674,
+
+      672,    0,    0,  673,  671,  671,    0,    0,  673,  674,
+        0,    0,  690,    0,  674,    0,    0,    0,  690,  695,
+        0,  673,    0,  695,  695,    0,  690,  674,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  690,  695,  696,
+      698,  699,    0,    0,  696,  698,  699,  696,  695,    0,
+        0,  698,  695,  695,    0,    0,    0,    0,  696,  698,
+      699,    0,    0,    0,    0,    0,  695,    0,  696,  698,
+      699,    0,  709,  696,  698,  699,  696,    0,    0,  698,
+        0,    0,  710,    0,    0,    0,  696,  698,  699,  709,
+      709,  709,  709,  709,  709,  709,  709,  709,  709,  710,
+
+      710,  710,  710,  710,  710,  710,  710,  710,  710,  711,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,  712,
+        0,    0,    0,    0,    0,    0,  711,  711,  711,  711,
+      711,  711,  711,  711,  711,  711,  712,  712,  712,  712,
+      712,  712,  712,  712,  712,  712,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  715,  715,  715,  715,  715,
+      715,  715,  715,  715,  715,  719,  719,  719,    0,    0,
+      719,  719,    0,  719,    0,    0,    0,  719,  719,    0,
+        0,  719,    0,    0,  719,  719,  719,  719,  719,  719,
+      719,  719,  719,  732,  732,    0,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  732,  732,  732,  732,  732,  732,  732,  732,
+      732,  732,  733,    0,    0,  735,    0,  733,  734,  734,
+      734,  734,  734,  734,  734,  734,  734,  734,  736,  737,
+        0,  733,  735,  736,  737,  738,    0,  735,    0,    0,
+      738,  733,    0,    0,    0,    0,  733,  736,  737,    0,
+        0,  735,    0,    0,  738,  739,    0,  736,  737,  733,
+
+      739,  735,  736,  737,  738,    0,  735,  740,    0,  738,
+        0,    0,  740,    0,  739,  736,  737,    0,  741,  735,
+        0,    0,  738,  741,  739,    0,  740,    0,    0,  739,
+      740,    0,    0,    0,    0,    0,  740,  741,  741,    0,
+        0,  740,  739,  742,    0,  742,    0,  741,  742,    0,
+      747,  743,  741,    0,  740,  747,  743,    0,  740,  743,
+        0,  745,  742,  745,    0,  741,  741,    0,    0,  747,
+      743,    0,  742,  750,  742,    0,    0,  742,  750,  747,
+      743,    0,  746,    0,  747,  743,  746,  746,  743,    0,
+      742,    0,  750,    0,  745,    0,  745,  747,  743,  745,
+
+        0,  746,  750,    0,    0,    0,    0,  750,    0,  745,
+        0,  746,    0,  745,  751,  746,  746,    0,  751,  751,
+      750,    0,    0,  745,    0,  745,  762,    0,  745,  746,
+        0,  762,    0,  751,  761,    0,  761,  745,    0,  761,
+        0,  745,    0,  751,    0,  762,  762,  751,  751,    0,
+        0,  763,    0,  761,    0,  762,  763,  763,    0,    0,
+      762,  751,    0,  761,    0,  761,    0,    0,  761,    0,
+      763,  764,  765,  762,  762,  764,  764,  765,  766,    0,
+      763,  761,  766,  766,    0,  763,  763,    0,    0,  765,
+      764,  765,    0,    0,  771,    0,    0,  766,  763,  771,
+
+      764,  765,    0,  767,  764,  764,  765,  766,  767,    0,
+      768,  766,  766,  771,  772,  768,  772,  765,  764,  765,
+      767,  768,  767,  771,  772,  766,  773,    0,  771,  768,
+        0,  773,  767,    0,    0,    0,    0,  767,    0,  768,
+      773,  771,    0,    0,  768,  773,  774,  772,  767,  768,
+      767,  774,  772,    0,  774,  773,    0,  768,  775,    0,
+      773,    0,  775,  775,    0,  774,  772,  776,  773,  778,
+        0,  776,  776,  773,  778,  774,  772,  775,    0,    0,
+      774,  772,    0,  774,    0,    0,  776,  775,  778,    0,
+      777,  775,  775,  774,  772,  777,  776,    0,  778,  779,
+
+      776,  776,    0,  778,  779,  775,    0,  777,    0,  777,
+      780,    0,    0,    0,  776,  780,  778,  779,  779,  777,
+        0,  780,  781,    0,  777,    0,    0,  781,  779,  780,
+        0,  782,    0,  779,    0,  777,  782,  777,    0,  780,
+        0,  781,  783,  784,  780,  779,  779,  783,  784,  780,
+      782,  781,    0,  785,    0,  785,  781,  780,    0,    0,
+      782,  783,  784,  786,    0,  782,    0,    0,  786,  781,
+        0,  783,  784,    0,  787,    0,  783,  784,  782,  787,
+        0,  786,  786,  788,    0,    0,  785,    0,  788,  783,
+      784,  785,  786,  787,  789,    0,    0,  786,  787,  789,
+
+        0,  785,  788,  787,    0,  785,    0,    0,  787,  786,
+      786,    0,  788,  789,    0,  785,    0,  788,    0,  790,
+      785,  787,    0,  789,  790,    0,  787,  791,  789,  785,
+      788,  791,  791,  785,    0,    0,  790,    0,  790,  792,
+        0,  789,    0,    0,  792,    0,  791,    0,  790,    0,
+        0,  792,    0,  790,    0,    0,  791,    0,  792,    0,
+      791,  791,  793,    0,  790,    0,  790,  793,  792,    0,
+      795,  796,    0,  792,  791,  795,  796,    0,  795,  792,
+        0,  793,  797,    0,    0,    0,  792,  797,    0,  795,
+      796,  793,    0,  798,    0,  799,  793,  799,  798,  795,
+
+      796,  797,    0,    0,  795,  796,    0,  795,    0,  793,
+        0,  797,  798,    0,    0,    0,  797,  795,  796,  800,
+      801,    0,  798,    0,  800,  801,  816,  798,  799,  797,
+      799,  816,    0,  799,    0,    0,    0,    0,  800,  801,
+      798,    0,    0,    0,    0,  816,    0,  799,  800,  801,
+        0,  817,    0,  800,  801,  816,  817,  799,    0,  799,
+      816,    0,  799,    0,  817,    0,  800,  801,    0,  818,
+      817,  818,    0,  816,  842,  799,  802,  802,  802,  802,
+      817,    0,    0,    0,    0,  817,    0,    0,    0,    0,
+      819,  842,  817,    0,    0,  819,  842,    0,  817,    0,
+
+        0,    0,  818,    0,    0,    0,    0,  818,    0,  819,
+      842,  802,  802,    0,    0,  802,    0,  802,    0,  819,
+      842,  818,    0,    0,  819,  842,    0,    0,  802,  802,
+        0,  818,    0,    0,    0,    0,  818,  819,  842,    0,
+      802,  802,    0,    0,  802,    0,  802,    0,    0,  818,
+        0,    0,    0,    0,    0,    0,  802,  802,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  827,  827,  827,
+      827,  827,  827,  827,  827,  827,  827,  828,  841,  841,
+      841,  841,  841,  841,  841,  841,  841,  841,    0,    0,
+        0,    0,    0,    0,  828,  828,  828,  828,  828,  828,
+      828,  828,  828,  828,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  829,  829,  829,  829,  829,  829,  829,
+      829,  829,  829,  843,    0,  844,    0,  847,  843,  844,
+      844,  845,  847,  845,  846,    0,  845,    0,  846,  846,
+        0,    0,  843,    0,  844,    0,  847,    0,    0,    0,
+      845,    0,  843,  846,  844,    0,  847,  843,  844,  844,
+
+      845,  847,  845,  846,  849,  845,    0,  846,  846,  849,
+      843,  848,  844,    0,  847,  848,  848,    0,  845,    0,
+      850,  846,    0,  849,    0,  850,    0,  853,    0,    0,
+      848,  854,  853,  849,  850,    0,  854,    0,  849,  850,
+      848,  853,    0,    0,  848,  848,  853,    0,  854,  850,
+      854,  849,  855,    0,  850,    0,  853,  855,  848,    0,
+      854,  853,  850,  858,    0,  854,    0,  850,  858,  853,
+        0,  855,  866,    0,  853,    0,  854,  866,  854,    0,
+      858,  855,  858,  867,    0,    0,  855,    0,  867,    0,
+        0,  866,  858,    0,  867,    0,    0,  858,    0,  855,
+
+        0,  866,  867,    0,  868,    0,  866,    0,  858,  868,
+      858,    0,  867,  869,    0,  869,    0,  867,  869,  866,
+        0,  868,  867,  868,    0,    0,    0,    0,    0,  870,
+      867,    0,  869,  868,  870,  871,    0,    0,  868,    0,
+      871,    0,  869,  870,  869,    0,    0,  869,  870,  868,
+        0,  868,    0,    0,  871,    0,    0,    0,  870,    0,
+      869,  872,    0,  870,  871,  872,  872,    0,  873,  871,
+      874,  870,  873,  873,    0,  874,  870,    0,    0,    0,
+      872,  874,  871,    0,    0,    0,    0,  873,    0,  874,
+      872,  878,    0,  877,  872,  872,  878,  873,  877,  874,
+
+        0,  873,  873,    0,  874,    0,  877,    0,  872,  874,
+      878,    0,  877,  879,  880,  873,  881,  874,  879,  880,
+      878,  881,  877,    0,    0,  878,    0,  877,    0,    0,
+        0,    0,  879,  880,  877,  881,  882,    0,  878,    0,
+      877,  882,  879,  880,  882,  881,    0,  879,  880,    0,
+      881,    0,  883,  886,    0,  882,    0,  883,  886,  885,
+      879,  880,    0,  881,  885,  882,    0,    0,    0,    0,
+      882,  883,  886,  882,    0,    0,  885,    0,  885,  887,
+        0,  883,  886,  882,  887,    0,  883,  886,  885,    0,
+      888,  890,    0,  885,    0,  888,  890,    0,  887,  883,
+
+      886,  888,  891,    0,  885,    0,  885,  891,  887,  888,
+      890,  889,    0,  887,    0,  889,  889,    0,    0,  888,
+      890,  891,  892,  897,  888,  890,  887,  892,  897,  888,
+      889,  891,    0,    0,  895,    0,  891,  888,  890,  895,
+      889,  892,  897,  906,  889,  889,    0,    0,  906,  891,
+        0,  892,  897,  895,    0,  895,  892,  897,  889,  898,
+        0,    0,  906,  895,  898,    0,  907,  898,  895,  892,
+      897,  907,  906,    0,    0,    0,    0,  906,  898,    0,
+        0,  895,    0,  895,  907,  907,    0,    0,  898,  909,
+      906,  909,    0,  898,  909,  907,  898,    0,    0,    0,
+
+      907,    0,    0,    0,    0,    0,  898,  914,  909,    0,
+        0,    0,  907,  907,    0,    0,  917,  917,  909,    0,
+      909,  917,    0,  909,  914,  914,  914,  914,  914,  914,
+      914,  914,  914,  914,    0,  917,  909,  918,    0,  919,
+        0,    0,  918,  919,  919,  917,  917,    0,  920,    0,
+      917,    0,    0,  920,    0,    0,  918,    0,  919,    0,
+        0,    0,    0,  917,    0,  920,  918,  920,  919,  921,
+      922,  918,  919,  919,  921,  922,    0,  920,  923,    0,
+        0,    0,  920,  923,  918,    0,  919,    0,  921,  922,
+        0,  923,    0,  920,    0,  920,    0,  923,  921,  922,
+
+        0,  927,    0,  921,  922,  928,  927,  923,    0,  928,
+      928,    0,  923,  927,    0,    0,  921,  922,    0,  923,
+      927,  938,    0,    0,  928,  923,  938,  930,  940,  938,
+      927,  930,  930,  940,  928,  927,    0,    0,  928,  928,
+      938,  927,    0,    0,    0,    0,  930,  940,  927,    0,
+      938,    0,  928,    0,    0,  938,  930,  940,  938,  939,
+      930,  930,  940,  939,  939,  941,  942,    0,  938,    0,
+      941,  942,    0,    0,  930,  940,    0,    0,  939,    0,
+        0,    0,  943,    0,  941,  942,  942,  943,  939,    0,
+        0,  944,  939,  939,  941,  942,  944,    0,    0,  941,
+
+      942,  943,  945,    0,  944,    0,  939,  945,    0,    0,
+      944,  943,  941,  942,  942,    0,  943,    0,  951,    0,
+      944,  945,  952,  951,    0,  944,    0,  952,    0,  943,
+        0,  945,  944,    0,    0,    0,  945,  951,  944,  955,
+        0,  952,    0,  953,  955,  953,    0,  951,  953,  945,
+        0,  952,  951,  955,    0,    0,  952,    0,  955,  956,
+        0,    0,  953,    0,  956,  951,  957,    0,  955,  952,
+      958,  957,  953,  955,  953,  958,    0,  953,  956,    0,
+        0,  955,    0,    0,    0,  957,  955,  958,  956,  958,
+      953,    0,  960,  956,    0,  957,  960,  960,    0,  958,
+
+      957,    0,    0,  963,  958,    0,  956,    0,  963,  962,
+        0,  960,    0,  957,  962,  958,  963,  958,    0,    0,
+        0,  960,  963,    0,    0,  960,  960,  962,  962,  969,
+        0,    0,  963,    0,  969,  970,    0,  963,  962,  960,
+      970,  971,    0,  962,  963,  971,  971,    0,  969,  969,
+      963,    0,  976,    0,  970,  962,  962,  976,  969,    0,
+      971,  975,    0,  969,  970,    0,  975,    0,  977,  970,
+      971,  976,  975,  977,  971,  971,  969,  969,    0,    0,
+      975,  976,  970,    0,  979,    0,  976,  977,  971,  979,
+      975,    0,    0,  985,    0,  975,    0,  977,  985,  976,
+
+      975,  978,  977,  979,  982,  978,  978,    0,  975,  982,
+        0,    0,  985,  979,    0,  977,    0,    0,  979,  982,
+      978,    0,  985,  982,  983,    0,  983,  985,    0,  983,
+      978,  979,    0,  982,  978,  978,    0,    0,  982,    0,
+      985,  993,    0,  983,  994,  992,  993,  982,  978,  994,
+      992,  982,    0,  983,    0,  983,  994,    0,  983,  992,
+      993,  995,    0,  994,  992,    0,  995,  996,    0,    0,
+      993,  983,  996,  994,  992,  993,    0,    0,  994,  992,
+      995,    0,    0,    0,  994,    0,  996,  992,  993,    0,
+      995,  994,  992, 1004,    0,  995,  996,  997, 1004,  997,
+
+     1007,  996,  997,    0, 1006, 1007, 1006,    0,  995, 1006,
+        0,    0, 1004,    0,  996,    0,  997,    0,    0, 1007,
+     1009,    0, 1004, 1006,    0, 1009,  997, 1004,  997, 1007,
+        0,  997,    0, 1006, 1007, 1006,    0, 1011, 1006, 1009,
+     1004, 1011, 1011,    0,  997,    0,    0, 1007,    0, 1009,
+        0, 1006,    0, 1012, 1009,    0, 1011, 1012, 1012,    0,
+     1020,    0,    0,    0, 1019, 1020, 1011, 1009,    0, 1019,
+     1011, 1011, 1012,    0,    0, 1019, 1025,    0,    0, 1020,
+     1025, 1025, 1012, 1019, 1011, 1026, 1012, 1012,    0, 1020,
+     1026,    0,    0, 1019, 1020, 1025,    0, 1029, 1019,    0,
+
+     1012,    0, 1029, 1019, 1026, 1025,    0, 1020, 1029, 1025,
+     1025, 1019,    0,    0, 1026,    0, 1029,    0,    0, 1026,
+     1030,    0, 1037, 1025, 1038, 1030, 1029, 1037, 1030, 1038,
+        0, 1029, 1026,    0,    0, 1037, 1029,    0,    0, 1030,
+        0, 1037,    0, 1038, 1029,    0,    0, 1039,    0, 1030,
+        0, 1037, 1039, 1038, 1030, 1039, 1037, 1030, 1038, 1047,
+        0,    0,    0, 1037, 1047,    0, 1039, 1030, 1040, 1037,
+     1044, 1038, 1040, 1040, 1044, 1044, 1039,    0, 1047,    0,
+        0, 1039,    0,    0, 1039,    0,    0, 1040, 1047, 1044,
+     1048, 1054,    0, 1047, 1039, 1048, 1054, 1040,    0, 1044,
+
+        0, 1040, 1040, 1044, 1044,    0, 1047, 1059,    0, 1048,
+     1054,    0, 1059,    0,    0, 1040, 1063, 1044,    0, 1048,
+     1054, 1063,    0, 1062, 1048, 1054, 1059, 1062, 1062,    0,
+        0,    0,    0,    0, 1063, 1063, 1059, 1048, 1054, 1067,
+        0, 1059, 1062,    0, 1067, 1063, 1068,    0, 1069,    0,
+     1063, 1068, 1062, 1069, 1059,    0, 1062, 1062, 1067, 1068,
+        0,    0, 1063, 1063,    0, 1068,    0, 1069, 1067, 1073,
+     1062, 1080, 1073, 1067, 1073, 1068, 1080, 1069,    0,    0,
+     1068,    0, 1069,    0,    0,    0, 1067, 1068, 1073,    0,
+     1080, 1087,    0, 1068, 1088, 1069, 1087,    0, 1073, 1088,
+
+     1080, 1073, 1088, 1073,    0, 1080,    0,    0,    0,    0,
+     1087,    0,    0, 1088, 1087,    0, 1073, 1091, 1080,    0,
+     1087, 1091, 1091, 1088, 1095, 1087,    0,    0, 1088, 1095,
+        0, 1088,    0,    0,    0,    0, 1091,    0, 1087,    0,
+     1105, 1088, 1087, 1095, 1095, 1105, 1091, 1106,    0, 1108,
+     1091, 1091, 1106, 1095, 1108,    0,    0,    0, 1095, 1105,
+        0, 1106,    0,    0, 1091,    0, 1106,    0, 1108, 1105,
+        0, 1095, 1095,    0, 1105,    0, 1106,    0, 1108,    0,
+        0, 1106,    0, 1108,    0,    0,    0, 1105,    0, 1106,
+        0,    0,    0,    0, 1106,    0, 1108, 1109, 1109, 1109,
+
+        0,    0, 1109, 1109,    0, 1109,    0,    0,    0, 1109,
+     1109,    0,    0, 1109,    0,    0, 1109, 1109, 1109, 1109,
+     1109, 1109, 1109, 1109, 1109, 1112, 1122,    0,    0,    0,
+     1112, 1122,    0,    0,    0,    0,    0,    0,    0, 1122,
+        0,    0, 1112,    0, 1112, 1122,    0,    0,    0,    0,
+        0,    0,    0,    0, 1112, 1122,    0,    0,    0, 1112,
+     1122,    0,    0,    0,    0,    0,    0, 1122,    0,    0,
+     1112,    0, 1112, 1122, 1126, 1126, 1126,    0,    0, 1126,
+     1126,    0, 1126,    0, 1128, 1126, 1126, 1126, 1128, 1128,
+     1126,    0,    0, 1126, 1126, 1126, 1126, 1126, 1126, 1126,
+
+     1126, 1126,    0, 1128, 1133, 1137,    0,    0,    0, 1133,
+     1137,    0,    0, 1128,    0,    0,    0, 1128, 1128,    0,
+        0,    0,    0, 1133, 1137,    0,    0,    0,    0,    0,
+        0, 1128,    0, 1133, 1137,    0,    0,    0, 1133, 1137,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0, 1133, 1137, 1162, 1162, 1162, 1162, 1162, 1162, 1162,
+     1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1164, 1164,    0,
+     1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1165,
+     1165,    0, 1165, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+
+     1165, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1167, 1167, 1167, 1168, 1168, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1170, 1170, 1170, 1170, 1170,
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1171, 1171, 1171,
+     1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1171, 1172,
+     1172, 1172, 1172, 1172, 1172,    0, 1172, 1172, 1172,    0,
+     1172, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173, 1173,
+     1173, 1173, 1173, 1174,    0,    0, 1174, 1175, 1175, 1175,
+        0,    0, 1175,    0, 1175, 1175,    0, 1175, 1175, 1176,
+
+     1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176, 1176,
+     1176, 1177, 1177,    0, 1177, 1177, 1177, 1177, 1177, 1177,
+     1177, 1177, 1177, 1178, 1178, 1178, 1178, 1178, 1178,    0,
+     1178, 1178, 1178,    0, 1178, 1179, 1179, 1179, 1179, 1179,
+     1179, 1179, 1179, 1179, 1179, 1179, 1179, 1180, 1180, 1180,
+     1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1180, 1181,
+        0,    0, 1181, 1182,    0,    0,    0, 1182,    0,    0,
+        0,    0,    0, 1182, 1183, 1183, 1183, 1183, 1183, 1183,
+     1183, 1183, 1183, 1183, 1183, 1183, 1184, 1184,    0, 1184,
+     1184, 1184, 1184, 1184, 1184, 1184, 1184, 1184, 1185, 1185,
+
+        0, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185, 1185,
+     1186, 1186,    0, 1186, 1186, 1186, 1186, 1186, 1186, 1186,
+     1186, 1186, 1187, 1187, 1187, 1187, 1187, 1187, 1187, 1187,
+     1187, 1187, 1187, 1187, 1188, 1188, 1188, 1188, 1188, 1188,
+     1188, 1188, 1188, 1188, 1188, 1188, 1189, 1189, 1189, 1189,
+     1189, 1189, 1189, 1189, 1189, 1189, 1189, 1189, 1190, 1190,
+     1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1190,
+     1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191, 1191,
+     1191, 1191, 1192, 1192,    0, 1192, 1192, 1192, 1192, 1192,
+     1192, 1192, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193,
+
+     1193, 1193, 1193, 1193, 1193, 1193, 1194, 1194, 1194, 1194,
+     1194, 1194, 1194, 1194, 1194, 1194, 1194, 1194, 1195, 1195,
+        0, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195,
+     1196, 1196,    0, 1196, 1196, 1196, 1196, 1196, 1196, 1196,
+     1196, 1196, 1197, 1197,    0, 1197, 1197, 1197, 1197, 1197,
+     1197, 1197, 1197, 1197, 1198, 1198,    0, 1198, 1198, 1198,
+     1198, 1198, 1198, 1198, 1198, 1198, 1199, 1199,    0, 1199,
+     1199, 1199, 1199, 1199, 1199, 1199, 1199, 1199, 1200, 1200,
+     1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200, 1200,
+     1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201, 1201,
+
+     1201, 1201, 1202, 1202, 1202, 1202, 1202, 1202, 1202, 1202,
+     1202, 1202, 1202, 1202, 1203, 1203, 1203, 1203, 1203, 1203,
+     1203, 1203, 1203, 1203, 1203, 1203, 1204, 1204, 1204, 1204,
+     1204, 1204, 1204, 1204, 1204, 1204, 1204, 1204, 1205, 1205,
+     1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205, 1205,
+     1206, 1206,    0, 1206, 1206, 1206, 1206, 1206, 1206, 1206,
+     1206, 1206, 1207, 1207,    0, 1207, 1207, 1207, 1207, 1207,
+     1207, 1207, 1207, 1207, 1208, 1208, 1208, 1208, 1208, 1208,
+     1208, 1208, 1208, 1208, 1208, 1208, 1209, 1209, 1209, 1209,
+     1209, 1209, 1209, 1209, 1209, 1209, 1209, 1209, 1210, 1210,
+
+     1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210, 1210,
+     1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211, 1211,
+     1211, 1211, 1212, 1212, 1212, 1212, 1212, 1212, 1212, 1212,
+     1212, 1212, 1212, 1212, 1213, 1213, 1213, 1213, 1213, 1213,
+     1213, 1213, 1213, 1213, 1213, 1213, 1214, 1214, 1214, 1214,
+     1214, 1214, 1214, 1214, 1214, 1214, 1214, 1214, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int fortran_flex_debug;
+int fortran_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *fortrantext;
+#line 1 "fortran.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+
+
+
+
+#line 41 "fortran.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * fortranin;
+#define MAX_INCLUDE_DEPTH 30
+#define tabsize 6
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_fortran=1;
+int line_num_fortran_common=1;
+int newlinef90 = 0;
+char *tmp;
+char tmpc;
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION \
+        {\
+           if (firstpass == 0) \
+           {\
+              strcat(curbuf,fortrantext); \
+              Save_Length(curbuf,38); \
+              strcpy(motparse,fortrantext);\
+              Save_Length(motparse,32); \
+              colnum = colnum + strlen(motparse);\
+              ECHO; \
+           }\
+           strcpy(motparse1,fortrantext);\
+/*           printf("fortrantext = %s\n",fortrantext);*/\
+        /*if ( firstpass == 1 ) 
+                      printf("fortrantext = %s %d\n",fortrantext,strlen(fortrantext));*/\
+        }
+#line 2979 "fortran.yy.c"
+
+#define INITIAL 0
+#define parameter 1
+#define character 2
+#define donottreat 3
+#define fortran77style 4
+#define fortran90style 5
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int fortranlex_destroy (void );
+
+int fortranget_debug (void );
+
+void fortranset_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortranget_extra (void );
+
+void fortranset_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortranget_in (void );
+
+void fortranset_in  (FILE * in_str  );
+
+FILE *fortranget_out (void );
+
+void fortranset_out  (FILE * out_str  );
+
+yy_size_t fortranget_leng (void );
+
+char *fortranget_text (void );
+
+int fortranget_lineno (void );
+
+void fortranset_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int fortranwrap (void );
+#else
+extern int fortranwrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( fortrantext, fortranleng, 1, fortranout )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( fortranin )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( fortranin ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, fortranin))==0 && ferror(fortranin)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(fortranin); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int fortranlex (void);
+
+#define YY_DECL int fortranlex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after fortrantext and fortranleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	if ( fortranleng > 0 ) \
+		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
+				(fortrantext[fortranleng - 1] == '\n'); \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 107 "fortran.lex"
+
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree) BEGIN(fortran90style)  ;
+
+#line 3174 "fortran.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! fortranin )
+			fortranin = stdin;
+
+		if ( ! fortranout )
+			fortranout = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			fortranensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				fortran_create_buffer(fortranin,YY_BUF_SIZE );
+		}
+
+		fortran_load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of fortrantext. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+		yy_current_state += YY_AT_BOL();
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 1162 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 9159 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 111 "fortran.lex"
+return TOK_DEBUT;
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 112 "fortran.lex"
+return TOK_FIN;
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 113 "fortran.lex"
+return TOK_OMP;
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 114 "fortran.lex"
+return TOK_DOLLAR;
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 116 "fortran.lex"
+{return TOK_REAL8;}
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 117 "fortran.lex"
+{return TOK_SUBROUTINE;}
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 118 "fortran.lex"
+{return TOK_PROGRAM;}
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 119 "fortran.lex"
+{inallocate = 1; return TOK_ALLOCATE;}
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 120 "fortran.lex"
+{return TOK_NULLIFY;}
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 121 "fortran.lex"
+{inallocate = 1; return TOK_DEALLOCATE;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 122 "fortran.lex"
+{return TOK_RESULT;}
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 123 "fortran.lex"
+{return TOK_FUNCTION;}
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 124 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 125 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 126 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 127 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_ENDUNIT;}
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 128 "fortran.lex"
+return TOK_INCLUDE;
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 129 "fortran.lex"
+{
+                            strcpy(yylval.na,fortrantext);
+                            tmpc = input();
+                            unput(tmpc);
+                            if ( (
+                               tmpc >= 'a' && tmpc <= 'z'
+                                  ) || (
+                               tmpc >= 'A' && tmpc <= 'Z'
+                               )  )
+                               {
+                                  return TOK_USE;
+                               }
+                               else
+                               {
+                                  return TOK_NAME;
+                               }
+                         }
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{return TOK_REWIND;}
+	YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+return TOK_IMPLICIT;
+	YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+return TOK_NONE;
+	YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+return TOK_CALL;
+	YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+return TOK_TRUE;
+	YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+return TOK_FALSE;
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{return TOK_POINT_TO;}
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DASTER;}
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_EQV;}
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_EQ;}
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_GT;}
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_GE;}
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LT;}
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LE;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NEQV;}
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NE;}
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NOT;}
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_OR;}
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_XOR;}
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_AND;}
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{return TOK_MODULE;}
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{return TOK_DOWHILE;}
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+return TOK_ENDMODULE;
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+return TOK_ENDDO;
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{return TOK_PLAINDO;}
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_REAL;}
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_INTEGER;}
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_LOGICAL;}
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHARACTER;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{return TOK_ALLOCATABLE;}
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+return TOK_CLOSE;
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+return TOK_INQUIRE;
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{return TOK_DIMENSION;}
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+return TOK_PAUSE;
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+return TOK_EQUIVALENCE;
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+return TOK_STOP;
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+return TOK_WHERE;
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+return TOK_ENDWHERE;
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+return TOK_ELSEWHERE;
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{return TOK_COMPLEX;}
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{return TOK_CONTAINS;}
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{return TOK_ONLY;}
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{return TOK_PARAMETER;}
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{return TOK_RECURSIVE;}
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{return TOK_COMMON;}
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{return TOK_GLOBAL;}
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{return TOK_EXTERNAL;}
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{return TOK_INTENT;}
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{return TOK_POINTER;}
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{return TOK_OPTIONAL;}
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{return TOK_SAVE;}
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{return TOK_TYPE;}
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{return TOK_TYPEPAR;}
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{if (inallocate == 1) return TOK_STAT; else {strcpy(yylval.na,fortrantext);return TOK_NAME;}}
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{return TOK_ENDTYPE;}
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+return TOK_OPEN;
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+return TOK_RETURN;
+	YY_BREAK
+case 76:
+/* rule 76 can match eol */
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+return TOK_EXIT;
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+return TOK_PRINT;
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{return TOK_PROCEDURE;}
+	YY_BREAK
+case 79:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{return TOK_READ;}
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{return TOK_NAMELIST;}
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{return TOK_WRITE;}
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{return TOK_TARGET;}
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{return TOK_PUBLIC;}
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{return TOK_PRIVATE;}
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_IN;}
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DATA;}
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+return TOK_CONTINUE;
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{return TOK_PLAINGOTO;}
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_OUT;}
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{strcpy(yylval.nac,fortrantext);return TOK_INOUT;}
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{return TOK_INTRINSIC;}
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{return TOK_THEN;}
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{return TOK_ELSEIF;}
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{return TOK_ELSE;}
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{return TOK_ENDIF;}
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{return TOK_LOGICALIF;}
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{return TOK_SUM;}
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{return TOK_MAX;}
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{return TOK_TANH;}
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{return TOK_MAXVAL;}
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{return TOK_TRIM;}
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{return TOK_SQRT;}
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{return TOK_SELECTCASE;}
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{return TOK_CASE;}
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{return TOK_CASEDEFAULT;}
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{return TOK_ENDSELECT;}
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{return TOK_FILE;}
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{return TOK_END;}
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{return TOK_ERR;}
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{return TOK_EXIST;}
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{return TOK_MIN;}
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{return TOK_NINT;}
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{return TOK_FLOAT;}
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{return TOK_EXP;}
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{return TOK_COS;}
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{return TOK_COSH;}
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{return TOK_ACOS;}
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{return TOK_SIN;}
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{return TOK_SINH;}
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{return TOK_ASIN;}
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 248 "fortran.lex"
+{return TOK_LOG;}
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 249 "fortran.lex"
+{return TOK_TAN;}
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 250 "fortran.lex"
+{return TOK_ATAN;}
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 251 "fortran.lex"
+{return TOK_CYCLE;}
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 252 "fortran.lex"
+{return TOK_ABS;}
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 253 "fortran.lex"
+{return TOK_MOD;}
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 254 "fortran.lex"
+{return TOK_SIGN;}
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 255 "fortran.lex"
+{return TOK_MINLOC;}
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 256 "fortran.lex"
+{return TOK_MAXLOC;}
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 257 "fortran.lex"
+{return TOK_MINVAL;}
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 258 "fortran.lex"
+{return TOK_BACKSPACE;}
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 259 "fortran.lex"
+{return TOK_LEFTAB;}
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 260 "fortran.lex"
+{return TOK_RIGHTAB;}
+	YY_BREAK
+case 134:
+/* rule 134 can match eol */
+YY_RULE_SETUP
+#line 261 "fortran.lex"
+{return TOK_FORMAT;}
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 262 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DOUBLEPRECISION;}
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 263 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DOUBLECOMPLEX;}
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 264 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_SLASH;}
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 265 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_DSLASH;}
+	YY_BREAK
+case 139:
+/* rule 139 can match eol */
+YY_RULE_SETUP
+#line 266 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_CUT;}
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 267 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_CONSTANT;}
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 268 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_MESSAGE;}
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 269 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CHAR_INT;}
+	YY_BREAK
+case 143:
+YY_RULE_SETUP
+#line 270 "fortran.lex"
+{printf("debug interfacer\n");BEGIN(donottreat);}
+	YY_BREAK
+case 144:
+/* rule 144 can match eol */
+YY_RULE_SETUP
+#line 271 "fortran.lex"
+{
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+	YY_BREAK
+case 145:
+YY_RULE_SETUP
+#line 278 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_NAME;}
+	YY_BREAK
+case 146:
+YY_RULE_SETUP
+#line 279 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
+	YY_BREAK
+case 147:
+YY_RULE_SETUP
+#line 280 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREALDP;}
+	YY_BREAK
+case 148:
+YY_RULE_SETUP
+#line 281 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREALQP;}
+	YY_BREAK
+case 149:
+/* rule 149 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortrantext again */
+YY_RULE_SETUP
+#line 282 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTREAL;}
+	YY_BREAK
+case 150:
+YY_RULE_SETUP
+#line 283 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return TOK_CSTINT;}
+	YY_BREAK
+case 151:
+YY_RULE_SETUP
+#line 284 "fortran.lex"
+{}
+	YY_BREAK
+case 152:
+YY_RULE_SETUP
+#line 285 "fortran.lex"
+{return TOK_QUOTE;}
+	YY_BREAK
+case 153:
+YY_RULE_SETUP
+#line 286 "fortran.lex"
+{}
+	YY_BREAK
+case 154:
+YY_RULE_SETUP
+#line 287 "fortran.lex"
+{strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
+	YY_BREAK
+case 155:
+YY_RULE_SETUP
+#line 288 "fortran.lex"
+{afterpercent = 1; strcpy(yylval.na,fortrantext);return (int) *fortrantext;}
+	YY_BREAK
+case 156:
+YY_RULE_SETUP
+#line 289 "fortran.lex"
+{return TOK_SEMICOLON;}
+	YY_BREAK
+case 157:
+YY_RULE_SETUP
+#line 290 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 158:
+YY_RULE_SETUP
+#line 291 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 159:
+YY_RULE_SETUP
+#line 292 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 160:
+YY_RULE_SETUP
+#line 293 "fortran.lex"
+{return (int) *fortrantext;}
+	YY_BREAK
+case 161:
+/* rule 161 can match eol */
+YY_RULE_SETUP
+#line 294 "fortran.lex"
+{colnum=0;line_num_fortran++;line_num_fortran_common++; return (int) *fortrantext;}
+	YY_BREAK
+case 162:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortrantext */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortrantext again */
+YY_RULE_SETUP
+#line 295 "fortran.lex"
+
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 296 "fortran.lex"
+{if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0;}
+	YY_BREAK
+case 164:
+YY_RULE_SETUP
+#line 297 "fortran.lex"
+
+	YY_BREAK
+case 165:
+YY_RULE_SETUP
+#line 298 "fortran.lex"
+{colnum=colnum-1+tabsize;}
+	YY_BREAK
+case 166:
+YY_RULE_SETUP
+#line 299 "fortran.lex"
+;
+	YY_BREAK
+case 167:
+/* rule 167 can match eol */
+YY_RULE_SETUP
+#line 300 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;newlinef90=1;colnum=0;}
+	YY_BREAK
+case 168:
+/* rule 168 can match eol */
+YY_RULE_SETUP
+#line 301 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;colnum=0;}
+	YY_BREAK
+case 169:
+/* rule 169 can match eol */
+YY_RULE_SETUP
+#line 302 "fortran.lex"
+{
+                           convert2lower(motparse1);
+                           if ( strncasecmp(motparse1,"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                            /*  colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(motparse1,"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }
+	YY_BREAK
+case 170:
+/* rule 170 can match eol */
+YY_RULE_SETUP
+#line 317 "fortran.lex"
+{
+                           convert2lower(&motparse1[1]);
+                           if ( strncasecmp(&motparse1[1],"contains",8) == 0 )
+                           {
+                              return TOK_CONTAINS;
+                           }
+                           else
+                           {
+                             /* colnum=0;line_num_fortran++;line_num_fortran_common++;*/
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_DO_NOT_TREAT\n")) 
+                             return TOK_DONOTTREAT;
+                             if ( !strcasecmp(&motparse1[1],"C$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                             unput('\n');
+                           }
+                         }                            
+	YY_BREAK
+case 171:
+/* rule 171 can match eol */
+YY_RULE_SETUP
+#line 332 "fortran.lex"
+{
+						BEGIN(donottreat);
+						}
+	YY_BREAK
+case 172:
+/* rule 172 can match eol */
+YY_RULE_SETUP
+#line 335 "fortran.lex"
+{
+						BEGIN(INITIAL);
+                        if (infixed) BEGIN(fortran77style) ;
+                        if (infree) BEGIN(fortran90style)  ;
+                        line_num_fortran++;line_num_fortran_common++;
+                        return '\n';
+						}
+	YY_BREAK
+case 173:
+/* rule 173 can match eol */
+YY_RULE_SETUP
+#line 342 "fortran.lex"
+{line_num_fortran++;line_num_fortran_common++;}
+	YY_BREAK
+case 174:
+/* rule 174 can match eol */
+YY_RULE_SETUP
+#line 343 "fortran.lex"
+{
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+	YY_BREAK
+case 175:
+YY_RULE_SETUP
+#line 348 "fortran.lex"
+{
+                             colnum = 0;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_DO_NOT_TREAT\n")) return TOK_DONOTTREAT;
+                             if ( !strcasecmp(motparse1,"!$AGRIF_END_DO_NOT_TREAT\n")) return TOK_ENDDONOTTREAT;
+                          }
+	YY_BREAK
+case 176:
+YY_RULE_SETUP
+#line 353 "fortran.lex"
+ECHO;
+	YY_BREAK
+#line 4224 "fortran.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(parameter):
+case YY_STATE_EOF(character):
+case YY_STATE_EOF(donottreat):
+case YY_STATE_EOF(fortran77style):
+case YY_STATE_EOF(fortran90style):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed fortranin at a new source and called
+			 * fortranlex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortranin;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( fortranwrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * fortrantext, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of fortranlex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					fortranrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			fortranrestart(fortranin  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortranrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+	yy_current_state += YY_AT_BOL();
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 1162 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 1162 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 1161);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up fortrantext */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					fortranrestart(fortranin );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( fortranwrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve fortrantext */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void fortranrestart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        fortranensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            fortran_create_buffer(fortranin,YY_BUF_SIZE );
+	}
+
+	fortran_init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void fortran_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		fortranpop_buffer_state();
+	 *		fortranpush_buffer_state(new_buffer);
+     */
+	fortranensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	fortran_load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (fortranwrap()) processing, but the only time this flag
+	 * is looked at is after fortranwrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void fortran_load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	fortranin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE fortran_create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) fortranalloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	fortran_init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with fortran_create_buffer()
+ * 
+ */
+    void fortran_delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		fortranfree((void *) b->yy_ch_buf  );
+
+	fortranfree((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a fortranrestart() or at EOF.
+ */
+    static void fortran_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	fortran_flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then fortran_init_buffer was _probably_
+     * called from fortranrestart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void fortran_flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		fortran_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void fortranpush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	fortranensure_buffer_stack();
+
+	/* This block is copied from fortran_switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from fortran_switch_to_buffer. */
+	fortran_load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void fortranpop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	fortran_delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		fortran_load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void fortranensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortranalloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortranrealloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortranensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE fortran_scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) fortranalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	fortran_switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to fortranlex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       fortran_scan_bytes() instead.
+ */
+YY_BUFFER_STATE fortran_scan_string (yyconst char * yystr )
+{
+    
+	return fortran_scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to fortranlex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE fortran_scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) fortranalloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran_scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = fortran_scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in fortran_scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortrantext. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		fortrantext[fortranleng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortrantext + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		fortranleng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int fortranget_lineno  (void)
+{
+        
+    return fortranlineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *fortranget_in  (void)
+{
+        return fortranin;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *fortranget_out  (void)
+{
+        return fortranout;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t fortranget_leng  (void)
+{
+        return fortranleng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *fortranget_text  (void)
+{
+        return fortrantext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void fortranset_lineno (int  line_number )
+{
+    
+    fortranlineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see fortran_switch_to_buffer
+ */
+void fortranset_in (FILE *  in_str )
+{
+        fortranin = in_str ;
+}
+
+void fortranset_out (FILE *  out_str )
+{
+        fortranout = out_str ;
+}
+
+int fortranget_debug  (void)
+{
+        return fortran_flex_debug;
+}
+
+void fortranset_debug (int  bdebug )
+{
+        fortran_flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from fortranlex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    fortranin = stdin;
+    fortranout = stdout;
+#else
+    fortranin = (FILE *) 0;
+    fortranout = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * fortranlex_init()
+     */
+    return 0;
+}
+
+/* fortranlex_destroy is for both reentrant and non-reentrant scanners. */
+int fortranlex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		fortran_delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		fortranpop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	fortranfree((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * fortranlex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *fortranalloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *fortranrealloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void fortranfree (void * ptr )
+{
+	free( (char *) ptr );	/* see fortranrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 353 "fortran.lex"
+
+
+
+fortranerror(char *s)
+{
+   if (!strcasecmp(curfile,mainfile))
+   {
+      printf("%s line %d, file %s motclef = %s\n",s,line_num_fortran,curfile,fortrantext);
+   }
+   else
+   {
+      printf("%s line %d, file %s motclef = %s curbuf = %s\n",s,line_num_fortran_common,curfile,fortrantext,curbuf);
+   }
+/*   exit(0);*/
+}
+
+int fortranwrap()
+{
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/main.c	(revision 3437)
@@ -0,0 +1,3876 @@
+/* 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
+
+
+
+/* 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_USE = 259,
+     TOK_MODULEMAIN = 260,
+     TOK_NOTGRIDDEP = 261,
+     TOK_USEITEM = 262,
+     TOK_NAME = 263,
+     TOK_PROBTYPE = 264
+   };
+#endif
+/* Tokens.  */
+#define TOK_SEP 258
+#define TOK_USE 259
+#define TOK_MODULEMAIN 260
+#define TOK_NOTGRIDDEP 261
+#define TOK_USEITEM 262
+#define TOK_NAME 263
+#define TOK_PROBTYPE 264
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 35 "convert.y"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+#line 42 "convert.y"
+{
+       int ival;
+       char na[LONG_C];
+       listnom * ln;
+       }
+/* Line 193 of yacc.c.  */
+#line 127 "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 140 "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   23
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  18
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  3
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  10
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  24
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   264
+
+#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,
+      17,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+      13,    14,     2,     2,    10,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,    12,    11,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,    15,     2,    16,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     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
+};
+
+#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,
+      36
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int8 yyrhs[] =
+{
+      19,     0,    -1,    -1,    19,    20,    -1,    17,    -1,     9,
+       8,    11,    -1,     9,     8,    10,     8,    11,    -1,     9,
+       8,    10,     8,    10,     8,    11,    -1,     5,     8,    11,
+      -1,     6,     3,     8,    11,    -1,     4,     7,    11,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint8 yyrline[] =
+{
+       0,    63,    63,    64,    66,    67,    68,    69,    71,    74,
+      75
+};
+#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_USE", "TOK_MODULEMAIN",
+  "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME", "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,
+      44,    59,    58,    40,    41,    91,    93,    10
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint8 yyr1[] =
+{
+       0,    18,    19,    19,    20,    20,    20,    20,    20,    20,
+      20
+};
+
+/* 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,     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,     4,     3,     0,
+       0,     0,     0,    10,     8,     0,     0,     5,     9,     0,
+       0,     6,     0,     7
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int8 yydefgoto[] =
+{
+      -1,     1,     8
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -10
+static const yytype_int8 yypact[] =
+{
+     -10,     0,   -10,    -4,     2,     8,     4,   -10,   -10,     3,
+       5,     7,    -9,   -10,   -10,     9,    10,   -10,   -10,    -3,
+      11,   -10,    12,   -10
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int8 yypgoto[] =
+{
+     -10,   -10,   -10
+};
+
+/* 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,    16,    17,     9,     3,     4,     5,    20,    21,     6,
+      10,    11,    12,     0,    13,    15,    14,     7,    19,    22,
+      18,     0,     0,    23
+};
+
+static const yytype_int8 yycheck[] =
+{
+       0,    10,    11,     7,     4,     5,     6,    10,    11,     9,
+       8,     3,     8,    -1,    11,     8,    11,    17,     8,     8,
+      11,    -1,    -1,    11
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint8 yystos[] =
+{
+       0,    19,     0,     4,     5,     6,     9,    17,    20,     7,
+       8,     3,     8,    11,    11,     8,    10,    11,    11,     8,
+      10,    11,     8,    11
+};
+
+#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 67 "convert.y"
+    {initdimprob(1,(yyvsp[(2) - (3)].na),"0","0");;}
+    break;
+
+  case 6:
+#line 68 "convert.y"
+    {initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0");;}
+    break;
+
+  case 7:
+#line 70 "convert.y"
+    {initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na));;}
+    break;
+
+  case 8:
+#line 72 "convert.y"
+    {listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
+                                                        Addmoduletothelist((yyvsp[(2) - (3)].na));;}
+    break;
+
+  case 9:
+#line 74 "convert.y"
+    {Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));;}
+    break;
+
+  case 10:
+#line 75 "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 1376 "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 82 "convert.y"
+
+
+int main(int argc,char *argv[])
+{
+   extern FILE * yyin ;
+   FILE *dependglobaloutput;
+   int i;
+   listnom *parcours;
+   listvar *newvar;
+   int stylegiven = 0;
+   int infreegiven ;
+   int infixedgiven ;
+   int lengthmainfile;
+
+   if (argc < 2)
+   {
+       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
+       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
+       printf(" [-free|-fixed]\n");
+       exit(0);
+   }
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+   List_Global_Var=(listvar *)NULL;
+   List_GlobalParameter_Var=(listvar *)NULL;
+   List_Allocate_Var=(listallocate *)NULL;
+   List_Common_Var=(listvar *)NULL;
+   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
+   List_Subroutine_For_Alloc=(listnom *)NULL;
+   List_Include=(listusemodule *)NULL;
+   List_NameOfModuleUsed=(listusemodule *)NULL;
+   listofmoduletmp=(listusemodule *)NULL;
+   List_SubroutineDeclaration_Var=(listvar *)NULL;
+   List_UsedInSubroutine_Var=(listvar *)NULL;
+   List_NotGridDepend_Var=(listvar *)NULL;
+   Listofavailableindices=(listindice *)NULL;
+   List_CouplePointed_Var=(listvarpointtovar *)NULL;
+   List_ModuleUsed_Var = (listvar *)NULL;
+   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
+   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
+   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
+   List_SubroutineArgument_Var = (listvar *)NULL;
+   List_FunctionType_Var = (listvar *)NULL;
+   tmpuselocallist = (listusemodule *)NULL;
+   List_ContainsSubroutine = (listnom *)NULL;
+   oldfortranout = (FILE *)NULL;
+
+   strcpy(mainfile,argv[1]);
+   strcpy(nomdir,"AGRIF_INC");
+   strcpy(commondirin,".");
+   strcpy(commondirout,".");
+   strcpy(filetoparse," ");
+   strcpy(subofagrifinitgrids,"");
+   strcpy(meetagrifinitgrids,"");
+   strcpy(mpiinitvar,"");
+
+   length_last = 0 ;
+   length_first = 0 ;
+   length_v_typevar = 0 ;
+   length_v_nomvar = 0 ;
+   length_v_dimchar = 0 ;
+   length_v_modulename = 0 ;
+   length_v_commonname = 0 ;
+   length_v_vallengspec = 0 ;
+   length_v_nameinttypename = 0 ;
+   length_v_commoninfile = 0 ;
+   length_v_subroutinename = 0 ;
+   length_v_precision = 0 ;
+   length_v_IntentSpec = 0 ;
+   length_v_initialvalue = 0 ;
+   length_v_readedlistdimension = 0 ;
+   length_u_usemodule = 0 ;
+   length_u_charusemodule = 0 ;
+   length_u_cursubroutine = 0 ;
+   length_u_modulename = 0 ;
+   length_n_name = 0 ;
+   length_c_namevar = 0 ;
+   length_c_namepointedvar = 0 ;
+   length_o_nom = 0 ;
+   length_o_module = 0 ;
+   length_a_nomvar = 0 ;
+   length_a_subroutine = 0 ;
+   length_a_module = 0 ;
+   length_t_usemodule = 0 ;
+   length_t_cursubroutine = 0 ;
+   length_curfilename = 0 ;
+   length_nomfileoutput = 0 ;
+   length_motparse = 0 ;
+   length_mainfile = 0 ;
+   length_nomdir = 0 ;
+   length_commondirout = 0 ;
+   length_commondirin = 0 ;
+   length_filetoparse = 0 ;
+   length_curbuf = 0 ;
+   length_toprintglob = 0 ;
+   length_tmpvargridname = 0 ;
+   length_ligne_Subloop = 0 ;
+   length_lvargridname_toamr = 0 ;
+   length_toprint_utilagrif = 0 ;
+   length_toprinttmp_utilchar = 0 ;
+   length_ligne_writedecl = 0 ;
+   length_newname_toamr = 0 ;
+   length_newname_writedecl = 0 ;
+   length_ligne_toamr = 0 ;
+   length_tmpligne_writedecl = 0 ;
+   value_char_size = 0 ;
+   value_char_size1 = 0 ;
+   value_char_size2 = 0 ;
+   value_char_size3 = 0 ;
+   inallocate = 0;
+   infixed = 1;
+   infree  = 0;
+
+   checkexistcommon=1;
+   todebug=0;
+   onlyfixedgrids=0;
+   fixedgrids=0;
+   InAgrifParentDef = 0;
+   IndicenbmaillesX=0;
+   IndicenbmaillesY=0;
+   IndicenbmaillesZ=0;
+   created_dimensionlist = 1;
+   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
+   SubloopScalar = 0;
+   todebug = 0;
+   todebugfree = 0;
+   retour77 = 1 ;
+   mark = 0 ;
+   shouldincludempif = 0 ;
+   Read_val_max();
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+   if ((yyin=fopen(argv[1],"r"))==NULL)
+   {
+      printf("the file %s doesn't exist \n",argv[1]);
+      exit(0);
+   }
+
+   i=2;
+   while (i<argc)
+   {
+      if (!strcasecmp(argv[i],"-incdir"))
+      {
+         strcpy(nomdir,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
+      {
+         strcpy(commondirin,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
+      {
+         strcpy(commondirout,argv[i+1]);
+         i++;
+      }
+      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
+      {
+         strcpy(filetoparse,argv[i+1]);
+         i++;
+         lengthmainfile = strlen(filetoparse);
+         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
+         {
+         infixed = 0;
+         infree = 1;
+         }
+         else
+         {
+         infixed = 1;
+         infree = 0;
+         }
+      }
+      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
+      {
+         stylegiven = 1;
+         infreegiven  = 1 ;
+         infixedgiven = 0;
+      }   
+      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
+      {
+         stylegiven = 1;
+         infreegiven  = 0;
+         infixedgiven = 1;
+      }         
+      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
+      {
+         SubloopScalar = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
+      {
+         SubloopScalar = 2 ;
+      }
+      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
+      {
+         todebug = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
+      {
+         mark = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
+      {
+         todebugfree = 1 ;
+      }
+      else if (!strcasecmp(argv[i],"-rm"))
+      {
+         checkexistcommon=0;
+      }
+      else
+      {
+         printf("Unkwon option : %s\n",argv[i]);
+         exit(0);
+      }
+      i++;
+   }
+
+   if (stylegiven == 1) 
+   {
+   infree = infreegiven;
+   infixed = infixedgiven;   
+   }
+   Save_Length(nomdir,34);
+   Save_Length(commondirout,35);
+   Save_Length(commondirin,36);
+   Save_Length(filetoparse,37);
+
+/******************************************************************************/
+/*  3-  Parsing of the  conv file <name>.in                                   */
+/******************************************************************************/
+
+   if ((yyin=fopen(argv[1],"r"))==NULL)
+   {
+       printf("the file %s doesn't exist \n",argv[1]);
+       exit(0);
+   }
+   strcpy(mainfile,argv[1]);
+   Save_Length(mainfile,33);
+
+   if ( strstr(filetoparse,".f90") ||
+        strstr(filetoparse,".F90") ) retour77 = 0;
+
+   yyparse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
+   {
+      printf("the file %s doesn't exist \n",filetoparse);
+      exit(0);
+   }
+   /* mainfile : the name of the file to parse                                */
+   strcpy(mainfile,filetoparse);
+   /*                                                                         */
+   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
+   {
+      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
+      fclose(dependglobaloutput);
+   }
+   Readthedependavailablefile();
+   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
+   /*    nbmailleY and nbmailleZ                                              */
+   Readthedependnbxnbyfile();
+   Read_Subroutine_For_Alloc();
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+   /* Record all variable in list                                             */
+   firstpass = 1;
+   processfortran(filetoparse);
+   /*                                                                         */
+   CompleteThelistvarindoloop();
+   /* Read list of module used                                                */
+   RecordUseModulesVariables();
+   /* Read list of module used in module used                                 */
+   RecordUseModulesUseModulesVariables();
+   /* Save variables are considered as globals ones                           */
+   Update_List_Global_Var_From_List_Save_Var();
+   /* Update all lists                                                        */
+   ListUpdate();
+   /*                                                                         */
+   Clean_List_Global_Var();
+   /* Indice tabvars identification                                           */
+   IndiceTabvarsIdentification();
+   /* Update all lists                                                        */
+   ListUpdate();
+   /* The allocation subroutine is necessary ????                             */
+   New_Allocate_Subroutine_Is_Necessary();
+   /* The allocation subroutine is necessary for common list                  */
+   New_Allocate_Subroutine_For_Common_Is_Necessary();
+   /* Sort List_SubroutineArgument_Var                                        */
+   Sort_List_SubroutineArgument_Var();
+   /* Clean all lists                                                         */
+   ListClean();
+   /* Update Indice of List_UsedInSubroutine_Var from module used             */
+   List_UsedInSubroutine_Var_Update_From_Module_Used();
+   /* Update List_SubroutineWhereAgrifUsed                                    */
+   UpdateList_SubroutineWhereAgrifUsed();
+   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+   UpdateList_UsedInSubroutine_With_dimension();;
+   /*                                                                         */
+   ModifyThelistvarindoloop();
+   /*                                                                         */
+   UpdateListDeclarationWithDimensionList();
+   /*                                                                         */
+   GiveTypeOfVariables();
+   Affiche();
+   /* Build new subroutines                                                   */
+   firstpass = 0;
+   processfortran(filetoparse);
+
+   newvar = (listvar *)NULL;
+/*newvar = List_Global_Var; */
+   while ( newvar )
+   {
+      printf("++++ %s %d %s %s %s\n",
+      newvar->var->v_nomvar,
+      newvar->var->v_nbdim,
+      newvar->var->v_subroutinename,
+      newvar->var->v_modulename,
+      newvar->var->v_typevar
+             );
+      newvar = newvar->suiv;
+   }
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+   /* Write the .dependglobal_agrif file which contain the max indice         */
+   /*    of the tabvars table                                                 */
+   dependglobaloutput = fopen(".dependglobal_agrif","w");
+   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
+   fclose(dependglobaloutput);
+   /* Write the list of available indice                                      */
+   Writethedependavailablefile();
+   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+   /*    nbmailleY and nbmailleZ                                              */
+   Writethedependnbxnbyfile();
+   /* Write the .depend<namefile> file which contain general informations     */
+   /*    about variable of this file                                          */
+   parcours = List_NameOfModule;
+   while( parcours )
+   {
+      Writethedependlistofmoduleused(parcours->o_nom);
+      WritedependParameterList(parcours->o_nom);
+      Writethedependfile(parcours->o_nom,List_Global_Var);
+      parcours=parcours->suiv;
+   }
+   parcours = List_NameOfCommon;
+   while( parcours )
+   {
+      Writethedependfile(parcours->o_nom,List_Common_Var);
+      parcours=parcours->suiv;
+   }
+   Write_Subroutine_For_Alloc();
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+   creefichieramr(NameTamponfile);
+
+   Write_val_max();
+
+   if ( todebug == 1 ) printf("Out of CONV \n");
+   return 0;
+}
+
+#line 2 "convert.yy.c"
+
+#line 4 "convert.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin  )
+
+#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 yyleng;
+
+extern FILE *yyin, *yyout;
+
+#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 yytext. */ \
+        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 yytext 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 yyrestart()), so that the user can continue scanning by
+	 * just pointing yyin 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 yytext is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t yyleng;
+
+/* 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 yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file  );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size  );
+void yy_delete_buffer (YY_BUFFER_STATE b  );
+void yy_flush_buffer (YY_BUFFER_STATE b  );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer  );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *yyalloc (yy_size_t  );
+void *yyrealloc (void *,yy_size_t  );
+void yyfree (void *  );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        yyensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        yyensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            yy_create_buffer(yyin,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char *yytext;
+#define yytext_ptr yytext
+
+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 yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	yyleng = (size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 12
+#define YY_END_OF_BUFFER 13
+/* 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[77] =
+    {   0,
+        0,    0,    0,    0,   13,   12,   11,   10,   12,    9,
+       12,   12,   12,    9,    8,    8,    8,    8,    8,    8,
+       11,    0,    4,    7,    7,    7,    5,    8,    8,    8,
+        8,    8,    8,    8,    6,    8,    8,    8,    8,    3,
+        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
+        8,    8,    8,    8,    8,    8,    8,    8,    8,    8,
+        8,    8,    8,    8,    8,    2,    8,    8,    8,    1,
+        8,    8,    8,    8,    6,    0
+    } ;
+
+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,
+        1,    1,    1,    1,   15,   16,   16,   17,   18,   19,
+       20,   16,   21,   16,   16,   22,   23,   24,   25,   26,
+       16,   27,   28,   29,   30,   16,   16,   31,   32,   16,
+       33,    1,   34,    1,   35,    1,   36,   16,   16,   37,
+
+       38,   39,   40,   16,   41,   16,   16,   42,   43,   44,
+       45,   46,   16,   47,   48,   49,   50,   16,   16,   51,
+       52,   16,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    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[53] =
+    {   0,
+        1,    1,    2,    1,    1,    1,    1,    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,    1,    1,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+        3,    3
+    } ;
+
+static yyconst flex_int16_t yy_base[79] =
+    {   0,
+        0,    0,    0,    0,  150,  164,  147,  164,  144,  164,
+       36,   37,   38,  134,    0,   44,   32,   34,   44,   33,
+      144,  141,  140,  164,  164,  164,  164,    0,  131,   31,
+       34,   42,   39,   49,    0,   50,   49,   38,   56,    0,
+       59,   52,  107,   68,  106,   72,   75,   72,   77,   81,
+       79,   76,   75,   86,   73,   88,   85,   89,   90,   79,
+       93,   86,   99,   97,  103,    0,   37,  115,  114,    0,
+      108,  116,  121,  112,    0,  164,  160,   57
+    } ;
+
+static yyconst flex_int16_t yy_def[79] =
+    {   0,
+       76,    1,    1,    1,   76,   76,   76,   76,   77,   76,
+       76,   76,   76,   76,   78,   78,   78,   78,   78,   78,
+       76,   77,   77,   76,   76,   76,   76,   78,   78,   78,
+       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
+       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
+       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
+       78,   78,   78,   78,   78,   78,   78,   78,   78,   78,
+       78,   78,   78,   78,   78,    0,   76,   76
+    } ;
+
+static yyconst flex_int16_t yy_nxt[217] =
+    {   0,
+        6,    7,    8,    9,   10,   10,   10,    6,   11,   12,
+       13,    6,   14,   10,   15,   15,   15,   15,   16,   15,
+       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
+       15,   15,   10,   10,   15,   15,   15,   15,   16,   15,
+       15,   15,   15,   17,   18,   19,   15,   15,   15,   20,
+       15,   15,   24,   25,   26,   29,   31,   32,   33,   28,
+       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
+       44,   69,   24,   25,   26,   45,   31,   32,   46,   33,
+       34,   36,   37,   38,   30,   39,   40,   41,   42,   43,
+       48,   44,   50,   51,   52,   45,   53,   54,   46,   55,
+
+       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+       48,   66,   50,   51,   52,   67,   53,   54,   68,   55,
+       56,   57,   58,   59,   60,   61,   62,   63,   64,   65,
+       35,   66,   70,   71,   72,   67,   73,   74,   68,   75,
+       49,   47,   35,   23,   23,   21,   27,   23,   21,   76,
+       35,   76,   70,   71,   72,   76,   73,   74,   76,   75,
+       22,   76,   22,    5,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76
+    } ;
+
+static yyconst flex_int16_t yy_chk[217] =
+    {   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,   11,   12,   13,   16,   17,   18,   19,   78,
+       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
+       39,   67,   11,   12,   13,   41,   17,   18,   42,   19,
+       20,   30,   31,   32,   16,   33,   34,   36,   37,   38,
+       44,   39,   46,   47,   48,   41,   49,   50,   42,   51,
+
+       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
+       44,   62,   46,   47,   48,   63,   49,   50,   64,   51,
+       52,   53,   54,   55,   56,   57,   58,   59,   60,   61,
+       65,   62,   68,   69,   71,   63,   72,   73,   64,   74,
+       45,   43,   29,   23,   22,   21,   14,    9,    7,    5,
+       65,    0,   68,   69,   71,    0,   72,   73,    0,   74,
+       77,    0,   77,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+
+       76,   76,   76,   76,   76,   76,   76,   76,   76,   76,
+       76,   76,   76,   76,   76,   76
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int yy_flex_debug;
+int yy_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 *yytext;
+#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 37 "convert.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+int line_num=1;
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+#line 565 "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 yylex_destroy (void );
+
+int yyget_debug (void );
+
+void yyset_debug (int debug_flag  );
+
+YY_EXTRA_TYPE yyget_extra (void );
+
+void yyset_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *yyget_in (void );
+
+void yyset_in  (FILE * in_str  );
+
+FILE *yyget_out (void );
+
+void yyset_out  (FILE * out_str  );
+
+yy_size_t yyget_leng (void );
+
+char *yyget_text (void );
+
+int yyget_lineno (void );
+
+void yyset_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (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( yytext, yyleng, 1, yyout )
+#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( yyin )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( yyin ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(yyin); \
+			} \
+		}\
+\
+
+#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 yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * 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 55 "convert.lex"
+
+#line 750 "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 ( ! yyin )
+			yyin = stdin;
+
+		if ( ! yyout )
+			yyout = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			yyensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				yy_create_buffer(yyin,YY_BUF_SIZE );
+		}
+
+		yy_load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of yytext. */
+		*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 >= 77 )
+					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] != 164 );
+
+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 56 "convert.lex"
+return TOK_MODULEMAIN; /* name of the module                      */
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 57 "convert.lex"
+return TOK_NOTGRIDDEP; /* variable which are not grid dependent   */
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 58 "convert.lex"
+return TOK_USE;
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 59 "convert.lex"
+{}
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 60 "convert.lex"
+return TOK_SEP;
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 61 "convert.lex"
+{strcpy(yylval.na,yytext); return TOK_USEITEM;}
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 62 "convert.lex"
+{strcpy(yylval.na,yytext); return TOK_PROBTYPE;}
+	YY_BREAK
+/* dimension of the problem                */
+case 8:
+YY_RULE_SETUP
+#line 64 "convert.lex"
+{strcpy(yylval.na,yytext); return TOK_NAME;}
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 65 "convert.lex"
+{return (int) *yytext;}
+	YY_BREAK
+case 10:
+/* rule 10 can match eol */
+YY_RULE_SETUP
+#line 66 "convert.lex"
+{line_num++;return (int) *yytext;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 67 "convert.lex"
+;
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 68 "convert.lex"
+ECHO;
+	YY_BREAK
+#line 895 "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 yyin at a new source and called
+			 * yylex().  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 = yyin;
+			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 ( yywrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * yytext, 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 yylex */
+
+/* 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. */
+					yyrealloc((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;
+			yyrestart(yyin  );
+			}
+
+		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 *) yyrealloc((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 >= 77 )
+				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 >= 77 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 76);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up yytext */
+	*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. */
+					yyrestart(yyin );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( yywrap( ) )
+						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 yytext */
+	(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 yyrestart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        yyensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            yy_create_buffer(yyin,YY_BUF_SIZE );
+	}
+
+	yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+	yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void yy_switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		yypop_buffer_state();
+	 *		yypush_buffer_state(new_buffer);
+     */
+	yyensure_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;
+	yy_load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (yywrap()) processing, but the only time this flag
+	 * is looked at is after yywrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(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 yy_create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_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 *) yyalloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	yy_init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ * 
+ */
+    void yy_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 )
+		yyfree((void *) b->yy_ch_buf  );
+
+	yyfree((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+    static void yy_init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	yy_flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then yy_init_buffer was _probably_
+     * called from yyrestart() or through yy_get_next_buffer.
+     * 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 yy_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 )
+		yy_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 yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	yyensure_buffer_stack();
+
+	/* This block is copied from yy_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 yy_switch_to_buffer. */
+	yy_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 yypop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	yy_delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		yy_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 yyensure_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**)yyalloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in yyensure_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**)yyrealloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+		/* 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 yy_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) yyalloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_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;
+
+	yy_switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() 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
+ *       yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
+{
+    
+	return yy_scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * 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 yy_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 *) yyalloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in yy_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 = yy_scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in yy_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 yytext. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		yytext[yyleng] = (yy_hold_char); \
+		(yy_c_buf_p) = yytext + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		yyleng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int yyget_lineno  (void)
+{
+        
+    return yylineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *yyget_in  (void)
+{
+        return yyin;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *yyget_out  (void)
+{
+        return yyout;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t yyget_leng  (void)
+{
+        return yyleng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *yyget_text  (void)
+{
+        return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void yyset_lineno (int  line_number )
+{
+    
+    yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE *  in_str )
+{
+        yyin = in_str ;
+}
+
+void yyset_out (FILE *  out_str )
+{
+        yyout = out_str ;
+}
+
+int yyget_debug  (void)
+{
+        return yy_flex_debug;
+}
+
+void yyset_debug (int  bdebug )
+{
+        yy_flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from yylex_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
+    yyin = stdin;
+    yyout = stdout;
+#else
+    yyin = (FILE *) 0;
+    yyout = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * yylex_init()
+     */
+    return 0;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		yy_delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		yypop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	yyfree((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * yylex() is called, initialization will occur. */
+    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 *yyalloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *yyrealloc  (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 yyfree (void * ptr )
+{
+	free( (char *) ptr );	/* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 68 "convert.lex"
+
+
+
+
+int yywrap()
+{
+}
+
+
+yyerror(char *s)
+{
+if (!strcasecmp(curfile,mainfile))
+{
+   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
+}
+else
+{
+   printf("Dans convert %s line %d, fichier %s\n",s,line_num,curfile);
+}
+exit(0);
+}
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/run
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/run	(revision 3437)
@@ -0,0 +1,2 @@
+gmake -f Makefile.lex clean
+gmake -f Makefile.lex
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/LIB/toamr.c	(revision 3437)
@@ -0,0 +1,1204 @@
+/******************************************************************************/
+/*                                                                            */
+/*     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"
+char lvargridname[LONG_4C];
+char lvargridname2[LONG_4C];
+
+
+/******************************************************************************/
+/*                       variablenameroottabvars                              */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  ----------->  Agrif_Mygrid % tabvars (i) % var                            */
+/*                                                                            */
+/******************************************************************************/
+char *variablenameroottabvars (variable * var)
+{
+  char *ligne;
+
+  ligne = (char *) malloc (LONG_C * sizeof (char));
+  sprintf (ligne, "Agrif_Mygrid %% tabvars(%d) %% var ", var->v_indicetabvars);
+  return ligne;
+}
+
+
+/******************************************************************************/
+/*                        variablenametabvars                                 */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  if iorindice = 0 ---------->  Agrif_Gr % tabvars (i) % var                */
+/*                                                                            */
+/*  if iorindice = 1 ---------->  Agrif_Gr % tabvars (12) % var               */
+/*                                                                            */
+/******************************************************************************/
+char *variablenametabvars (variable * var, int iorindice)
+{
+  char *ligne;
+
+  ligne = (char *) malloc (LONG_C * sizeof (char));
+  if ( iorindice == 0 ) sprintf (ligne, " Agrif_Gr %% tabvars(%d)%% var",
+                                 var->v_indicetabvars);
+  else sprintf (ligne, " Agrif_Gr %% tabvars(i)%% var");
+  return ligne;
+}
+
+/******************************************************************************/
+/*                        variablecurgridtabvars                              */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  ----------->  Agrif_Curgrid % tabvars (i) % var                           */
+/*                                                                            */
+/******************************************************************************/
+char *variablecurgridtabvars (variable * var,int ParentOrCurgrid)
+{
+  char *ligne;
+
+  ligne = (char *) malloc (LONG_C * sizeof (char));
+  if ( ParentOrCurgrid == 0 ) sprintf (ligne, " Agrif_tabvars(%d) %% var",
+                              var->v_indicetabvars);
+  else if ( ParentOrCurgrid == 1 ) sprintf (ligne,
+                              " Agrif_tabvars(%d) %% parent_var %% var",
+                               var->v_indicetabvars);
+  else if ( ParentOrCurgrid == 2 ) sprintf (ligne,
+                              " Agrif_Mygrid %% tabvars(%d) %% var",
+                               var->v_indicetabvars);
+  else if ( ParentOrCurgrid == 3 ) sprintf (ligne,
+                              " Agrif_Curgrid %% tabvars(%d) %% var",
+                               var->v_indicetabvars);
+  else sprintf (ligne, " AGRIF_Mygrid %% tabvars(%d) %% var",
+                               var->v_indicetabvars);
+  return ligne;
+}
+
+void WARNING_CharSize(variable *var)
+{
+   if ( var->v_nbdim == 0 )
+   {
+      if ( convert2int(var->v_dimchar) > 2050 )
+      {
+         printf("WARNING : The dimension of the character  %s   \n",
+                                                              var->v_nomvar);
+         printf("   is upper than 2050. You must change         \n");
+         printf("   the dimension of carray0                    \n");
+         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
+         printf("   line 247. Replace 300 with %d.              \n",
+                                            convert2int(var->v_dimchar)+100);
+      }
+      Save_Length_int(convert2int(var->v_dimchar),1);
+   }
+   else if ( var->v_nbdim == 1 )
+   {
+      if ( convert2int(var->v_dimchar) > 300 )
+      {
+         printf("WARNING : The dimension of the character  %s   \n",
+                                                              var->v_nomvar);
+         printf("   is upper than 300. You must change          \n");
+         printf("   the dimension of carray1                    \n");
+         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
+         printf("   line 247. Replace 300 with %d.              \n",
+                                            convert2int(var->v_dimchar)+100);
+      }
+      Save_Length_int(convert2int(var->v_dimchar),2);
+   }
+   else if ( var->v_nbdim == 2 )
+   {
+      if ( convert2int(var->v_dimchar) > 300 )
+      {
+         printf("WARNING : The dimension of the character  %s   \n",
+                                                              var->v_nomvar);
+         printf("   is upper than 300. You must change          \n");
+         printf("   the dimension of carray2                    \n");
+         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
+         printf("   line 247. Replace 300 with %d.              \n",
+                                            convert2int(var->v_dimchar)+100);
+      }
+      Save_Length_int(convert2int(var->v_dimchar),3);
+   }
+   else if ( var->v_nbdim == 3 )
+   {
+      if ( convert2int(var->v_dimchar) > 300 )
+      {
+         printf("WARNING : The dimension of the character  %s   \n",
+                                                              var->v_nomvar);
+         printf("   is upper than 300. You must change          \n");
+         printf("   the dimension of carray3                    \n");
+         printf("   in the file AGRIF/AGRIF_FILES/modtypes.F    \n");
+         printf("   line 247. Replace 300 with %d.              \n",
+                                            convert2int(var->v_dimchar)+100);
+      }
+      Save_Length_int(convert2int(var->v_dimchar),4);
+   }
+}
+/******************************************************************************/
+/*                           vargridnametabvars                               */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % var % array1     */
+/*                                                                            */
+/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % var % array1    */
+/*                                                                            */
+/******************************************************************************/
+char *vargridnametabvars (variable * var,int iorindice)
+{
+  char *tmp;
+  char tmp1[LONG_C];
+
+  tmp = variablenametabvars (var,iorindice);
+  strcpy(tmp1,tmp);
+  if ( todebugfree == 1 ) free(tmp);
+
+  sprintf (lvargridname, "%s", tmp1);
+  if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+      if ( !strcasecmp(var->v_nameinttypename,"8") )
+                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
+      else if ( !strcasecmp(var->v_nameinttypename,"4") )
+                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
+      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "INTEGER"))
+    {
+      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
+    {
+      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
+    {
+      WARNING_CharSize(var);
+      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
+    }
+
+  strcat (lvargridname, lvargridname2);
+
+  Save_Length(lvargridname,42);
+  Save_Length(lvargridname2,42);
+  return lvargridname;
+}
+
+/******************************************************************************/
+/*                           vargridcurgridtabvars                            */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/* if ParentOrCurgrid == 0 -->  Agrif_Curgrid % tabvars (i) % var % array1    */
+/*                                                                            */
+/* if ParentOrCurgrid == 1 -->  Agrif_tabvars (i) % parent_var %var % array1  */
+/*                                                                            */
+/* if ParentOrCurgrid == 2 -->  Agrif_Gr % tabvars (i) % var % array1         */
+/*                                                                            */
+/******************************************************************************/
+char *vargridcurgridtabvars (variable * var,int ParentOrCurgrid)
+{
+  char *tmp;
+  char tmp1[LONG_C];
+
+ if (!strcasecmp(var->v_typevar,"type"))
+  {
+  strcpy(lvargridname2,"");
+  sprintf(lvargridname,"Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s",var->v_modulename,var->v_nomvar);
+  printf("modulename = %s %s\n",var->v_nomvar, var->v_modulename);
+  }
+  else
+  {
+  tmp = variablecurgridtabvars (var,ParentOrCurgrid);
+  strcpy(tmp1,tmp);
+  if ( todebugfree == 1 ) free(tmp);
+
+  sprintf (lvargridname, "%s", tmp1);
+  if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+      if ( !strcasecmp(var->v_nameinttypename,"8") )
+                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
+      else if ( !strcasecmp(var->v_nameinttypename,"4") )
+                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
+      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "INTEGER"))
+    {
+      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
+    {
+      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
+    {
+      WARNING_CharSize(var);
+      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
+    }
+  }
+
+  strcat (lvargridname, lvargridname2);
+
+  Save_Length(lvargridname,42);
+  Save_Length(lvargridname2,42);
+  return lvargridname;
+}
+
+/******************************************************************************/
+/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+char *vargridcurgridtabvarswithoutAgrif_Gr (variable * var)
+{
+
+  sprintf (lvargridname, "(%d) %% var", var->v_indicetabvars);
+
+  if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+      if ( !strcasecmp(var->v_nameinttypename,"8") )
+                           sprintf (lvargridname2, "%% darray%d", var->v_nbdim);
+      else if ( !strcasecmp(var->v_nameinttypename,"4") )
+                           sprintf (lvargridname2, "%% sarray%d", var->v_nbdim);
+      else sprintf (lvargridname2, "%% array%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "INTEGER"))
+    {
+      sprintf (lvargridname2, "%% iarray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "LOGICAL"))
+    {
+      sprintf (lvargridname2, "%% larray%d", var->v_nbdim);
+    }
+  else if (!strcasecmp (var->v_typevar, "CHARACTER"))
+    {
+      WARNING_CharSize(var);
+      sprintf (lvargridname2, "%% carray%d", var->v_nbdim);
+    }
+
+  strcat (lvargridname, lvargridname2);
+
+  Save_Length(lvargridname,42);
+  Save_Length(lvargridname2,42);
+  return lvargridname;
+}
+
+/******************************************************************************/
+/*                               vargridparam                                 */
+/******************************************************************************/
+/* This subroutine is used to create the string which contains                */
+/* dimension list                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj"                            */
+/*                                                                            */
+/******************************************************************************/
+char *vargridparam (variable * v, int whichone)
+{
+  typedim dim;
+  listdim *newdim;
+  char newname[LONG_4C];
+
+  newdim = v->v_dimension;
+  if (!newdim) return "";
+
+  strcpy (tmpvargridname, "(");
+  while (newdim)
+  {
+     dim = newdim->dim;
+
+     strcpy(newname,"");
+     strcpy(newname,
+            ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var,
+                                                                     whichone));
+                                                                     
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
+                       List_Common_Var,whichone));
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,
+                       List_ModuleUsed_Var,whichone));
+
+     strcat (tmpvargridname, newname);
+     strcat (tmpvargridname, " : ");
+
+     strcpy(newname,"");
+     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                        (dim.last,List_Global_Var,whichone));
+                        
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                       (newname, List_Common_Var,whichone));   
+                       
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
+                       (newname, List_ModuleUsed_Var,whichone));                                            
+                        
+     Save_Length(tmpvargridname,46);
+     strcat (tmpvargridname, newname);
+     newdim = newdim->suiv;
+     if (newdim) strcat (tmpvargridname, ",");
+  }
+  strcat (tmpvargridname, ")");
+  strcat (tmpvargridname, "\0");
+  Save_Length(tmpvargridname,40);
+  return tmpvargridname;
+}
+
+/******************************************************************************/
+/*                        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_C];
+
+  probdim = associate("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 = associate ("keys_agrif.h");
+  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 0\n");
+  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 0\n");
+  if (fixedgrids     == 1) fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = 1\n");
+  if (onlyfixedgrids == 1)
+                         fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = 1\n");
+
+  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_C];
+  FILE *typedata;
+
+  typedata = associate ("modtype_agrif.h");
+  /* AGRIF_NbVariables : number of variables                                  */
+  sprintf (ligne, "AGRIF_NbVariables = %d",indicemaxtabvars);
+  tofich(typedata,ligne,1);
+  fclose (typedata);
+}
+
+/******************************************************************************/
+/*                   write_createvarnameagrif_file                            */
+/******************************************************************************/
+/* This subroutine is used to create the file  createvarname                  */
+/******************************************************************************/
+/*                                                                            */
+/*    Agrif_Gr % tabvars (i) % var % namevar = "variable"                     */
+/*                                                                            */
+/******************************************************************************/
+void write_createvarnameagrif_file(variable *v,FILE *createvarname,
+                                                       int *InitEmpty)
+{
+  char ligne[LONG_C];
+  char *tmp;
+  char temp1[LONG_C];
+
+  tmp =  variablenametabvars(v,0);
+  strcpy (temp1, tmp);
+  if ( todebugfree == 1 ) free(tmp);
+
+  *InitEmpty = 0 ;
+  sprintf(ligne, "%s %% namevar = \"%s\"",temp1,v->v_nomvar);
+  tofich(createvarname,ligne,1);
+}
+
+/******************************************************************************/
+/*                        write_Setnumberofcells_file                         */
+/******************************************************************************/
+/* This subroutine is used to create the file  setnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              Agrif_Gr % n(i) = nbmailles                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Setnumberofcells_file(char *name)
+{
+  char ligne[LONG_C];
+  FILE *setnumberofcells;
+
+  if ( IndicenbmaillesX != 0 )
+  {
+  setnumberofcells=associate(name);
+
+  if (onlyfixedgrids != 1 )
+  {
+  sprintf (ligne,
+           "Agrif_Gr %% nb(1) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesX);
+  }
+  else
+  {
+  sprintf (ligne,
+           "Agrif_Gr %% nb(1) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesX);
+  }
+  tofich (setnumberofcells, ligne,1);
+  if (dimprob > 1)
+  {
+     if (onlyfixedgrids != 1 )
+     {
+     sprintf (ligne,
+           "Agrif_Gr %% nb(2) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesY);
+     }
+     else
+     {
+     sprintf (ligne,
+           "Agrif_Gr %% nb(2) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesY);
+     }
+
+     tofich (setnumberofcells, ligne,1);
+  }
+  if (dimprob > 2)
+  {
+     if (onlyfixedgrids != 1 )
+     {
+     sprintf (ligne,
+           "Agrif_Gr %% nb(3) = Agrif_Gr %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesZ);
+     }
+     else
+     {
+     sprintf (ligne,
+           "Agrif_Gr %% nb(3) = Agrif_Curgrid %% tabvars(%d) %% var %% iarray0",
+           IndicenbmaillesZ);
+     }
+     tofich (setnumberofcells, ligne,1);
+  }
+
+  fclose (setnumberofcells);
+  }
+}
+
+/******************************************************************************/
+/*                       write_Getnumberofcells_file                          */
+/******************************************************************************/
+/* This subroutine is used to create the file  getnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              nbmailles = Agrif_Gr % n(i)                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Getnumberofcells_file(char *name)
+{
+  char ligne[LONG_C];
+  FILE *getnumberofcells;
+
+  if ( IndicenbmaillesX != 0 )
+  {
+  getnumberofcells=associate(name);
+  sprintf (ligne,
+           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(1)",
+           IndicenbmaillesX);
+  tofich (getnumberofcells, ligne,1);
+  if (dimprob > 1)
+    {
+      sprintf (ligne,
+           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(2)",
+           IndicenbmaillesY);
+      tofich (getnumberofcells, ligne,1);
+    }
+  if (dimprob > 2)
+    {
+      sprintf (ligne,
+           "Agrif_Curgrid %% tabvars(%d) %% var %% iarray0 = Agrif_Gr %% nb(3)",
+           IndicenbmaillesZ);
+      tofich (getnumberofcells, ligne,1);
+    }
+  fclose (getnumberofcells);
+  }
+}
+
+
+/******************************************************************************/
+/*                      write_initialisationsagrif_file                       */
+/******************************************************************************/
+/* This subroutine is used to create the file initproc                        */
+/******************************************************************************/
+/*                                                                            */
+/*              ! variable                                                    */
+/*              Agrif_Gr % tabvars(i) % var % nbdim = 1                       */
+/*                                                                            */
+/******************************************************************************/
+void write_initialisationsagrif_file(variable *v,FILE *initproc,
+                                     int *VarnameEmpty)
+{
+  char ligne[LONG_C];
+  char temp1[LONG_C];
+  char *tmp;
+
+  tmp = variablenameroottabvars (v);
+  strcpy (temp1, tmp);
+  if ( todebugfree == 1 ) free(tmp);
+
+  if ( v->v_nbdim != 0 )
+  {
+     *VarnameEmpty = 0 ;
+     sprintf (ligne, "%s %% nbdim = %d", temp1, v->v_nbdim);
+     tofich (initproc, ligne,1);
+  }
+}
+
+
+void Write_Alloc_Agrif_Files()
+{
+   listnom *parcours;
+   FILE *alloccalls;
+   FILE *AllocUSE;
+
+   AllocUSE= associate("include_use_Alloc_agrif.h");
+   alloccalls = associate("allocations_calls_agrif.h");
+
+   parcours = List_Subroutine_For_Alloc;
+   while ( parcours )
+   {
+      fprintf(AllocUSE,"      USE %s\n", parcours -> o_nom );
+      fprintf (alloccalls,"      Call Alloc_agrif_%s(Agrif_Gr)\n",
+                                                            parcours -> o_nom );
+      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[LONGNOM];
+   char ligne2[LONGNOM];   
+   variable *v;
+   int IndiceMax;
+   int IndiceMin;
+   int compteur;
+   int out;
+   int indiceprec;
+   int ValeurMax;
+   char initialvalue[LONG_4C];
+   listindice *list_indic;
+   listindice *parcoursindic;
+   int i;
+
+   parcoursprec = (listvar *)NULL;
+   parcours_nom = List_NameOfCommon;
+   ValeurMax = 2;
+   while ( parcours_nom  )
+   {
+      /*                                                                      */
+      if ( parcours_nom->o_val == 1 )
+      {
+         /* Open the file to create the Alloc_agrif subroutine                */
+         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+         allocationagrif = associate (ligne);
+         /*                                                                   */
+         fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n",
+                                                           parcours_nom->o_nom);
+         /*                                                                   */
+         sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
+         paramtoamr = associate (ligne);
+         neededparameter = (listnom * )NULL;
+         /*                                                                   */
+         list_indic = (listindice *)NULL;
+         /*                                                                   */
+         shouldincludempif = 1 ;
+         parcours = List_Common_Var;
+         while ( parcours )
+         {
+            if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
+                  IndiceInlist(parcours->var->v_indicetabvars,list_indic) == 0
+               )
+            {
+               /***************************************************************/
+               /***************************************************************/
+               /***************************************************************/
+               v = parcours->var;
+               IndiceMax = 0;
+               IndiceMin = indicemaxtabvars;
+  /* body of the file                                                         */
+  if ( !strcasecmp(v->v_commoninfile,mainfile) )
+  {
+     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
+     {
+        strcpy (ligne, "If (.not. associated(");
+        strcat (ligne, vargridnametabvars(v,0));
+        strcat (ligne, "))                       then");
+        Save_Length(ligne,48);
+        tofich (allocationagrif, ligne,1);
+     }
+     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
+     {
+        /*                ALLOCATION                                          */
+        if ( v->v_dimension != 0  )
+        {
+           if ( v->v_indicetabvars < IndiceMin ||
+                v->v_indicetabvars > IndiceMax )
+           {
+              parcours1 = parcours;
+              compteur = -1;
+              out = 0;
+              indiceprec = parcours->var->v_indicetabvars -1 ;
+              while ( parcours1 && out == 0 &&
+                      !strcasecmp(  parcours->var->v_readedlistdimension,
+                                  parcours1->var->v_readedlistdimension) &&
+                      !strcasecmp(  parcours->var->v_typevar,
+                                  parcours1->var->v_typevar) &&
+                            ( parcours1->var->v_indicetabvars == indiceprec+1 )
+                     )
+              {
+
+               if ( !strcasecmp(parcours1->var->v_modulename,
+                                parcours_nom->o_nom) ||
+                    !strcasecmp(parcours1->var->v_commonname,
+                                parcours_nom->o_nom) )
+                 {
+                      compteur = compteur +1 ;
+                      indiceprec = parcours1->var->v_indicetabvars;
+                      parcoursprec = parcours1;
+                      parcours1 = parcours1->suiv;
+                 }
+                 else out = 1;
+              }
+
+              if ( compteur > ValeurMax )
+              {
+                 fprintf(allocationagrif,"      DO i = %d , %d\n",
+                                         parcours->var->v_indicetabvars,
+                                       parcours->var->v_indicetabvars+compteur);
+                 IndiceMin = parcours->var->v_indicetabvars;
+                 IndiceMax = parcours->var->v_indicetabvars+compteur;
+                 strcpy (ligne, "allocate ");
+                 strcat (ligne, "(");
+                 strcat (ligne, vargridnametabvars(v,1));
+                 strcat (ligne, vargridparam(v,0));
+                 strcat (ligne, ")");
+                 Save_Length(ligne,48);
+                 tofich (allocationagrif, ligne,1);
+                 fprintf(allocationagrif,"      end do\n");
+                 i=parcours->var->v_indicetabvars;
+                 do
+                 {
+                    parcoursindic =  (listindice *)malloc(sizeof(listindice));
+                    parcoursindic -> i_indice = i;
+                    parcoursindic -> suiv = list_indic;
+                    list_indic = parcoursindic;
+                    i = i + 1;
+                 } while ( i <= parcours->var->v_indicetabvars+compteur );
+                 parcours = parcoursprec;
+                 /*                                                           */
+              }
+              else
+              {
+                 strcpy (ligne, "allocate ");
+                 strcat (ligne, "(");
+                 strcat (ligne, vargridnametabvars(v,0));
+                 strcat (ligne, vargridparam(v,0));
+                 strcat (ligne, ")");
+                 Save_Length(ligne,48);
+                 tofich (allocationagrif, ligne,1);
+                 /*                                                           */
+                 parcoursindic =  (listindice *)malloc(sizeof(listindice));
+                 parcoursindic -> i_indice = parcours->var->v_indicetabvars;
+                 parcoursindic -> suiv = list_indic;
+                 list_indic = parcoursindic;
+              }
+                neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                              paramtoamr,v,parcours_nom->o_nom,neededparameter,
+                                                               v->v_commonname);
+              /*                                                              */
+           }
+        } /* end of the allocation part                                       */
+        /*                INITIALISATION                                      */
+        if ( strcasecmp(v->v_initialvalue,"") )
+        {
+           strcpy (ligne, "");
+           strcat (ligne, vargridnametabvars(v,0));
+           /* We should modify the initialvalue in the case of variable has   */
+           /*    been defined with others variables                           */
+                      
+           strcpy(initialvalue,
+                  ChangeTheInitalvaluebyTabvarsName
+                                      (v->v_initialvalue,List_Global_Var,0));
+           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+           {
+              strcpy(initialvalue,"");
+              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
+                                      (v->v_initialvalue,List_Common_Var,0));
+           }
+           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+           {
+              strcpy(initialvalue,"");
+              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
+                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
+           }
+           strcat (ligne," = ");
+
+           if (v->v_nbdim == 0)
+           {
+           strcpy(ligne2,initialvalue);
+           }
+           else
+           {
+           sprintf(ligne2,"RESHAPE(%s,SHAPE(%s))",initialvalue,vargridnametabvars(v,0));
+           }
+           strcat (ligne,ligne2);
+           /*                                                                 */
+           Save_Length(ligne,48);
+           tofich (allocationagrif, ligne,1);
+        }
+     }
+     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
+     {
+        strcpy (ligne, "   End if");
+        tofich (allocationagrif, ligne,1);
+     }
+  }
+               /***************************************************************/
+               /***************************************************************/
+               /***************************************************************/
+            }
+            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[LONGNOM];
+   variable *v;
+   int IndiceMax;
+   int IndiceMin;
+   int compteur;
+   int out;
+   int indiceprec;
+   int ValeurMax;
+   char initialvalue[LONG_4C];
+   int typeiswritten ;
+
+   parcoursprec = (listvar *)NULL;
+   parcours_nom = List_NameOfModule;
+   ValeurMax = 2;
+   while ( parcours_nom  )
+   {
+      /*                                                                      */
+      if ( parcours_nom->o_val == 1 )
+      {
+         IndiceMax = 0;
+         IndiceMin = indicemaxtabvars;
+         /* Open the file to create the Alloc_agrif subroutine                */
+         sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+         allocationagrif = associate (ligne);
+         /*                                                                   */
+         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+         {
+             /* add the call to initworkspace                                 */
+            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
+            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
+            tofich(allocationagrif,"else ",1);
+            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
+            tofich(allocationagrif,"endif ",1);
+            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
+         }
+
+         typeiswritten = 0;
+
+         parcours = List_Global_Var;
+         while ( parcours )
+         {
+            if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+                 parcours->var->v_VariableIsParameter == 0                  &&
+                 parcours->var->v_notgrid == 0                              &&
+                 !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom)  )
+            {
+               /***************************************************************/
+               /***************************************************************/
+               /***************************************************************/
+               v = parcours->var;
+               IndiceMax = 0;
+               IndiceMin = indicemaxtabvars;
+  /* body of the file                                                         */
+  if ( !strcasecmp(v->v_commoninfile,mainfile) )
+  {
+     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
+     {
+        strcpy (ligne, "If (.not. associated(");
+        strcat (ligne, vargridnametabvars(v,0));
+        strcat (ligne, "))                       then");
+        Save_Length(ligne,48);
+        tofich (allocationagrif, ligne,1);
+     }
+     if ( v->v_allocatable != 1 && ( v->v_dimsempty != 1) )
+     {
+        /*                ALLOCATION                                          */
+        if ( v->v_dimension != 0  )
+        {
+           if ( v->v_indicetabvars < IndiceMin ||
+                v->v_indicetabvars > IndiceMax )
+           {
+              parcours1 = parcours;
+              compteur = -1;
+              out = 0;
+              indiceprec = parcours->var->v_indicetabvars -1 ;
+              while ( parcours1 && out == 0 &&
+                      !strcasecmp(  parcours->var->v_readedlistdimension,
+                                  parcours1->var->v_readedlistdimension) &&
+                      !strcasecmp(  parcours->var->v_typevar,
+                                  parcours1->var->v_typevar) &&
+                             ( parcours1->var->v_indicetabvars == indiceprec+1 )
+                     )
+              {
+
+               if ( !strcasecmp(parcours1->var->v_modulename,
+                                parcours_nom->o_nom) ||
+                    !strcasecmp(parcours1->var->v_commonname,
+                                parcours_nom->o_nom) )
+                 {
+                      compteur = compteur +1 ;
+                      indiceprec = parcours1->var->v_indicetabvars;
+                      parcoursprec = parcours1;
+                      parcours1 = parcours1->suiv;
+                 }
+                 else out = 1;
+              }
+              if ( compteur > ValeurMax )
+              {
+                 fprintf(allocationagrif,"      DO i = %d , %d\n",
+                                          parcours->var->v_indicetabvars,
+                                       parcours->var->v_indicetabvars+compteur);
+                 IndiceMin = parcours->var->v_indicetabvars;
+                 IndiceMax = parcours->var->v_indicetabvars+compteur;
+                 strcpy (ligne, "allocate ");
+                 strcat (ligne, "(");
+                 strcat (ligne, vargridnametabvars(v,1));
+                 strcat (ligne, vargridparam(v,0));
+                 strcat (ligne, ")");
+                 Save_Length(ligne,48);
+                 tofich (allocationagrif, ligne,1);
+                 fprintf(allocationagrif,"      end do\n");
+                 parcours = parcoursprec;
+              }
+              else
+              {
+                 strcpy (ligne, "allocate ");
+                 strcat (ligne, "(");
+                 strcat (ligne, vargridnametabvars(v,0));
+                 strcat (ligne, vargridparam(v,0));
+                 strcat (ligne, ")");
+                 Save_Length(ligne,48);
+                 tofich (allocationagrif, ligne,1);
+              }
+           }
+        } /* end of the allocation part                                       */
+
+        /*                INITIALISATION                                      */
+        if ( strcasecmp(v->v_initialvalue,"") )
+        {
+           strcpy (ligne, "");
+           strcat (ligne, vargridnametabvars(v,0));
+           /* We should modify the initialvalue in the case of variable has   */
+           /*    been defined with others variables                           */
+
+           strcpy(initialvalue,
+                  ChangeTheInitalvaluebyTabvarsName
+                                      (v->v_initialvalue,List_Global_Var,0));
+           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+           {
+              strcpy(initialvalue,"");
+              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
+                                      (v->v_initialvalue,List_Common_Var,0));
+           }
+           if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+           {
+              strcpy(initialvalue,"");
+              strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName
+                                     (v->v_initialvalue,List_ModuleUsed_Var,0));
+           }
+           strcat (ligne," = ");
+           strcat (ligne,initialvalue);
+           /*                                                                 */
+           Save_Length(ligne,48);
+           tofich (allocationagrif, ligne,1);
+        }
+     }
+/* Case of structure types */
+        if ((typeiswritten == 0) && !strcasecmp(v->v_typevar,"type"))
+        {
+        sprintf(ligne,"If (.Not.Allocated(Agrif_%s_var)) Then",v->v_modulename);
+        tofich(allocationagrif, ligne, 1);
+        sprintf(ligne,"Allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
+        tofich(allocationagrif, ligne, 1);
+        strcpy(ligne,"End If");
+        tofich(allocationagrif, ligne, 1);
+        typeiswritten = 1;
+        }
+     if (onlyfixedgrids != 1 && v->v_nbdim!=0)
+     {
+        strcpy (ligne, "   End if");
+        tofich (allocationagrif, ligne,1);
+     }
+  }
+               /***************************************************************/
+               /***************************************************************/
+               /***************************************************************/
+            }
+            parcours = parcours -> suiv;
+         }
+         /*                                                                   */
+         if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+         {
+            /* add the call to initworkspace                                  */
+            tofich(allocationagrif,"if ( .NOT. Agrif_Root() ) then ",1);
+            fprintf(allocationagrif,"#include \"GetNumberofcells.h\" \n");
+            tofich(allocationagrif,"else ",1);
+            fprintf(allocationagrif,"#include \"SetNumberofcells.h\" \n");
+            tofich(allocationagrif,"endif ",1);
+            tofich(allocationagrif,"Call Agrif_InitWorkspace ",1);
+         }
+         /* Close the file Alloc_agrif                                        */
+         fclose(allocationagrif);
+      } /* end parcours_nom == 1                                              */
+      /*                                                                      */
+      parcours_nom = parcours_nom -> suiv;
+   }
+}
+
+/******************************************************************************/
+/*                           creefichieramr                                   */
+/******************************************************************************/
+/* This subroutine is the main one to create AGRIF_INC files                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void creefichieramr (char *NameTampon)
+{
+  listvar *newvar;
+  variable *v;
+  int erreur;
+  char filefich[LONG_C];
+  char ligne[LONG_C];
+  int IndiceMax;
+  int IndiceMin;
+  int InitEmpty;
+  int VarnameEmpty;
+  int donotwrite;
+
+  FILE *initproc;
+  FILE *initglobal;
+  FILE *createvarname;
+  FILE *createvarnameglobal;
+
+  if ( todebug == 1 ) printf("Enter in creefichieramr\n");
+  strcpy (filefich, "cd ");
+  strcat (filefich, nomdir);
+  erreur = system (filefich);
+  if (erreur)
+  {
+     strcpy (filefich, "mkdir ");
+     strcat (filefich, nomdir);
+     system (filefich);
+     printf ("%s: Directory created\n", nomdir);
+  }
+
+/******************************************************************************/
+/******************** Creation of AGRIF_INC files *****************************/
+/******************************************************************************/
+
+/*----------------------------------------------------------------------------*/
+  if ( todebug == 1 )
+  {
+     strcpy(ligne,"initialisations_agrif_");
+     strcat(ligne,NameTampon);
+     strcat(ligne,".h");
+     initproc = associate (ligne);
+/*----------------------------------------------------------------------------*/
+     strcpy(ligne,"createvarname_agrif_");
+     strcat(ligne,NameTampon);
+     strcat(ligne,".h");
+     createvarname = associate (ligne);
+/*----------------------------------------------------------------------------*/
+     InitEmpty = 1 ;
+     VarnameEmpty = 1 ;
+
+     newvar = List_Global_Var;
+     while ( newvar && todebug == 1 )
+     {
+        donotwrite = 0;
+        v = newvar->var;
+
+        if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
+        {
+          write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
+          write_initialisationsagrif_file(v,initproc,&InitEmpty);
+        }
+        newvar = newvar->suiv;
+     }
+  /*                                                                          */
+     fclose (createvarname);
+     fclose (initproc);
+  /*--------------------------------------------------------------------------*/
+     if ( Did_filetoparse_readed(curmodulename) == 0 )
+     {
+        if ( InitEmpty != 1  )
+        {
+           initglobal = associateaplus("initialisations_agrif.h");
+           strcpy(ligne,"#include \"initialisations_agrif_");
+           strcat(ligne,NameTampon);
+           strcat(ligne,".h\"\n");
+           fprintf(initglobal,ligne);
+           fclose(initglobal);
+        }
+  /*--------------------------------------------------------------------------*/
+        if ( VarnameEmpty != 1 )
+        {
+           createvarnameglobal= associateaplus("createvarname_agrif.h");
+           strcpy(ligne,"#include \"createvarname_agrif_");
+           strcat(ligne,NameTampon);
+           strcat(ligne,".h\"\n");
+           fprintf(createvarnameglobal,ligne);
+           fclose(createvarnameglobal);
+        }
+     }
+  }
+/*----------------------------------------------------------------------------*/
+/*----------------------------------------------------------------------------*/
+/*----------------------------------------------------------------------------*/
+/*----------------------------------------------------------------------------*/
+/*----------------------------------------------------------------------------*/
+  IndiceMax = 0;
+  IndiceMin = 0;
+
+  write_allocation_Common_0();
+  write_allocation_Global_0();
+
+  Write_Alloc_Agrif_Files();
+  write_probdimagrif_file();
+  write_keysagrif_file();
+  write_modtypeagrif_file();
+  if ( NbMailleXDefined == 1 )
+                             write_Setnumberofcells_file("SetNumberofcells.h");
+  if ( NbMailleXDefined == 1 )
+                             write_Getnumberofcells_file("GetNumberofcells.h");
+  retour77 = 0;
+  if ( NbMailleXDefined == 1 )
+                          write_Setnumberofcells_file("SetNumberofcellsFree.h");
+  if ( NbMailleXDefined == 1 )
+                          write_Getnumberofcells_file("GetNumberofcellsFree.h");
+  retour77 = 1;
+  if ( NbMailleXDefined == 1 )
+                         write_Setnumberofcells_file("SetNumberofcellsFixed.h");
+  if ( NbMailleXDefined == 1 )
+                         write_Getnumberofcells_file("GetNumberofcellsFixed.h");
+  if ( todebug == 1 ) printf("Out of creefichieramr\n");
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/AGRIF/agrif_opa.in	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/calendar.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/defprec.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/errioipsl.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/flincom.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/fliocom.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/getincom.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/histcom.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/ioipsl.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/mathelp.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/nc4interface.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/restcom.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/src/stringop.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/Fparser.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90	(revision 3437)
@@ -0,0 +1,1624 @@
+PROGRAM flio_rbld
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! PROGRAM flio_rbld
+!!
+!! PURPOSE :
+!!   Recombine the files of MPI version of IOIPSL
+!!   along several dimensions.
+!!
+!! CALLING SEQUENCE :
+!!
+!!   "flio_rbld" is usually invoked by the script "rebuild"
+!!
+!!   rebuild -h
+!!
+!!   rebuild [-v lev] [-f] -o outfile infile[1] ... infile[n]
+!!
+!! INPUT for "rebuild" :
+!!
+!!   -h         : help
+!!   -v lev     : verbosity level
+!!   -f         : force executing mode
+!!   -o outfile : name of the recombined file.
+!!   infiles    : names of the files that must be recombined.
+!!
+!! INPUT for "flio_rbld" :
+!!
+!!  (I) i_v_lev  : verbosity level
+!!  (C) c_force  : executing mode (noforce/force)
+!!  (I) f_nb     : total number of files
+!!  (C) f_nm(:)  : names of the files (input_files output_file)
+!!
+!!
+!! ASSOCIATED MODULES :
+!!   IOIPSL(fliocom)
+!!
+!! RESTRICTIONS :
+!!
+!!   Cases for character are not coded.
+!!
+!!   Cases for netCDF variables such as array with more
+!!   than 5 dimensions are not coded.
+!!
+!!   Input files must have the following global attributes :
+!!
+!!     "DOMAIN_number_total"
+!!     "DOMAIN_number"
+!!     "DOMAIN_dimensions_ids"
+!!     "DOMAIN_size_global"
+!!     "DOMAIN_size_local"
+!!     "DOMAIN_position_first"
+!!     "DOMAIN_position_last"
+!!     "DOMAIN_halo_size_start"
+!!     "DOMAIN_halo_size_end"
+!!     "DOMAIN_type"
+!!
+!!   NetCDF files must be smaller than 2 Gb.
+!!
+!!   Character variables should have less than 257 letters
+!!
+!! EXAMPLE :
+!!
+!!   rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
+!!
+!! MODIFICATION HISTORY :
+!!   Sebastien Masson   (smasson@jamstec.go.jp)   March 2004
+!!   Jacques   Bellier  (Jacques.Bellier@cea.fr)  June  2005
+!!--------------------------------------------------------------------
+  USE IOIPSL
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+!-
+! DO loops and test related variables
+  INTEGER :: i,ia,id,iv,iw,i_i,i_n
+  INTEGER :: ik,itmin,itmax,it1,it2,it
+  LOGICAL :: l_force,l_uld
+!-
+! Input arguments related variables
+  INTEGER :: i_v_lev
+  CHARACTER(LEN=15) :: c_force
+  INTEGER :: f_nb,f_nb_in
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
+!-
+! Domains related variables
+  INTEGER :: d_n_t,i_ntd
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
+  LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_m,l_o_l
+  CHARACTER(LEN=chlen) :: c_d_n
+!-
+! Model files related variables
+  LOGICAL :: l_ocf
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
+  INTEGER :: f_id_i1,f_id_i,f_id_o
+  INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul
+  INTEGER :: v_a_nb,a_type
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
+&  f_d_nm,f_v_nm,f_a_nm,v_a_nm
+  CHARACTER(LEN=chlen) :: f_u_nm
+  INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
+  INTEGER :: a_l
+  INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie
+  INTEGER,DIMENSION(:),ALLOCATABLE :: &
+ &  io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
+  LOGICAL :: l_ex
+  CHARACTER(LEN=chlen) :: c_wn1,c_wn2
+!-
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1) :: i1_0d
+!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
+!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
+  INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
+  INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
+  REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
+  REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
+  REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
+  REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
+!-
+! elapsed and cpu time computation variables
+  INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
+  REAL :: t_cpu_ini,t_cpu_end
+!---------------------------------------------------------------------
+!-
+!-------------------
+! INPUT arguments
+!-------------------
+!-
+! Retrieve the verbosity level
+  READ (UNIT=*,FMT=*) i_v_lev
+!-
+! Retrieve the executing mode
+  READ (UNIT=*,FMT='(A)') c_force
+  l_force = (TRIM(c_force)  == 'force')
+!-
+! Retrieve the number of arguments
+  READ (UNIT=*,FMT=*) f_nb
+  f_nb_in = f_nb-1
+!-
+! Retrieve the file names
+  ALLOCATE(f_nm(f_nb))
+  DO iw=1,f_nb
+    READ (UNIT=*,FMT='(A)') f_nm(iw)
+  ENDDO
+!-
+! Allocate and initialize the array of file access identifiers
+  ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1;
+!-
+  IF (i_v_lev >= 1) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev
+    WRITE (UNIT=*,FMT='(" executing  mode : ",A)') TRIM(c_force)
+    WRITE (UNIT=*,FMT='(" number of args  : ",I4)') f_nb
+    WRITE (UNIT=*,FMT='(" Input  files :")')
+    DO iw=1,f_nb_in
+      WRITE (*,'("   ",A)') TRIM(f_nm(iw))
+    ENDDO
+    WRITE (UNIT=*,FMT='(" Output file  :")')
+    WRITE (*,'("   ",A)') TRIM(f_nm(f_nb))
+!-- time initializations
+    CALL system_clock &
+ &   (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
+    CALL cpu_time (t_cpu_ini)
+  ENDIF
+!-
+!---------------------------------------------------
+! Retrieve basic informations from the first file
+!---------------------------------------------------
+!-
+! Open the first file
+  CALL flrb_of (1,f_id_i)
+!-
+! Get the attribute "DOMAIN_number_total"
+  CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
+!-
+! Validate the number of input files :
+! should be equal to the total number
+! of domains used in the simulation
+  IF (d_n_t /= f_nb_in) THEN
+    IF (l_force) THEN
+      iw = 2
+    ELSE
+      iw = 3
+      DEALLOCATE(f_nm,f_a_id)
+      CALL flrb_cf (1,.TRUE.)
+    ENDIF
+    CALL ipslerr (iw,"flio_rbld", &
+ &   "The number of input files", &
+ &   "is not equal to the number of DOMAINS"," ")
+  ENDIF
+!-
+! Retrieve the basic characteristics of the first input file
+  CALL flioinqf &
+ & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul)
+!-
+! Build the list of the names of the
+! dimensions/variables/global_attributes and retrieve
+! the unlimited_dimension name from the first input file
+  ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
+  CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
+ &                      cn_gat=f_a_nm,cn_uld=f_u_nm)
+!-
+! Build the list of the dimensions identifiers and lengths
+  ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
+  CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
+!-
+! Close the file
+  CALL flrb_cf (1,.FALSE.)
+!-
+! Check if the number of needed files is greater than
+! the maximum number of simultaneously opened files.
+! In that case, open and close model files for each reading,
+! otherwise keep the "flio" identifiers of the opened files.
+  l_ocf = (f_nb > flio_max_files)
+!-
+!----------------------------------------------------
+! Retrieve domain informations for each input file
+!----------------------------------------------------
+!-
+  DO iw=1,f_nb_in
+!---
+    CALL flrb_of (iw,f_id_i)
+!---
+    IF (iw > 1) THEN
+      c_wn1 = "DOMAIN_number_total"
+      CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+      IF (l_ex) THEN
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
+        IF (i_ntd /= d_n_t) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &        "File      : "//TRIM(f_nm(iw)), &
+ &        "Attribute : "//TRIM(c_wn1), &
+ &        "not equal to the one of the first file")
+        ENDIF
+      ELSE
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1),"not found")
+      ENDIF
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_dimensions_ids"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      ALLOCATE(dom_att(a_l))
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+      IF (iw == 1) THEN
+        IF (ANY(dom_att(:) == f_d_ul)) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "contains the unlimited dimension")
+        ENDIF
+        ALLOCATE (d_d_i(a_l))
+        d_d_i(:) = dom_att(:)
+      ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+      DEALLOCATE(dom_att)
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_global"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_g(a_l))
+          d_s_g(:)=dom_att(:)
+        ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "not equal to the one of the first file")
+        ENDIF
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_local"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_l(a_l,f_nb_in))
+        ENDIF
+        d_s_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_first"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_f(a_l,f_nb_in))
+        ENDIF
+        d_p_f(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_last"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_l(a_l,f_nb_in))
+        ENDIF
+        d_p_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_start"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_s(a_l,f_nb_in))
+        ENDIF
+        d_h_s(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_end"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_e(a_l,f_nb_in))
+        ENDIF
+        d_h_e(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_type"
+    c_wn2 = " "
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
+      CALL strlowercase (c_wn2)
+      IF (iw == 1) THEN
+        IF (    (TRIM(c_wn2) == "box") &
+ &          .OR.(TRIM(c_wn2) == "apple") ) THEN
+          c_d_n = c_wn2
+        ELSE
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "type "//TRIM(c_wn2)//" not (yet) supported")
+        ENDIF
+      ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    CALL flrb_cf (iw,l_ocf)
+!---
+  ENDDO
+!-
+  IF (i_v_lev >= 2) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From the first file : ")')
+    WRITE (*,'("   Number of dimensions : ",I2)') f_d_nb
+    WRITE (*,'("     Idents  : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
+    WRITE (*,'("     Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_d_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_d_nm(i))
+    ENDDO
+    IF (f_d_ul > 0) THEN
+      WRITE (*,'("   Unlimited dimension id : ",I2)') f_d_i(f_d_ul)
+    ENDIF
+    WRITE (*,'("   Number of variables  : ",I2)') f_v_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_v_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_v_nm(i))
+    ENDDO
+    WRITE (*,'("   Number of global attributes : ",I2)') f_a_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_a_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_a_nm(i))
+    ENDDO
+  ENDIF
+  IF (i_v_lev >= 3) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From input files : ")')
+    WRITE (*,'("   Total number of DOMAINS : ",I4)') d_n_t
+    WRITE (*,'("   DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
+    WRITE (*,'("   DOMAIN_size_global    :",(10(1X,I5),:))') d_s_g(:)
+    WRITE (*,'("   DOMAIN_type           : """,(A),"""")') TRIM(c_d_n)
+    DO iw=1,f_nb_in
+      WRITE (*,'("   File   : ",A)') TRIM(f_nm(iw))
+      WRITE (*,'("     d_s_l  :",(10(1X,I5),:))') d_s_l(:,iw)
+      WRITE (*,'("     d_p_f  :",(10(1X,I5),:))') d_p_f(:,iw)
+      WRITE (*,'("     d_p_l  :",(10(1X,I5),:))') d_p_l(:,iw)
+      WRITE (*,'("     d_h_s  :",(10(1X,I5),:))') d_h_s(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Beginning offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+      WRITE (*,'("     d_h_e  :",(10(1X,I5),:))') d_h_e(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Ending offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+!---------------------------------------
+! Create the dimensionned output file
+!---------------------------------------
+!-
+! Define the dimensions used in the output file
+  DO id=1,f_d_nb
+    DO i=1,SIZE(d_d_i)
+      IF (f_d_i(id) == d_d_i(i)) THEN
+        f_d_l(id) = d_s_g(i)
+      ENDIF
+    ENDDO
+  ENDDO
+!-
+  IF (f_d_ul > 0) THEN
+    i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1;
+  ENDIF
+!-
+! Create the output file
+  CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
+!-
+  IF (f_d_ul > 0) THEN
+    f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul);
+  ELSE
+    itmin = 1; itmax = 1;
+  ENDIF
+!-
+! open the first input file used to build the output file
+!-
+  CALL flrb_of (1,f_id_i1)
+!-
+! define the global attributes in the output file
+! copy all global attributes except those beginning by "DOMAIN_"
+! eventually actualize the "file_name" attribute
+!-
+  DO ia=1,f_a_nb
+    IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1)  CYCLE
+    IF (TRIM(f_a_nm(ia)) == "file_name") THEN
+      CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
+    ELSE
+      CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
+    ENDIF
+  ENDDO
+!-
+! define the variables in the output file
+!-
+  ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0;
+  ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0;
+  ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb));
+  DO iv=1,f_v_nb
+!-- get variable informations
+    CALL flioinqv &
+ &   (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), &
+ &    nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb)
+!-- define the new variable
+    IF (v_d_nb(iv) == 0) THEN
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv))
+    ELSE
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv))
+      DO iw=1,v_d_nb(iv)
+        IF (f_d_ul > 0) THEN
+          IF (d_i(iw) == f_d_ul) THEN
+            v_d_ul(iv) = iw
+          ENDIF
+        ENDIF
+      ENDDO
+      v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv))
+    ENDIF
+!-- copy all variable attributes
+    IF (v_a_nb > 0) THEN
+      ALLOCATE(v_a_nm(v_a_nb))
+      CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
+      DO ia=1,v_a_nb
+        CALL fliocpya &
+ &       (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
+ &        f_id_o,TRIM(f_v_nm(iv)))
+      ENDDO
+      DEALLOCATE(v_a_nm)
+    ENDIF
+  ENDDO
+!-
+! update valid_min valid_max attributes values
+!-
+  CALL flrb_rg
+!-
+!------------------------
+! Fill the output file
+!------------------------
+!-
+  DO ik=1,2
+    l_uld = (ik /= 1)
+    IF (l_uld) THEN
+      it1=itmin; it2=itmax;
+    ELSE
+      it1=1; it2=1;
+    ENDIF
+    DO it=it1,it2
+      DO iv=1,f_v_nb
+        IF (    (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
+ &          .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
+          CYCLE
+        ENDIF
+        IF (i_v_lev >= 3) THEN
+          WRITE (UNIT=*,FMT='("")')
+          IF (l_uld) THEN
+            WRITE (UNIT=*,FMT=*) "time step     : ",it
+          ENDIF
+          WRITE (UNIT=*,FMT=*) "variable      : ",TRIM(f_v_nm(iv))
+          WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv)
+        ENDIF
+!------ do the variable contains dimensions to be recombined ?
+        l_cgd = .FALSE.
+        i_n = 1
+        DO i=1,SIZE(d_d_i)
+          l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
+          l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
+          IF (l_cgd) THEN
+            i_n = f_nb_in
+              EXIT
+          ENDIF
+        ENDDO
+        IF (v_d_nb(iv) > 0) THEN
+!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
+          i = v_d_nb(iv)
+          ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
+!-------- Default definition of io_i,io_n,io_sm,io_cm
+          io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
+          ia_sm(:) = 1; io_sm(:) = 1;
+          IF (v_d_ul(iv) > 0) THEN
+            io_i(v_d_ul(iv))=it
+            io_n(v_d_ul(iv))=1
+            io_sm(v_d_ul(iv))=it
+          ENDIF
+          io_cm(:) = io_n(:);
+!-------- If needed, allocate offset
+          l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+          IF (TRIM(c_d_n) == "apple") THEN
+            ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
+            ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
+            ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
+            ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
+            IF (v_d_ul(iv) > 0) THEN
+              io_sf(v_d_ul(iv))=it
+              io_sl(v_d_ul(iv))=it
+            ENDIF
+          ENDIF
+        ENDIF
+!------
+        DO i_i=1,i_n
+          IF (l_cgd) THEN
+!---------- the variable contains dimensions to be recombined
+!-----------
+!---------- open each file containing a small piece of data
+            CALL flrb_of (i_i,f_id_i)
+!-----------
+!---------- do the variable has offset at first/last block ?
+            l_cof = .FALSE.; l_col = .FALSE.;
+            IF (TRIM(c_d_n) == "apple") THEN
+              L_BF: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_cof = (d_h_s(i,i_i) /= 0)
+                    IF (l_cof)  EXIT L_BF
+                  ENDIF
+                ENDDO
+              ENDDO L_BF
+              L_BL: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_col = (d_h_e(i,i_i) /= 0)
+                    IF (l_col)  EXIT L_BL
+                  ENDIF
+                ENDDO
+              ENDDO L_BL
+            ENDIF
+!---------- if needed, redefine start and count for dimensions
+            l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+            DO id=1,v_d_nb(iv)
+              DO i=1,SIZE(d_d_i)
+                IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                  io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
+                  ia_sm(id) = 1
+                  io_sm(id) = d_p_f(i,i_i)
+                  io_cm(id) = io_n(id)
+                  IF     (TRIM(c_d_n) == "box") THEN
+                    ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
+                    io_sm(id) = io_sm(id)+d_h_s(i,i_i)
+                    io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
+                  ELSEIF (TRIM(c_d_n) == "apple") THEN
+                    IF (l_cof) THEN
+                      IF (d_h_s(i,i_i) /= 0) THEN
+                        ia_sf(id) = 1+d_h_s(i,i_i)
+                        io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
+                        io_cf(id) = io_n(id)-d_h_s(i,i_i)
+                      ELSE
+                        io_sf(id) = d_p_f(i,i_i)
+                        io_cf(id) = 1
+                        ia_sm(id) = ia_sm(id)+1
+                        io_sm(id) = io_sm(id)+1
+                        io_cm(id) = io_cm(id)-1
+                        l_o_f = .TRUE.
+                      ENDIF
+                    ENDIF
+                    IF (l_col) THEN
+                      IF (d_h_e(i,i_i) /= 0) THEN
+                        ia_sl(id) = 1
+                        io_sl(id) = d_p_f(i,i_i)
+                        io_cl(id) = io_n(id)-d_h_e(i,i_i)
+                      ELSE
+                        io_cm(id) = io_cm(id)-1
+                        ia_sl(id) = 1+io_n(id)-1
+                        io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
+                        io_cl(id) = 1
+                        l_o_l = .TRUE.
+                      ENDIF
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDDO
+            ENDDO
+            l_o_m = ALL(io_cm > 0)
+          ELSE
+!---------- the data can be read/write in one piece
+            f_id_i = f_id_i1
+          ENDIF
+!---------
+          IF (i_v_lev >= 3) THEN
+            WRITE (UNIT=*,FMT=*) &
+ &            TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
+            WRITE (UNIT=*,FMT=*) "io_i  : ",io_i(:)
+            WRITE (UNIT=*,FMT=*) "io_n  : ",io_n(:)
+            WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f
+            IF (l_o_f) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_m : ",l_o_m
+            IF (l_o_m) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l
+            IF (l_o_l) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:)
+            ENDIF
+          ENDIF
+!---------
+!-------- Cases according to the type, shape and offsets of the data
+!---------
+          SELECT CASE (v_type(iv))
+!?INTEGERS of KIND 1 are not supported on all computers
+!?        CASE (flio_i1) !--- INTEGER 1
+!?          SELECT CASE (v_d_nb(iv))
+!?          CASE (0) !--- Scalar
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
+!?            CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
+!?          CASE (1) !--- 1d array
+!?            ALLOCATE(i1_1d(io_n(1)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_1d)
+!?          CASE (2) !--- 2d array
+!?            ALLOCATE(i1_2d(io_n(1),io_n(2)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_2d)
+!?          CASE (3) !--- 3d array
+!?            ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_3d)
+!?          CASE (4) !--- 4d array
+!?            ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_4d)
+!?          CASE (5) !--- 5d array
+!?            ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_5d)
+!?          END SELECT
+!?        CASE (flio_i2) !--- INTEGER 2
+          CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i2_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i2_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_5d)
+            END SELECT
+          CASE (flio_i4) !--- INTEGER 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_5d)
+            END SELECT
+          CASE (flio_r4) !--- REAL 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_5d)
+            END SELECT
+          CASE (flio_r8) !--- REAL 8
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r8_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r8_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_5d)
+            END SELECT
+          END SELECT
+!-------- eventually close each file containing a small piece of data
+          CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
+        ENDDO
+!------ If needed, deallocate io_* arrays
+        IF (v_d_nb(iv) > 0) THEN
+          DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
+          IF (TRIM(c_d_n) == "apple") THEN
+            DEALLOCATE(ia_sf,io_sf,io_cf)
+            DEALLOCATE(ia_sl,io_sl,io_cl)
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+!-------------------
+! Ending the work
+!-------------------
+!-
+! Close files
+  CALL flrb_cf (0,.TRUE.)
+!-
+! Deallocate
+  DEALLOCATE(f_nm,f_a_id)
+  DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
+  DEALLOCATE(f_d_i,f_d_l)
+  DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
+  DEALLOCATE(d_d_i,d_s_g)
+  DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
+!-
+  IF (i_v_lev >= 1) THEN
+!-- elapsed and cpu time computation
+    CALL cpu_time (t_cpu_end)
+    CALL system_clock(count=nb_cc_end)
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
+ &   REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
+    WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
+ &   t_cpu_end-t_cpu_ini
+  ENDIF
+!=======
+CONTAINS
+!=======
+SUBROUTINE flrb_of (i_f_n,i_f_i)
+!---------------------------------------------------------------------
+! Open the file of number "i_f_n" if necessary,
+! and returns its identifier in "i_f_i".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: i_f_n
+  INTEGER,INTENT(OUT) :: i_f_i
+!---------------------------------------------------------------------
+  IF (f_a_id(i_f_n) < 0) THEN
+    CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
+    f_a_id(i_f_n) = i_f_i
+  ELSE
+    i_f_i = f_a_id(i_f_n)
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_of
+!===
+SUBROUTINE flrb_cf (i_f_n,l_cf)
+!---------------------------------------------------------------------
+! Close the file of number "i_f_n" if "l_cf" is TRUE.
+! Close all files if "i_f_n <= 0".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_f_n
+  LOGICAL,INTENT(IN) :: l_cf
+!---------------------------------------------------------------------
+  IF (i_f_n <= 0) THEN
+    CALL flioclo ()
+    f_a_id(:) = -1
+  ELSE
+    IF (l_cf) THEN
+      IF (f_a_id(i_f_n) < 0) THEN
+        CALL ipslerr (2,"flio_rbld", &
+ &       "The file",TRIM(f_nm(i_f_n)),"is already closed")
+      ELSE
+        CALL flioclo (f_a_id(i_f_n))
+        f_a_id(i_f_n) = -1
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_cf
+!===
+SUBROUTINE flrb_rg
+!---------------------------------------------------------------------
+! Update valid_min valid_max attributes values
+!---------------------------------------------------------------------
+  INTEGER :: k,j
+  LOGICAL :: l_vmin,l_vmax
+  INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
+  REAL(KIND=r_4) :: r4_vmin,r4_vmax
+  REAL(KIND=r_8) :: r8_vmin,r8_vmax
+!---------------------------------------------------------------------
+  DO k=1,f_v_nb
+!-- get attribute informations
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
+!---
+    IF (l_vmin.OR.l_vmax) THEN
+!---- get values of min/max
+      SELECT CASE (a_type)
+      CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
+            IF (j == 1) THEN
+              i4_vmin = i4_0d
+            ELSE
+              i4_vmin = MIN(i4_vmin,i4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
+            IF (j == 1) THEN
+              i4_vmax = i4_0d
+            ELSE
+              i4_vmax = MAX(i4_vmax,i4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
+        ENDIF
+      CASE (flio_r4) !--- REAL 4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
+            IF (j == 1) THEN
+              r4_vmin = r4_0d
+            ELSE
+              r4_vmin = MIN(r4_vmin,r4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
+            IF (j == 1) THEN
+              r4_vmax = r4_0d
+            ELSE
+              r4_vmax = MAX(r4_vmax,r4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
+        ENDIF
+      CASE (flio_r8) !--- REAL 8
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
+            IF (j == 1) THEN
+              r8_vmin = r8_0d
+            ELSE
+              r8_vmin = MIN(r8_vmin,r8_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
+            IF (j == 1) THEN
+              r8_vmax = r8_0d
+            ELSE
+              r8_vmax = MAX(r8_vmax,r8_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
+        ENDIF
+      END SELECT
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE flrb_rg
+!===
+!--------------------
+END PROGRAM flio_rbld
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncregular.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/ncunderflow.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.h	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/LICENSE
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/LICENSE	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/LICENSE	(revision 3437)
@@ -0,0 +1,35 @@
+Copyright (c) 2003, 2004, Alberto Garcia (SAX, XPATH, WXML, Overall design)
+(c) 2003, 2004, Jon Wakelin, Alberto Garcia (DOM subsystem)
+(c) 2003, 2004, Jon Wakelin (CML writing subsystem)
+STRINGS module contributed by Mart Reentmeester. (See strings/m_strings.f90)
+
+All rights reserved.
+
+* Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+        
+* Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+        
+* Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+        
+* Neither the name of the copyright holder nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/flib_cml.f90	(revision 3437)
@@ -0,0 +1,7 @@
+module flib_cml
+  use m_stmw
+  use m_cmlw
+ 
+  public
+
+end module flib_cml
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_cmlw.f90	(revision 3437)
@@ -0,0 +1,1846 @@
+module m_cmlw
+
+  use flib_wxml
+  use m_stmw
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+
+! CMLUnits
+  character(len=40), parameter :: U_ANGSTR = 'units:angstrom'
+  character(len=40), parameter :: U_PMETER = 'units:pm'
+  character(len=40), parameter :: U_DEGREE = 'units:degree'
+  character(len=40), parameter :: U_RADIAN = 'units:radian'
+  character(len=40), parameter :: U_INVCM  = 'units:cm-1'
+  character(len=40), parameter :: U_KCALMO = 'units:kcal-mole'
+  character(len=40), parameter :: U_EVOLT  = 'units:ev'
+  character(len=40), parameter :: U_SECOND = 'units:second'
+  character(len=40), parameter :: U_VOLT   = 'units:volt'
+
+! CMLCore
+  PUBLIC :: cmlAddCoordinates
+  PUBLIC :: cmlAddCrystal
+  PUBLIC :: cmlAddAngle
+  PUBLIC :: cmlAddLength
+  PUBLIC :: cmlAddEigenvalue
+  PUBLIC :: cmlAddProperty
+  PUBLIC :: cmlAddPropertyList
+  PUBLIC :: cmlAddMolecule
+  PUBLIC :: cmlAddMetadata
+
+! CMLComp
+  PUBLIC :: cmlAddLattice
+  PUBLIC :: cmlAddLatticeVector
+  PUBLIC :: cmlAddParameter
+
+! CMLCore
+  INTERFACE cmlAddCoordinates
+     MODULE PROCEDURE cmlAddCoordinatesSP, cmlAddCoordinatesDP
+  END INTERFACE
+
+  INTERFACE cmlAddCrystal
+     MODULE PROCEDURE cmlAddCrystalSP, cmlAddCrystalDP
+  END INTERFACE
+
+  INTERFACE cmlAddAngle
+     MODULE PROCEDURE cmlAddAngleSP, cmlAddAngleDP
+  END INTERFACE
+
+  INTERFACE cmlAddLength
+     MODULE PROCEDURE cmlAddLengthSP, cmlAddLengthDP
+  END INTERFACE
+
+  INTERFACE cmlAddEigenvalue
+     MODULE PROCEDURE cmlAddEigenvalueSP, cmlAddEigenvalueDP
+  END INTERFACE
+
+  INTERFACE cmlAddMolecule
+     MODULE PROCEDURE cmlAddMoleculeSP, cmlAddMoleculeDP, cmlAddMolecule3SP, &
+                      cmlAddMolecule3DP
+  END INTERFACE
+
+! CMLComa
+  INTERFACE cmlAddLattice
+     MODULE PROCEDURE cmlAddLatticeSP, cmlAddLatticeDP
+  END INTERFACE
+
+  INTERFACE cmlAddLatticeVector
+     MODULE PROCEDURE cmlAddLatticeVectorSP, cmlAddLatticeVectorDP
+  END INTERFACE
+
+  INTERFACE cmlAddProperty
+     MODULE PROCEDURE &
+          cmlAddPropScalarDP, cmlAddPropScalarSP, cmlAddPropScalarI, & 
+          cmlAddPropMatrixDP, cmlAddPropMatrixSP, cmlAddPropMatrixI, &
+          cmlAddPropArrayDP,  cmlAddPropArraySP,  cmlAddPropArrayI
+  END INTERFACE
+
+  INTERFACE cmlAddParameter
+     MODULE PROCEDURE &
+        cmlAddParameterCH, cmlAddParameterI, &
+        cmlAddParameterSP, cmlAddParameterDP, &
+        cmlAddParameterLG
+  END INTERFACE
+
+
+CONTAINS
+
+  ! =================================================
+  ! convenience CML routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! writes a propertyList start Tag to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropertyList(xf, id, title, conv, dictref, ref, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: role
+    
+    call xml_NewElement(xf, 'propertyList')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    
+  END SUBROUTINE cmlAddPropertyList
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarDP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv))    call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref))    call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+
+  END SUBROUTINE cmlAddPropScalarDP
+
+  ! -------------------------------------------------
+  ! 2. writes a Scalar SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropScalarSP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarSP
+  
+  ! -------------------------------------------------
+  ! 3. writes a Scalar integer property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarI(xf, property, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarI
+
+  ! -------------------------------------------------
+  ! 4. writes an Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixDP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=dp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixDP
+
+  ! -------------------------------------------------
+  ! 5. writes an SP Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixSP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=sp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf,matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 6. writes an Integer matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixI(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+
+    integer, intent(in)                    :: nrows
+    integer, intent(in)                    :: ncols
+    integer, intent(in), optional          :: dim
+    integer, intent(in)                    :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(conv)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixI
+
+
+  ! -------------------------------------------------
+  ! 7. writes an Array DP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayDP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayDP
+
+  ! -------------------------------------------------
+  ! 8. writes an Array SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArraySP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArraySP
+
+  ! -------------------------------------------------
+  ! 9. writes an Array integer property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayI(xf, property, nvalue, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf, array=property, nvalue=nvalue, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayI
+
+  !------------------------------------------------------------
+  ! END OF PROPERTIES 
+  !------------------------------------------------------------
+
+
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddMoleculeDP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms             ! number of atoms
+    real(kind=dp), intent(in)               :: coords(3, natoms)  ! atomic coordinates
+    character(len=*), intent(in)           :: elements(natoms)   ! chemical element types
+    character(len=*), intent(in), optional :: id                 ! id
+    character(len=*), intent(in), optional :: title              ! the title
+    character(len=*), intent(in), optional :: dictref            ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt                ! format for coords
+    character(len=*), intent(in), optional :: style              ! type of coordinates 
+
+    ! 'x3' for Cartesians, 
+    ! 'xFrac' for fractionals
+    ! default => cartesians
+
+    ! Internal Variables
+    character(len=6) :: id1, id0
+    character(len=10):: formt, stylei
+    integer          :: i
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, coords(1, i), coords (2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMoleculeDP
+
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMoleculeSP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    real(kind=sp), intent(in)               :: coords(3, *)    ! atomic coordinates
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Flush on entry and exit
+    character(len=6) :: id1, id0
+    integer          :: i
+    character(len=10):: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+    
+  END SUBROUTINE cmlAddMoleculeSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3DP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=dp), intent(in)               :: x(*)
+    real(kind=dp), intent(in)               :: y(*)
+    real(kind=dp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = trim(style)
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf=xf, name='molecule', id=id, title=title, dictref=dictref)
+    call xml_NewElement(xf, 'atomArray')
+
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (trim(stylei) .eq. 'x3') then
+          call CMLATX39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, x(i), y(i), z(i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMolecule3DP
+  
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3SP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    ! 10 Arguments
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=sp), intent(in)               :: x(*)
+    real(kind=sp), intent(in)               :: y(*)
+    real(kind=sp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)      ! chemical element types
+    character(len=*), intent(in), optional :: id               ! id
+    character(len=*), intent(in), optional :: title            ! the title
+    character(len=*), intent(in), optional :: dictref          ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt              ! format for coords
+    character(len=*), intent(in), optional :: style            ! type of coordinates ('x3' for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Internal variables
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call xml_NewElement(xf, 'molecule')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'title', title)
+    call xml_AddAttribute(xf, 'dictref', dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, x(i), y(i), z(i), formt)
+       endif
+           call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+
+  END SUBROUTINE cmlAddMolecule3SP
+  
+  ! -------------------------------------------------
+  ! writes an <atom> start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddAtom(xf, elem, id, charge, hCount, occupancy, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in), optional           :: charge     ! formalCharge
+    integer, intent(in), optional           :: hCount     ! hydrogenCount
+    real(kind=sp), intent(in), optional      :: occupancy  ! hydrogenCount
+    character(len=*), intent(in), optional  :: elem       ! chemical element name
+    character(len=*), intent(in), optional  :: id         ! atom id
+    character(len=*), intent(in), optional  :: fmt        ! format
+
+    ! internal Variable
+    character(len=10):: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'atom')
+    if (present(elem))      call xml_AddAttribute(xf, 'elementType', elem)
+    if (present(id))        call xml_AddAttribute(xf, 'id', id)
+    if (present(charge))    call xml_AddAttribute(xf, 'formalCharge', str(charge))
+    if (present(hCount))    call xml_AddAttribute(xf, 'hydrogenCount', str(hCount))
+    if (present(occupancy)) call xml_AddAttribute(xf, 'occupancy', str(occupancy,formt))
+
+  END SUBROUTINE cmlAddAtom
+  
+  
+  ! -------------------------------------------------
+  ! 1. append SP coordinates to atom tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddCoordinatesSP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: x, y
+    real(kind=sp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9SP(xf, x, y, z, formt)
+    elseif (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9SP(xf, x, y, formt)           
+    endif
+
+  END SUBROUTINE cmlAddCoordinatesSP
+
+  ! -------------------------------------------------
+  ! 2. append DP coordinates to atom tag
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCoordinatesDP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf 
+    real(kind=dp), intent(in)               :: x, y
+    real(kind=dp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+    
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+    
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9DP(xf, x, y, z, formt)
+    else if (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9DP(xf, x, y, formt)           
+    endif
+    
+  END SUBROUTINE cmlAddCoordinatesDP
+
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthDP(xf, length, id, atomRef1, atomRef2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: length     ! length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9DP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthDP
+
+  ! -------------------------------------------------
+  ! 2. writes a SP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthSP(xf, length, id, atomRef1, atomRef2, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: length     ! the length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9SP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthSP
+
+
+  ! -------------------------------------------------
+  ! 1. writes an DP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleDP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleDP
+
+  ! -------------------------------------------------
+  ! 2. writes an SP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleSP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddTorsionDP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionDP
+  
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddTorsionSP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an SP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeSP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+    call xml_EndElement(xf, 'latticeVector')
+    enddo
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeSP
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes DP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeDP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+       call xml_EndElement(xf, 'latticeVector')
+    enddo
+    
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeDP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP Lattice Vector element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLatticeVectorDP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(periodic)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorDP
+
+
+  ! -------------------------------------------------
+  ! 2. creates a SP Lattice Vector element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeVectorSP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       ! should this be optional
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(units)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorSP
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalDP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: a, b, c      ! cell parameters
+    real(kind=dp), intent(in)               :: alpha        ! alpha cell parameter
+    real(kind=dp), intent(in)               :: beta         ! beta cell parameter
+    real(kind=dp), intent(in)               :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (default = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (default = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) ::  lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = 'units:angstrom'
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = 'units:degree'
+    endif
+
+    call stmAddStartTag(xf=xf, name='crystal', id=id, title=title, dictref=dictref)
+    call stmAddScalar(xf=xf, value=a, title='a', dictref='cml:a', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=b, title='b', dictref='cml:b', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=c, title='c', dictref='cml:c', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=alpha, title='alpha', dictref='cml:alpha', units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=beta,  title='beta',  dictref='cml:beta',  units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=gamma, title='gamma', dictref='cml:gamma', units=aunits, fmt=formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalDP
+
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalSP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: a, b, c      ! cell parameters
+    real(kind=sp), intent(in)     :: alpha        ! alpha cell parameter
+    real(kind=sp), intent(in)     :: beta         ! beta cell parameter
+    real(kind=sp), intent(in)     :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (' ' = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (' ' = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) :: lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = U_ANGSTR
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = U_DEGREE
+    endif
+
+    call stmAddStartTag(xf, 'crystal', id, title, dictref)
+    call stmAddScalar(xf, a, ' ', 'a', 'cml:a', lunits, formt)
+    call stmAddScalar(xf, b, ' ', 'b', 'cml:b', lunits, formt)
+    call stmAddScalar(xf, c, ' ', 'c', 'cml:c', lunits, formt)
+    call stmAddScalar(xf, alpha, ' ', 'alpha', 'cml:alpha', aunits, formt)
+    call stmAddScalar(xf, beta, ' ', 'beta', 'cml:beta', aunits, formt)
+    call stmAddScalar(xf, gamma, ' ', 'gamma', 'cml:gamma', aunits, formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. creates and writes an DP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueDP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=dp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=dp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueDP
+
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueSP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=sp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=sp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueSP
+
+
+  SUBROUTINE cmlAddMetadata(xf, name, content, conv)
+    
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: name
+    character(len=*) :: content
+    character(len=*), optional :: conv
+    
+    call xml_NewElement(xf, 'metadata')
+    call xml_AddAttribute(xf, 'name', name)
+    call xml_AddAttribute(xf, 'content', content)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    call xml_EndElement(xf, 'metadata')
+
+  END SUBROUTINE cmlAddMetadata
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an Char <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterCh(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, value)
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', value)
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERCH
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterSP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value,formt))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERSP
+
+
+  ! -------------------------------------------------
+  ! 3. creates and writes an DP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterDP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERDP
+
+
+  ! -------------------------------------------------
+  ! 4. creates and writes an Integer <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterI(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERI
+
+  SUBROUTINE cmlAddParameterLG(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    logical      :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERLG
+
+
+
+! =================================================
+! basic CML routines
+! =================================================
+
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyz3 to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZ39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39DP
+
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyz3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZ39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39SP
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyzFrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZFRACT9DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZFRACT9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyzFrac to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZFRACT9SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(y)//' '//trim(z))
+
+  END SUBROUTINE CMLATXYZFRACT9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP xFract, yFract, zFract to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXF9DP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: xFract, yFract, zFract ! coordinates
+    character(len=*), intent(in) :: fmt                    ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9DP
+  
+  ! -------------------------------------------------
+  ! 2. adds SP xfrac, yFractractrac, zFractrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXF9SP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: xFract, yFract, zFract   ! fractional coordinates
+    character(len=*) :: fmt                      ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9DP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                   !!! AG****
+
+  END SUBROUTINE CMLATXY9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9SP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                      !!AG***
+
+  END SUBROUTINE CMLATXY9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <length> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLLEN9DP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=dp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9DP
+  
+  ! -------------------------------------------------
+  ! 2. creates a SP <length> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLLEN9SP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=sp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=dp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=sp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=dp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=sp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9SP
+
+end module m_cmlw
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/cml/m_stmw.f90	(revision 3437)
@@ -0,0 +1,875 @@
+module m_stmw
+
+  use flib_wxml
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+!  TYPE(xmlf_t), save,  :: xf
+
+  PUBLIC :: stmAddScalar
+  PUBLIC :: stmAddArray
+  PUBLIC :: stmAddMatrix
+  PUBLIC :: stmAddTriangle
+  PUBLIC :: stmAddStartTag
+
+  INTERFACE stmAddScalar
+     MODULE PROCEDURE stmAddString, stmAddInteger, stmAddFloatSP, stmAddFloatDP
+  END INTERFACE
+
+  INTERFACE stmAddArray
+     MODULE PROCEDURE stmAddFloatArraySP, stmAddFloatArrayDP, stmAddStringArray, &
+                      stmAddIntegerArray
+  END INTERFACE
+
+  INTERFACE stmAddMatrix
+     MODULE PROCEDURE stmAddFloatMatrixSP, stmAddFloatMatrixDP, stmAddIntegerMatrix
+  END INTERFACE
+
+  INTERFACE stmAddTriangle
+     MODULE PROCEDURE stmAddTriangleSP, stmAddTriangleDP
+  END INTERFACE
+
+ 
+CONTAINS
+  
+  
+  ! =================================================
+  ! STMML convenience routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! create STMML start tag in xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE stmAddStartTag(xf, name, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: name                   ! the element name
+    character(len=*), intent(in), optional :: id           ! the element id; if whitespace, is omitted
+    character(len=*), intent(in), optional :: title        ! the title; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+!    call XMLCHKN9(name)
+    call xml_NewElement(xf, name)
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+  END SUBROUTINE stmAddStartTag
+
+
+  ! -------------------------------------------------
+  ! outputs STMML scalar in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddString(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: value         ! the value to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+    ! Internal variables
+    character(len=20) :: temp
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, ' '//value)
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddString
+
+
+  ! -------------------------------------------------
+  ! outputs STMML integer in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddInteger(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: value                           ! the value to be output
+    character(len=*), intent(in), optional :: id           ! the id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units (default = none)
+
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddInteger
+
+
+  ! -------------------------------------------------
+  ! 1. create an STMML <scalar> DP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatDP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Vaiable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatDP
+
+  ! -------------------------------------------------
+  ! 2. create an STMML <scalar> SP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatSP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: units        ! units (' ' = none)
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', title)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatSP
+
+
+  ! -------------------------------------------------
+  ! outputs string array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddStringArray(xf, nvalue, array, id, title, dictref, type, delim, ref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    character(len=*), intent(in)           :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: type          ! the dataType
+    character(len=*), intent(in), optional :: delim         ! delimiter
+    character(len=*), intent(in), optional :: ref           ! delimiter
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    character(len=1) :: delim1
+    integer          :: i
+
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'type', type)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+    call xml_AddPcdata(xf, array(1))
+    do i = 2, nvalue
+       if (delim1 .eq. ' ') then
+          call xml_AddPcdata(xf, ' '//array(i))
+       else
+          call xml_AddPcdata(xf, delim1//array(i))
+       endif
+    enddo
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddStringArray
+
+
+  ! -------------------------------------------------
+  ! outputs integer array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerArray(xf, nvalue, array, id, title, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! the number of values to be output
+    integer, intent(in)                    :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    integer          :: i
+
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+
+    call xml_AddPcdata(xf, str(array(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(array(i)))
+    enddo
+    call xml_EndElement(xf, 'array')
+    
+  END SUBROUTINE stmAddIntegerArray
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArrayDP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! 
+    character(len=*), intent(in), optional :: fmt           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9DP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArrayDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArraySP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt           ! the output format
+    character(len=*), intent(in), optional :: ref           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArraySP
+
+
+  ! -------------------------------------------------
+  ! outputs integer matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerMatrix(xf, nrows, ncols, dim, matrix, id, title, dictref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nrows         ! the number of rows to be output
+    integer, intent(in)                    :: ncols         ! the number of rows to be output
+    integer, intent(in)                    :: dim           ! the range of the fastest index
+    integer, intent(in)                    :: matrix(nrows,ncols) ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit
+    integer ::  i, j
+
+
+
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+
+!
+!   Try addArray...
+!
+    do i = 1, ncols
+       do j = 1, nrows
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddIntegerMatrix
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixDP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols                ! the number of cols to be output
+    integer, intent(in)                    :: nrows                ! the number of rows to be output
+    integer, intent(in)                    :: dim                  ! the range of the fastest index
+    real(kind=dp), intent(in)               :: matrix(ncols,nrows)  ! the values to be output
+    character(len=*), intent(in), optional :: id                   ! the id
+    character(len=*), intent(in), optional :: title                ! the title
+    character(len=*), intent(in), optional :: dictref              ! the dictionary reference
+    character(len=*), intent(in), optional :: units                ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                  ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !-------------
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    !-------------
+    do i = 1, nrows
+       do j = 1, ncols
+          !              write(*,*) ">>> 1", i, j
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixSP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols               ! the number of cols to be output
+    integer, intent(in)                    :: nrows               ! the number of rows to be output
+    integer, intent(in)                    :: dim                 ! the range of the fastest index
+    real(kind=sp), intent(in)               :: matrix(ncols,nrows) ! the values to be output
+    character(len=*), intent(in), optional :: id                  ! the id
+    character(len=*), intent(in), optional :: title               ! the title
+    character(len=*), intent(in), optional :: dictref             ! the dictionary reference
+    character(len=*), intent(in), optional :: units               ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                 ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    do i = 1, nrows
+       do j = 1, ncols
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleDP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9DP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleSP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9SP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleSP
+
+
+  ! -------------------------------------------------
+  ! outputs fatal error message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmErrorMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'fatal')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmErrorMessage
+
+
+  ! -------------------------------------------------
+  ! outputs informational message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmInfoMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'warning')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmInfoMessage
+
+
+  ! -------------------------------------------------
+  ! outputs warning message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmWarningMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'info')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmWarningMessage
+
+
+
+  ! =================================================
+  ! basic STMML routines
+  ! =================================================
+
+
+  ! -------------------------------------------------
+  ! creates STMML <scalar> string
+  ! -------------------------------------------------
+
+  SUBROUTINE STMSCAS9(xf, value, id, title, dictref, type)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: value                 ! the value to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: type        ! the data type (default 'xsd:string')
+
+    ! Internal variables
+    character(len=20) :: temp
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'dataType', type)
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, value)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE STMSCAS9
+
+
+
+  ! -------------------------------------------------
+  ! output start tag for an STMML array
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARST9(xf, nvalue, id, title, dictref, typunt, tuval, delim)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: typunt      ! 'type' (for strings) or 'unit' (for numeric)
+    character(len=*), intent(in), optional :: tuval       ! data type (default 'xsd:string') or units (' ' = none)
+    character(len=*), intent(in), optional :: delim       ! the delimiter (default ' ')
+
+    ! Internal Variables
+    character(len=1) :: delim1
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(tuval))   call xml_AddAttribute(xf, 'type', tuval)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE STMARST9
+
+
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARF9SP(xf, nvalue, arrf, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    real(kind=sp), intent(in)               :: arrf(*)     ! the values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: units       ! units (' ' = none)
+    character(len=*)                       :: fmt         ! the output format
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, arrf, fmt)
+    call xml_NewElement(xf, 'scalar')
+
+  END SUBROUTINE STMARF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs content of DP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9DP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: nvalue     ! the number of values to be output
+    real(kind=dp), intent(in)     :: arrf(*)    ! the values to be output
+    character(len=*), intent(in) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9DP
+
+
+  ! -------------------------------------------------
+  ! 2. outputs content of SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9SP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer          :: nvalue     ! the number of values to be output
+    real(kind=sp)     :: arrf(*)    ! the values to be output
+    character(len=*) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9SP
+
+end module m_stmw
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/flib_dom.f90	(revision 3437)
@@ -0,0 +1,17 @@
+module flib_dom
+
+  use m_dom_types
+  use m_dom_namednodemap
+  use m_dom_nodelist
+  use m_dom_attribute
+  use m_dom_document
+  use m_dom_node
+  use m_dom_element
+  use m_dom_parse
+  use m_dom_utils
+
+  use m_strings
+
+  public
+
+end module flib_dom
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_attribute.f90	(revision 3437)
@@ -0,0 +1,86 @@
+module m_dom_attribute
+
+use m_dom_types
+use m_dom_node
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR ATTRIBUTE NODES
+  !------------------------------------------------------- 
+
+  public :: getName
+  public :: getValue
+  public :: setValue
+
+CONTAINS
+
+  function getName(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getName
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getName = attribute%nodeName
+    else
+       getName = ''
+    endif
+
+  end function getName
+
+  !-----------------------------------------------------------
+
+  function getValue(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getValue
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getValue = attribute%nodeValue
+    else
+       getValue = ''
+    endif
+
+  end function getValue
+
+  !-----------------------------------------------------------
+
+  subroutine setValue(attribute, value)
+
+    character(len=*), intent(in) :: value
+    type(fnode), pointer  :: attribute
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       call setNodeValue(attribute,value)
+    endif
+
+  end subroutine setValue
+
+  !-----------------------------------------------------------
+
+
+!!! NB Is this a good idea?
+!!! NB pure functions have no side effects
+
+  pure function attr_name_len(attribute)
+    type(fnode), intent(in) :: attribute
+    integer :: attr_name_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_name_len = len_trim(attribute % nodeName)
+    else
+       attr_name_len = 0
+    end if
+  end function attr_name_len
+  
+  pure function attr_val_len(attribute)   
+    type(fnode), intent(in) :: attribute
+    integer :: attr_val_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_val_len = len_trim(attribute % nodeValue)
+    else
+       attr_val_len = 0
+    end if
+  end function attr_val_len
+
+
+end module m_dom_attribute
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_debug.f90	(revision 3437)
@@ -0,0 +1,5 @@
+module m_dom_debug
+
+  logical, save, public :: dom_debug = .false.
+
+end module m_dom_debug
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_document.f90	(revision 3437)
@@ -0,0 +1,113 @@
+module m_dom_document
+
+use m_dom_types
+use m_strings
+
+private
+
+  !-------------------------------------------------------  
+  ! METHODS FOR DOCUMENT NODES
+  !-------------------------------------------------------   
+  public :: createDocumentNode
+  public :: createDocumentFragment
+  public :: createTextNode
+  public :: createAttribute
+  public :: createElement
+  public :: createComment
+  public :: createCdataSection
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR DOCUMENT NODES
+  !-----------------------------------------------------------
+
+  function createDocumentNode()
+
+    type(fnode), pointer :: createDocumentNode
+    
+    createDocumentNode => createNode()
+    createDocumentNode % nodeType = DOCUMENT_NODE
+    createDocumentNode % nodeName = "#document"
+    
+  end function createDocumentNode
+!-------------------------------------------------------------------
+  function createDocumentFragment()
+
+    type(fnode), pointer :: createDocumentFragment
+    
+    createDocumentFragment => createNode()
+    createDocumentFragment % nodeType = DOCUMENT_FRAGMENT_NODE
+    createDocumentFragment % nodeName = "#document-fragment"
+    
+  end function createDocumentFragment
+!-------------------------------------------------------------------
+  function createTextNode(data)
+
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createTextNode
+    
+    createTextNode => createNode()
+    createTextNode % nodeType = TEXT_NODE
+    createTextNode % nodeName = "#text"
+    createTextNode % nodeValue = data  ! NB need to split this string 
+                                       ! across several nodes 
+    
+  end function createTextNode
+
+  !-----------------------------------------------------------
+
+  function createAttribute(name)
+    
+    character(len=*), intent(in) :: name
+    type(fnode), pointer :: createAttribute
+  
+    createAttribute => createNode()
+    createAttribute % nodeName = name
+    createAttribute % nodeType = ATTRIBUTE_NODE
+  
+  end function createAttribute
+
+  !-----------------------------------------------------------
+
+  function createElement(tagName)
+    
+    character(len=*), intent(in) :: tagName
+    type(fnode), pointer :: createElement
+  
+    createElement => createNode()
+    createElement % nodeName = tagName
+    createElement % nodeType = ELEMENT_NODE
+  
+  end function createElement
+
+  !-----------------------------------------------------------
+
+  function createComment(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createComment
+  
+    createComment => createNode()
+    createComment % nodeName = "#comment"
+    createComment % nodeValue = data
+    createComment % nodeType = COMMENT_NODE
+  
+  end function createComment
+
+  !-----------------------------------------------------------
+
+  function createCdataSection(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createCdataSection
+  
+    createCdataSection => createNode()
+    createCdataSection % nodeName = "#cdata-section"
+    createCdataSection % nodeValue = data
+    createCdataSection % nodeType = CDATA_SECTION_NODE
+  
+  end function createCdataSection
+
+  
+end module m_dom_document
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_element.f90	(revision 3437)
@@ -0,0 +1,242 @@
+module m_dom_element
+
+use m_dom_types
+use m_dom_namednodemap
+use m_dom_nodelist
+use m_dom_attribute
+use m_dom_document
+use m_dom_debug
+use m_dom_node
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR ELEMENT NODES
+  !-------------------------------------------------------   
+  public :: getTagName
+  public :: getElementsByTagName
+  public :: getAttribute
+  public :: getAttributeNode
+  public :: setAttribute
+  public :: setAttributeNode
+  public :: removeAttribute
+  public :: normalize       !--- combines adjacent text nodes ---!
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  !  METHODS FOR ELEMENT NODES
+  !-----------------------------------------------------------
+  function getTagName(element)
+
+    type(fnode), intent(in) :: element   
+    type(string)            :: getTagName
+
+    if (element % nodeType == ELEMENT_NODE) then
+       getTagName = element % nodeName 
+    else
+       getTagName = ''
+    endif
+
+  end function getTagName
+
+  !-----------------------------------------------------------
+  function getElementsByTagName(element, tag) result(nodelist)
+    type(fnode), pointer         :: element
+    character(len=*), intent(in) :: tag
+    type(fnodeList), pointer     :: nodelist 
+
+    type(fnode), pointer        :: np
+
+    nodelist => null()
+
+    np => element
+    if (dom_debug) print *, "Going into search for tag: ", trim(tag)
+    call search(np)
+
+    CONTAINS
+
+    recursive subroutine search(np)
+    type(fnode), pointer        :: np
+
+    type(string)                :: name
+
+    !
+    ! Could replace the calls to helper methods by direct lookups of node 
+    ! components to make it faster.
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(DOCUMENT_NODE) 
+             ! special case ... search its children 
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+             ! will exit for lack of siblings
+          case(ELEMENT_NODE)
+
+             name = getNodeName(np)
+             if (dom_debug) print *, "exploring node: ", char(name)
+             if ((tag == "*") .or. (tag == name)) then
+                call append(nodelist,np)
+                if (dom_debug) print *, "found match ", nodelist%length
+             endif
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+
+          case default
+             
+             ! do nothing
+
+        end select
+
+        if (associated(np,element)) exit  ! no siblings of element...
+        np => getNextSibling(np)
+
+     enddo
+    
+    end subroutine search
+
+  end function getElementsByTagName
+
+  !-----------------------------------------------------------
+
+  function getAttribute(element, name)
+    
+    type(fnode), intent(in) :: element
+    character(len=*), intent(in) :: name
+    type(string)                 :: getAttribute
+
+    type(fnode), pointer :: nn
+
+    getAttribute = ""  ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    nn => getNamedItem(element%attributes,name)
+    if (.not. associated(nn)) RETURN
+    
+    getAttribute = nn%nodeValue
+
+        
+  end function getAttribute
+
+  !-----------------------------------------------------------
+
+  function getAttributeNode(element, name)
+    
+    type(fnode), intent(in) :: element
+    type(fnode), pointer    :: getAttributeNode
+    character(len=*), intent(in) :: name
+
+    getAttributeNode => null()     ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    getAttributeNode => getNamedItem(element%attributes,name)
+
+  end function getAttributeNode
+  
+  !-----------------------------------------------------------
+
+  subroutine setAttributeNode(element, newattr)
+    type(fnode), pointer :: element
+    type(fnode), pointer :: newattr
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) then
+       if (dom_debug) print *, "not an element node in setAttributeNode..."
+       RETURN
+    endif
+
+    dummy => setNamedItem(element%attributes,newattr)
+     
+  end subroutine setAttributeNode
+
+!-------------------------------------------------------------------
+  subroutine setAttribute(element, name, value)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+    character(len=*), intent(in) :: value
+
+    type(fnode), pointer      :: newattr
+
+    newattr => createAttribute(name)
+    call setValue(newattr,value)
+    call setAttributeNode(element,newattr)
+
+  end subroutine setAttribute
+
+  !-----------------------------------------------------------
+
+  subroutine removeAttribute(element, name)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    if (.not. associated(element%attributes)) RETURN
+
+    dummy => removeNamedItem(element%attributes,name)
+     
+  end subroutine removeAttribute
+
+  !-----------------------------------------------------------
+  recursive subroutine normalize(element)
+    type(fnode), pointer         :: element
+
+    type(fnode), pointer        :: np, ghost
+    logical                     :: first
+
+    type(fnode), pointer        :: head
+
+    first = .true.  ! next Text node will be first
+
+    if (dom_debug) print *, "Normalizing: ", trim(element%nodeName)
+    np => element%firstChild
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(TEXT_NODE) 
+             if (first) then
+                if (dom_debug) print *, "normalize: found first in chain"
+                head => np
+                first = .false.
+                np => getNextSibling(np)
+             else                    ! a contiguous text node
+                if (dom_debug) print *, "normalize: found second in chain"
+                head%nodeValue = head%nodeValue // np%nodeValue
+                head%nextSibling => np%nextSibling
+                if (associated(np,np%parentNode%lastChild)) then
+                   np%parentNode%lastChild => head
+                   head%nextSibling => null()
+                else
+                   np%nextSibling%previousSibling => head
+                endif
+                ghost => np
+                np => getNextSibling(np)
+                call destroyNode(ghost)
+             endif
+
+          case(ELEMENT_NODE)
+
+             first = .true.
+             if (dom_debug) print *, "element sibling: ", trim(np%nodeName)
+             if (hasChildNodes(np)) call normalize(np)
+             np => getNextSibling(np)
+
+          case default
+             
+             ! do nothing, just mark that we break the chain of text nodes
+             if (dom_debug) print *, "other sibling: ", trim(np%nodeName)
+             first = .true.
+             np => getNextSibling(np)
+
+        end select
+
+     enddo
+
+    end subroutine normalize
+
+
+end module m_dom_element
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_error.f90	(revision 3437)
@@ -0,0 +1,35 @@
+module m_dom_error
+
+  !-------------------------------------------------------
+  ! EXCEPTION CODES
+  !-------------------------------------------------------
+  integer, parameter, public :: INDEX_SIZE_ERR              = 1
+  integer, parameter, public :: DOMSTRING_SIZE_ERR          = 2
+  integer, parameter, public :: HIERARCHY_REQUEST_ERR       = 3
+  integer, parameter, public :: WRONG_DOCUMENT_ERR          = 4
+  integer, parameter, public :: INVALID_CHARACTER_ERR       = 5
+  integer, parameter, public :: NO_DATA_ALLOWED_ERR         = 6
+  integer, parameter, public :: NO_MODIFICATION_ALLOWED_ERR = 7
+  integer, parameter, public :: NOT_FOUND_ERR               = 8
+  integer, parameter, public :: NOT_SUPPORTED_ERR           = 9
+  integer, parameter, public :: INUSE_ATTRIBUTE_ERR         = 10
+  integer, parameter, public :: INVALID_STATE_ERR           = 11
+  integer, parameter, public :: SYNTAX_ERR                  = 12
+  integer, parameter, public :: INVALID_MODIFICATION_ERR    = 13
+  integer, parameter, public :: NAMESPACE_ERR               = 14
+  integer, parameter, public :: INVALID_ACCESS_ERR          = 15
+  integer, parameter, public :: VALIDATION_ERR              = 16
+  integer, parameter, public :: TYPE_MISMATCH_ERR           = 17
+
+CONTAINS
+
+  subroutine dom_error(name,code,msg)
+    character(len=*), intent(in) :: name, msg
+    integer, intent(in)          :: code
+
+    print *, "***ERROR***"
+    print *, "Routine ", trim(name), ":", trim(msg)
+    print *, 1.0 / sin(3.141592654)
+  end subroutine dom_error
+
+end module m_dom_error
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 3437)
@@ -0,0 +1,203 @@
+module m_dom_namednodemap
+!
+! This is basically a dictionary module, but written with the
+! DOM node structure in mind.
+!
+use m_dom_types
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR NAMEDNODEMAPS
+  !-------------------------------------------------------   
+  public :: getNamedItem
+  public :: setNamedItem
+  public :: removeNamedItem
+
+  public :: item
+  public :: getLength
+  public :: append
+
+  interface append
+     module procedure append_nnm
+  end interface
+
+  interface item
+     module procedure item_nnm
+  end interface 
+
+  interface getLength
+     module procedure getLength_nnm
+  end interface
+
+CONTAINS
+
+  function item_nnm(namedNodeMap, i)
+    
+    integer, intent(in)             :: i
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: item_nnm
+    
+    type(fnamedNode), pointer :: nnp
+
+    integer :: n
+
+    item_nnm => null()            ! In case there is no such item
+    if (.not. associated(namedNodeMap)) RETURN
+
+    nnp => namedNodeMap%head
+    n = -1
+    do 
+       if (.not. associated(nnp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nnm => nnp%node
+          exit
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function item_nnm
+
+  !----------------------------------------------------------- 
+  
+  function getLength_nnm(namedNodeMap)
+  
+    type(fnamedNodeMap), pointer :: namedNodeMap
+    integer :: getLength_nnm
+
+    getLength_nnm = 0
+    if (.not. associated(namedNodeMap)) return
+
+    getLength_nnm = namedNodeMap % length    
+    
+  end function getLength_nnm
+
+  !----------------------------------------------------------- 
+
+
+  subroutine append_nnm(nodeMap,node)
+    type(fnamednodeMap), pointer :: nodeMap
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeMap)) then
+       allocate(nodeMap)
+       nodeMap%length = 1
+       allocate(nodeMap%head)
+       nodeMap%head%name = node%nodeName
+       nodeMap%head%node => node
+       nodeMap%tail => nodeMap%head
+    else
+       allocate(nodeMap%tail%next)
+       nodeMap%tail%next%node => node
+       nodeMap%tail%next%name =  node%nodeName
+       nodeMap%tail => nodeMap%tail%next
+       nodeMap%length = nodeMap%length + 1
+    endif
+
+  end subroutine append_nnm
+
+  !----------------------------------------------------------- 
+
+  function getNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    character(len=*), intent(in)    :: name
+    type(fnode), pointer            :: getNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    getNamedItem => null()
+    if (.not. associated(namedNodeMap)) return 
+
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          getNamedItem => nnp%node
+          exit                 ! one or zero nodes with a given name
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function getNamedItem
+
+  
+  function setNamedItem(namedNodeMap, node)
+
+!!AG: Do we need to clone the node ?
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: node
+    type(fnode), pointer            :: setNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    if (.not. associated(namedNodeMap)) then
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+      
+    else
+
+       nnp => namedNodeMap%head
+       do while (associated(nnp)) 
+          if (nnp%name == node%nodeName) then
+             setNamedItem => nnp%node
+             nnp%node => node
+             setNamedItem => node
+             return
+          endif
+          nnp => nnp%next
+       enddo
+
+       !   If not found, insert it at the end of the linked list
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+    endif
+
+  end function setNamedItem
+
+!------------------------------------------------------------
+   function removeNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer   :: namedNodeMap
+    character(len=*), intent(in)   :: name
+    type(fnode), pointer           :: removeNamedItem
+
+    type(fnamedNode), pointer :: nnp, previous
+
+    removeNamedItem => null()
+    if (.not. associated(namedNodeMap)) return  
+
+    previous => null()
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          removeNamedItem => nnp%node
+          if (associated(nnp,namedNodeMap%head)) then
+             ! we remove the first fnamedNode in the chain...
+             namedNodeMap%head => nnp%next
+          else if (.not. associated(nnp%next)) then
+             ! we remove the last fnamedNode in the chain
+             previous%next => null()
+             namedNodeMap%tail => previous
+          else
+             ! we remove a link in the middle of the chain
+             previous%next => nnp%next
+          endif
+          namedNodeMap%length =  namedNodeMap%length - 1
+          call unstring(nnp%name)
+          deallocate(nnp)
+          EXIT                 ! one or zero nodes with a given name
+       endif
+       previous => nnp
+       nnp => nnp%next
+    enddo
+
+  end function removeNamedItem
+
+
+
+end module m_dom_namednodemap
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_node.f90	(revision 3437)
@@ -0,0 +1,560 @@
+module m_dom_node
+
+use m_dom_types
+use m_dom_nodelist
+use m_dom_namednodemap
+use m_dom_debug
+use m_dom_error
+
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR NODES
+  !-------------------------------------------------------   
+
+  public :: getNodeName
+  public :: getNodevalue	
+  public :: getNodeType
+  public :: hasChildNodes
+  public :: hasAttributes
+  public :: getParentNode
+  public :: getFirstChild
+  public :: getLastChild
+  public :: getNextSibling
+  public :: getPreviousSibling
+  public :: getOwnerDocument
+  public :: getAttributes
+  public :: getChildNodes
+  public :: setNodeValue
+  public :: appendChild
+  public :: removeChild
+  public :: replaceChild
+  public :: cloneNode  
+  public :: isSameNode
+  public :: insertBefore
+
+  private :: name_len, value_len
+
+CONTAINS
+
+  pure function name_len(node)
+    type(fnode), pointer :: node
+    integer :: name_len
+
+    name_len = len_trim(node % nodeName)
+
+  end function name_len
+
+  pure function value_len(node)
+    type(fnode), pointer :: node
+    integer :: value_len
+
+    value_len = len_trim(node % nodeValue)
+
+  end function value_len
+
+  !-----------------------------------------------------------
+  !  METHODS FOR NODES
+  !-----------------------------------------------------------
+  function getNodeName(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeName)) :: getNodeName
+    type(string)  :: getNodeName
+    if (.not. associated(node))  &
+               call dom_error("getNodeName",0,"Node not allocated")
+    getNodeName = node % nodeName
+
+  end function getNodeName
+
+  !-----------------------------------------------------------
+
+  function getNodeValue(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeValue)) :: getNodeValue
+    type(string)  :: getNodeValue
+
+    if (.not. associated(node))  &
+               call dom_error("getNodeValue",0,"Node not allocated")
+    getNodeValue = node % nodeValue
+
+  end function getNodeValue
+
+  !-----------------------------------------------------------
+
+  function getNodeType(node)
+
+    type(fnode), pointer :: node
+    integer :: getNodeType
+
+    if (.not. associated(node)) call dom_error("getNodeType",0,"Node not allocated")
+    getNodeType = node % nodeType
+
+  end function getNodeTYpe
+
+  !-----------------------------------------------------------
+
+  function hasChildNodes(node)
+
+    type(fnode), pointer :: node
+    logical :: hasChildNodes
+
+    if (.not. associated(node)) call dom_error("hasChildNodes",0,"Node not allocated")
+    hasChildNodes = associated(node % firstChild)
+
+  end function hasChildNodes
+
+  !-----------------------------------------------------------
+
+  function hasAttributes(node)
+
+    type(fnode), pointer    :: node
+    logical                 :: hasAttributes
+
+    hasAttributes = .false.
+    if (.not. associated(node)) call dom_error("hasAttributes",0,"Node not allocated")
+    if (node % nodeType /= ELEMENT_NODE) RETURN
+    if ( getLength(node%attributes) > 0) hasAttributes = .true.
+
+  end function hasAttributes
+
+  !-----------------------------------------------------------
+
+  function getParentNode(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getParentNode
+
+    if (.not. associated(node)) call dom_error("getParentNode",0,"Node not allocated")
+    getParentNode => node % parentNode
+    
+  end function getParentNode
+  
+  !-----------------------------------------------------------
+
+  function getFirstChild(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getFirstChild
+
+    if (.not. associated(node)) call dom_error("getFirstChild",0,"Node not allocated")
+    getFirstChild => node % firstChild
+
+  end function getFirstChild
+
+  !-----------------------------------------------------------
+
+  function getLastChild(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getLastChild
+
+    if (.not. associated(node)) call dom_error("getLastChild",0,"Node not allocated")
+    getLastChild => node % lastChild
+
+  end function getLastChild
+
+  !-----------------------------------------------------------
+
+  function getNextSibling(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getNextSibling
+
+    if (.not. associated(node)) call dom_error("getNextSibling",0,"Node not allocated")
+    getNextSibling => node % nextSibling
+
+  end function getNextSibling
+
+  !-----------------------------------------------------------
+
+  function getPreviousSibling(node)
+
+    type(fnode), pointer     :: node
+    type(fnode), pointer    :: getPreviousSibling
+
+    if (.not. associated(node)) call dom_error("getPreviousSibling",0,"Node not allocated")
+    getPreviousSibling => node % previousSibling
+
+  end function getPreviousSibling
+
+  !-----------------------------------------------------------
+
+  function getOwnerDocument(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getOwnerDocument
+
+    if (.not. associated(node)) call dom_error("getOwnerDocument",0,"Node not allocated")
+    getOwnerDocument => node % ownerDocument
+
+  end function getOwnerDocument
+
+  !----------------------------------------------------------- 
+
+  function getChildNodes(node) result(nodelist)
+    
+    type(fnode), pointer        :: node
+    type(fnodeList), pointer    :: nodelist      !!! NB nodeList
+
+    type(fnode), pointer        :: np
+
+    if (.not. associated(node)) call dom_error("getChildNodes",0,"Node not allocated")
+    nodelist => null()
+    np => node%firstChild
+    do 
+       if (.not. associated(np)) exit
+       call append(nodelist,np)
+       np => np%nextSibling
+    enddo
+
+  end function getChildNodes
+
+  !----------------------------------------------------------- 
+
+  function getAttributes(node)
+
+    type(fnode), pointer         :: node
+    type(fnamedNodeMap), pointer :: getAttributes       !!! NB namedNodeMap
+    
+    if (.not. associated(node))  &
+               call dom_error("getAttributes",0,"Node not allocated")
+    getAttributes => node % attributes
+
+  end function getAttributes
+
+  !----------------------------------------------------------- 
+
+  subroutine setNodeValue(node, value)
+
+    type(fnode), pointer :: node
+    character(len=*), intent(in) :: value
+    
+    if (.not. associated(node))  &
+               call dom_error("setNodeValue",0,"Node not allocated")
+
+    select case(node % nodeType)
+
+    case(ATTRIBUTE_NODE)
+       node % nodeValue = trim(value)    !!AG: use just value ??
+
+    case(COMMENT_NODE)
+       node % nodeValue = value
+
+    case(TEXT_NODE)
+       node % nodeValue = value
+
+    case(PROCESSING_INSTRUCTION_NODE)
+       node % nodeValue = value
+
+    case(CDATA_SECTION_NODE)
+       node % nodeValue = value
+
+    end select
+
+  end subroutine setNodeValue
+
+  !-----------------------------------------------------------
+  
+  function appendChild(node, newChild)
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: appendChild
+    
+    if (.not. associated(node))  & 
+               call dom_error("appendChild",0,"Node not allocated")
+
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("appendChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    if (.not.(associated(node % firstChild))) then
+       node % firstChild => newChild
+    else 
+       newChild % previousSibling   => node % lastChild
+       node % lastChild % nextSibling => newChild 
+    endif
+
+    node % lastChild               => newChild
+    newChild % parentNode          => node
+    newChild % ownerDocument       => node % ownerDocument
+    node%nc  = node%nc + 1
+
+    appendChild => newChild
+
+  end function appendChild
+
+  !-----------------------------------------------------------
+  
+  function removeChild(node, oldChild)
+
+    type(fnode), pointer :: removeChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: oldChild
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("removeChild",0,"Node not allocated")
+    np => node % firstChild
+
+    do while (associated(np))
+       if (associated(np, oldChild)) then   ! Two argument form 
+                                              !  of associated()
+          if (associated(np,node%firstChild)) then
+             node%firstChild => np%nextSibling
+             if (associated(np % nextSibling)) then
+                np%nextSibling % previousSibling => null()
+             else
+                node%lastChild => null()    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => np%previousSibling
+             np%previousSibling%nextSibling => null()
+          else
+             np % previousSibling % nextSibling => np % nextSibling
+             np % nextSibling % previousSibling => np % previousSibling
+          endif
+          node%nc = node%nc -1
+          np % previousSibling => null()    ! Are these necessary?
+          np % nextSibling => null()
+          np % parentNode => null()
+          removeChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("removeChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function removeChild
+
+ !-----------------------------------------------------------
+  
+  function replaceChild(node, newChild, oldChild)
+
+    type(fnode), pointer :: replaceChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: oldChild
+
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("replaceChild",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("replaceChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    np => node % firstChild
+
+    do while (associated(np))    
+       if (associated(np, oldChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+             if (associated(np % nextSibling)) then
+                oldChild%nextSibling % previousSibling => newChild
+             else
+                node%lastChild => newChild    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => newChild
+             oldChild%previousSibling%nextSibling => newChild
+          else
+             oldChild % previousSibling % nextSibling => newChild
+             oldChild % nextSibling % previousSibling => newChild
+          endif
+
+          newChild % parentNode      => oldChild % parentNode
+          newChild % nextSibling     => oldChild % nextSibling
+          newChild % previousSibling => oldChild % previousSibling
+          replaceChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("replaceChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function replaceChild
+
+  !-----------------------------------------------------------
+
+  function cloneNode(node, deep)             
+    type(fnode), pointer :: cloneNode
+    type(fnode), pointer :: node
+
+    logical, optional :: deep
+    logical           :: do_children
+
+    type(fnode), pointer :: original
+    type(fnode), pointer :: parent_clone
+    
+    if (.not. associated(node)) call dom_error("cloneNode",0,"Node not allocated")
+
+    do_children = .false.
+    if (present(deep)) then
+       do_children = deep
+    endif
+    
+    original => node             ! Keep node
+    cloneNode => null()
+    parent_clone => null()
+    call recursive_clone(original, cloneNode)
+    cloneNode%parentNode => null()     ! as per specs   , superfÃluous
+ 
+  Contains
+
+    recursive subroutine recursive_clone(original, cloneNode)
+      type(fnode), pointer :: original        ! node to clone
+      type(fnode), pointer :: cloneNode       ! new node
+
+      type(fnode), pointer :: np, clone
+      type(fnode), pointer :: previous_clone, attr, newattr
+      type(string)         :: name
+      logical :: first_sibling
+      integer :: i
+
+      np => original
+      previous_clone => null()
+      first_sibling = .true.
+      do 
+
+         ! Keep going across siblings
+         ! (2nd and lower levels only)
+
+         if (.not.(associated(np))) EXIT
+
+
+         !----------------------------------------------------!
+         clone => createNode()
+         if (first_sibling) then
+            cloneNode => clone       ! Rest of siblings are chained
+                                     ! automatically, but must not
+                                     ! be aliases of cloneNode !!
+            first_sibling = .false.
+         endif
+         clone % nodeName    = np % nodeName
+         name = np%nodeName
+         if (dom_debug) print *, "Cloning ", char(name)
+         clone % nodeValue   = np % nodeValue
+         clone % nodeType    = np % nodeType
+         clone % ownerDocument => np % ownerDocument
+         clone % parentNode  => parent_clone
+         !
+         ! always deep copy attributes, as per specs
+         ! Note that this will not work for "deep" attributes, with
+         ! hanging entity nodes, etc
+         if (associated(np % attributes)) then
+            do i = 0, getLength(np%attributes) - 1
+               attr => item(np%attributes,i)
+               newattr => createNode()
+               newattr%nodeName = getNodeName(attr)
+               newattr%nodeValue = getNodeValue(attr)
+               newattr%nodeType = ATTRIBUTE_NODE
+               call append(clone%attributes, newattr)
+            enddo
+         endif
+
+         ! Deal with first sibling
+         if (associated(previous_clone)) then
+            if (dom_debug) print *, "linking to previous sibling"
+            previous_clone%nextSibling => clone
+            clone%previousSibling => previous_clone
+         else
+            if (dom_debug) print *, "marking as first child of parent"
+            if (associated(parent_clone))  &
+                           parent_clone%firstChild => clone
+         endif
+
+         ! Deal with last sibling
+         if (.not. associated(np%nextSibling)) then
+            if (dom_debug) print *, "this is the last sibling"
+            if (associated(parent_clone)) then
+               if (dom_debug) print *, "marking as last child of parent"
+               parent_clone%lastChild => clone
+            endif
+         endif
+            
+         if (do_children .and. associated(np%firstChild)) then
+            parent_clone => clone
+            if (dom_debug) print *, ".... going for its children"
+            call recursive_clone(np%firstChild,clone%firstChild)
+            parent_clone => clone%parentNode
+         endif
+
+         if (associated(np,node)) then
+            if (dom_debug) print *, "No more siblings of ", char(name)
+            EXIT  ! no siblings of master node
+         endif
+         np => np % nextSibling
+         previous_clone => clone
+
+      enddo 
+
+    end subroutine recursive_clone
+
+  end function cloneNode
+
+  !-----------------------------------------------------------
+
+  function isSameNode(node1, node2)    ! DOM 3.0
+    type(fnode), pointer :: node1
+    type(fnode), pointer :: node2
+    logical :: isSameNode
+
+    isSameNode = associated(node1, node2)
+
+  end function isSameNode
+
+  !-----------------------------------------------------------
+
+  function insertBefore(node, newChild, refChild)
+    type(fnode), pointer :: insertBefore
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: refChild
+    type(fnode), pointer :: np
+
+    if (.not. associated(node)) call dom_error("insertBefore",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("insertBefore",HIERARCHY_REQUEST_ERR, &
+           "cannot insert node here")
+
+    if (.not.associated(refChild)) then
+       insertBefore => appendChild(node, newChild)
+       RETURN
+    endif
+
+    np => node % firstChild
+    do while (associated(np))
+       if (associated(np, refChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+          else
+             refChild%previousSibling%nextSibling => newChild
+          endif
+
+          refChild % previousSibling => newChild
+          newChild % nextSibling => refChild
+          newChild % parentNode => node
+          newChild % ownerDocument => refChild % ownerDocument
+          insertBefore => newChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("insertBefore",NOT_FOUND_ERR,"refChild not found")
+
+  end function insertBefore
+
+!----------------------------------------------------------------------
+
+end module m_dom_node
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_nodelist.f90	(revision 3437)
@@ -0,0 +1,89 @@
+module m_dom_nodelist
+
+use m_dom_types
+
+private
+
+public :: item
+public :: getLength
+public :: append
+
+interface append
+   module procedure append_nl
+end interface
+
+interface item
+   module procedure item_nl
+end interface
+
+interface getLength
+   module procedure getLength_nl
+end interface
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR NODELISTS
+  !-----------------------------------------------------------
+  function item_nl(nodeList, i)
+    
+    integer, intent(in)             :: i
+    type(fnodeList), pointer        :: nodeList
+    type(fnode), pointer            :: item_nl
+    
+    type(flistNode), pointer :: lp
+    integer :: n
+
+    item_nl => null()            ! In case there is no such item
+    if (.not. associated(nodeList)) RETURN
+
+    lp => nodeList%head
+    n = -1
+    do 
+       if (.not. associated(lp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nl => lp%node
+          exit
+       endif
+       lp => lp%next
+    enddo
+
+  end function item_nl
+
+  !----------------------------------------------------------- 
+
+  function getLength_nl(nodeList)
+    
+    type(fnodeList), pointer :: nodeList
+    integer                  :: getLength_nl
+
+    if (.not. associated(nodeList)) then
+       getLength_nl = 0
+    else
+       getLength_nl = nodeList % length
+    endif
+
+  end function getLength_nl
+
+  subroutine append_nl(nodeList,node)
+    type(fnodeList), pointer :: nodeList
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeList)) then
+       allocate(nodeList)
+       nodelist%length = 1
+       allocate(nodelist%head)
+       nodelist%head%node => node
+       nodelist%tail => nodelist%head
+    else
+       allocate(nodelist%tail%next)
+       nodelist%tail%next%node => node
+       nodelist%tail => nodelist%tail%next
+       nodelist%length = nodelist%length + 1
+    endif
+
+  end subroutine append_nl
+
+end module m_dom_nodelist
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_parse.f90	(revision 3437)
@@ -0,0 +1,152 @@
+module m_dom_parse
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+!  use m_dom_namednodemap
+  use m_dom_debug
+
+  use flib_sax
+
+  implicit none
+  
+  private
+
+  public :: parsefile
+
+  type(fnode), pointer, private, save  :: main
+  type(fnode), pointer, private, save  :: current
+
+
+CONTAINS
+
+  subroutine begin_element_handler(name,attrs)
+
+    character(len=*),   intent(in) :: name
+    type(dictionary_t), intent(in) :: attrs
+   
+    type(fnode), pointer :: temp
+    character(len=400)   :: attr_name, attr_value
+    integer              :: status
+    integer              :: i
+
+    if (dom_debug) print *, "Adding node for element: ", name
+
+    temp => createElement(name)
+    current => appendChild(current,temp)
+!
+!   Add attributes
+!
+    do i = 1, len(attrs)
+       call get_name(attrs, i, attr_name, status)
+       call get_value(attrs, attr_name, attr_value, status)
+       if (dom_debug) print *, "Adding attribute: ", &
+                       trim(attr_name), ":",trim(attr_value)
+       call setAttribute(current,attr_name,attr_value)
+    enddo
+
+  end subroutine begin_element_handler
+
+!---------------------------------------------------------
+
+  subroutine end_element_handler(name)
+    character(len=*), intent(in)     :: name
+
+!!AG for IBM    type(fnode), pointer :: np
+
+    if (dom_debug) print *, "End of element: ", name
+!!AG for IBM    np => getParentNode(current)
+!!AG for IBM    current => np
+    current => getParentNode(current)
+  end subroutine end_element_handler
+
+!---------------------------------------------------------
+
+  subroutine pcdata_chunk_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got PCDATA: |", chunk, "|"
+
+    temp => createTextNode(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine pcdata_chunk_handler
+
+!---------------------------------------------------------
+
+  subroutine comment_handler(comment)
+    character(len=*), intent(in) :: comment
+
+    type(fnode), pointer :: temp, dummy
+
+    if (dom_debug) print *, "Got COMMENT: |", comment, "|"
+
+    temp => createComment(comment)
+    dummy => appendChild(current,temp)
+
+  end subroutine comment_handler
+!---------------------------------------------------------
+  subroutine cdata_section_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got CDATA_SECTION: |", chunk, "|"
+
+    temp => createCdataSection(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine cdata_section_handler
+
+!***************************************************
+!   PUBLIC PROCEDURES
+!***************************************************
+
+
+  function parsefile(filename, verbose, sax_verbose)
+
+    character(len=*), intent(in) :: filename
+    logical, intent(in), optional :: verbose
+    logical, intent(in), optional :: sax_verbose
+
+    type(fnode), pointer :: parsefile
+
+    logical :: sax_debug = .false.
+
+    type(xml_t) :: fxml
+    integer :: iostat
+
+    if (present(verbose)) then
+       dom_debug = verbose
+    endif
+
+    if (present(sax_verbose)) then
+       sax_debug = sax_verbose
+    endif
+    
+    call open_xmlfile(filename, fxml, iostat)
+
+    PRINT *,'filename : ',filename
+    if (iostat /= 0) then
+       stop "Cannot open file."
+    endif
+
+    main => createDocumentNode()
+    current => main
+
+    call xml_parse(fxml,  &
+           begin_element_handler, end_element_handler, pcdata_chunk_handler, &
+           comment_handler, cdata_section_handler=cdata_section_handler, &
+           verbose = sax_debug)    
+    call close_xmlfile(fxml)
+
+    parsefile => main
+    if (dom_debug) print *, "Number of allocated nodes: ", getNumberofAllocatedNodes()
+
+  end function parsefile
+
+
+END MODULE m_dom_parse
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_types.f90	(revision 3437)
@@ -0,0 +1,195 @@
+Module m_dom_types
+
+  use m_strings
+
+  implicit none
+
+  private
+
+  !-------------------------------------------------------   
+  ! A GENERIC NODE
+  !-------------------------------------------------------   
+  type, public :: fnode
+     type(string)         :: nodeName    
+     type(string)         :: nodeValue   
+!!!     character(len=200)    :: nodeName  = ""
+!!!     character(len=200)    :: nodeValue = ""
+     integer              :: nc              = 0 
+     integer              :: nodeType        = 0
+     type(fnode), pointer :: parentNode      => null()
+     type(fnodeList), pointer :: childNodes  => null()  ! New
+     type(fnode), pointer :: firstChild      => null()
+     type(fnode), pointer :: lastChild       => null()
+     type(fnode), pointer :: previousSibling => null()
+     type(fnode), pointer :: nextSibling     => null()
+     type(fnode), pointer :: ownerDocument   => null()
+     type(fnamedNodeMap), pointer :: attributes => null()
+  end type fnode
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NAMEDNODEMAP  (dictionary)
+  !-----------------------------------------------------------
+
+  ! Linked list of name/node pairs, with overall length variable
+
+  type, public :: fnamedNode
+     type(string)                   :: name
+!!!     character(len=100)            :: name
+     type(fnode), pointer          :: node => null()
+     type(fnamedNode), pointer     :: next => null()
+  end type fnamedNode
+
+  type, public :: fnamedNodeMap
+     integer :: length = 0
+     type(fnamedNode), pointer  :: head => null()
+     type(fnamedNode), pointer  :: tail => null()
+  end type fnamedNodeMap
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NODELIST 
+  !-----------------------------------------------------------
+
+  type, public :: flistNode
+     type(fnode), pointer          :: node => null()
+     type(flistNode), pointer      :: next => null()
+  end type flistNode
+
+  type, public :: fnodeList
+     integer                      :: length = 0
+     type(flistNode), pointer     :: head => null()
+     type(flistNode), pointer     :: tail => null()
+  end type fnodeList
+
+!========================================================================
+  integer, save, private          :: allocated_nodes = 0
+!========================================================================
+
+  !-------------------------------------------------------   
+  ! NODETYPES
+  !-------------------------------------------------------   
+  integer, parameter, public :: ELEMENT_NODE                = 1
+  integer, parameter, public :: ATTRIBUTE_NODE              = 2
+  integer, parameter, public :: TEXT_NODE                   = 3
+  integer, parameter, public :: CDATA_SECTION_NODE          = 4
+  integer, parameter, public :: ENTITY_REFERENCE_NODE       = 5
+  integer, parameter, public :: ENTITY_NODE                 = 6
+  integer, parameter, public :: PROCESSING_INSTRUCTION_NODE = 7
+  integer, parameter, public :: COMMENT_NODE                = 8
+  integer, parameter, public :: DOCUMENT_NODE               = 9
+  integer, parameter, public :: DOCUMENT_TYPE_NODE          = 10
+  integer, parameter, public :: DOCUMENT_FRAGMENT_NODE      = 11
+  integer, parameter, public :: NOTATION_NODE               = 12
+
+  public :: node_class
+  public :: createNode
+  public :: destroyNode
+  public :: destroyNamedNodeMap
+  public :: destroyNodeList
+  public :: getNumberofAllocatedNodes
+
+CONTAINS
+
+  function getNumberofAllocatedNodes() result(n)
+    integer   :: n
+
+    n = allocated_nodes
+  end function getNumberofAllocatedNodes
+
+!--------------------------------------------------------------
+  function createNode() result(node)
+    type(fnode), pointer  :: node
+
+    allocate(node)
+    allocated_nodes = allocated_nodes + 1
+
+  end function createNode
+!--------------------------------------------------------------
+
+  function node_class(nodetype) result(class)
+    integer, intent(in) :: nodetype
+    character(len=10)  ::     class
+
+    select case(nodetype)
+    case(ELEMENT_NODE)
+       class = "element"
+    case(ATTRIBUTE_NODE)
+       class = "attribute"
+    case(TEXT_NODE)
+       class = "text"
+    case(COMMENT_NODE)
+       class = "comment"
+    case(DOCUMENT_NODE)
+       class = "document"
+    end select
+  end function node_class
+
+  subroutine destroyNamedNodeMap(nodemap)
+    type(fnamedNodeMap), pointer :: nodemap
+
+    type(fnamednode), pointer  :: nnp
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodemap)) return
+    nnp => nodemap%head
+    do while (associated(nnp))
+       call unstring(nnp%name)
+       ghost => nnp%node
+       nnp => nnp%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNamedNodeMap
+
+  subroutine destroyNodeList(nodelist)
+    type(fnodeList), pointer :: nodelist
+
+    type(flistnode), pointer   :: p
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodelist)) return
+    p => nodelist%head
+    do while (associated(p))
+       ghost => p%node
+       p => p%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNodeList
+
+  recursive subroutine destroyNode(node)
+    type(fnode), pointer  :: node
+    
+    type(fnode), pointer  :: np, ghost
+    
+    np => node
+    do while (associated(np))
+       if (associated(np%firstChild)) then
+          call destroyNode(np%firstChild)
+       endif
+       if (associated(np%attributes)) call destroyNamedNodeMap(np%attributes)
+       call unstring(np%nodeName)
+       call unstring(np%nodeValue)
+       if (associated(np%previousSibling)) & 
+                np%previousSibling%nextSibling => np%nextSibling
+       if (associated(np%nextSibling)) & 
+                np%nextSibling%previousSibling => np%previousSibling
+       if (associated(np%parentNode)) then
+          if (associated(np%parentNode%firstChild,np)) &
+               np%parentNode%firstChild => null()
+          if (associated(np%parentNode%lastChild,np)) &
+               np%parentNode%lastChild => null()
+       endif
+       if (associated(np,node)) then    
+          deallocate(np)
+          allocated_nodes = allocated_nodes - 1
+          EXIT                           ! do not destroy siblings
+       else
+          ghost => np
+          np => np%nextSibling
+          deallocate(ghost)
+          allocated_nodes = allocated_nodes - 1
+       endif
+    enddo
+    node => null()     ! superfluous ?
+  end subroutine destroyNode
+
+end module m_dom_types
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/dom/m_dom_utils.f90	(revision 3437)
@@ -0,0 +1,131 @@
+module m_dom_utils
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+  use m_dom_namednodemap
+  use m_dom_debug
+  use m_strings
+
+  use flib_wxml
+
+  public :: dumpTree
+  public :: xmlize
+
+  private
+
+CONTAINS
+
+  subroutine dumpTree(startNode)
+
+    type(fnode), pointer :: startNode   
+
+    character(len=50) :: indent = " "
+    integer           :: indent_level
+    type(string)      :: s
+
+    indent_level = 0
+
+    call dump2(startNode)
+
+  contains
+
+    recursive subroutine dump2(input)
+      type(fnode), pointer :: input
+      type(fnode), pointer :: temp     
+      temp => input
+      do while(associated(temp))
+         s = getNodeName(temp)
+         write(*,'(3a,i3)') indent(1:indent_level), &
+                        char(s), " of type ", &
+                        getNodeType(temp)
+         if (hasChildNodes(temp)) then
+            indent_level = indent_level + 3
+            call dump2(getFirstChild(temp))
+            indent_level = indent_level - 3
+         endif
+         temp => getNextSibling(temp)
+      enddo
+
+    end subroutine dump2
+
+  end subroutine dumpTree
+!----------------------------------------------------------------
+
+  subroutine xmlize(startNode,fname)
+
+    type(fnode), pointer :: startNode   
+    character(len=*), intent(in) :: fname
+
+    type(xmlf_t)  :: xf
+    type(string)  :: s, sv, sn       ! to avoid memory leaks
+
+    call xml_OpenFile(fname,xf)
+    call dump_xml(startNode)
+    call xml_Close(xf)
+
+  contains
+
+    recursive subroutine dump_xml(input)
+      type(fnode), pointer         :: input
+!
+!     Just this node and its descendants, no siblings. 
+!     Of course, the document node has only children...
+!
+      type(fnode), pointer         :: node, attr
+      type(fnamedNodeMap), pointer :: attr_map
+      integer  ::  i
+
+      node => input
+      do
+         if (.not. associated(node)) exit
+         select case (getNodeType(node))
+
+          case (DOCUMENT_NODE)
+
+             call xml_AddXMLDeclaration(xf)
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+
+          case (ELEMENT_NODE)
+
+             s = getNodeName(node)
+             call xml_NewElement(xf,char(s))
+             attr_map => getAttributes(node)
+             do i = 0, getLength(attr_map) - 1
+                attr => item(attr_map,i)
+                sn = getNodeName(attr)
+                sv = getNodeValue(attr)
+                call xml_AddAttribute(xf, char(sn),char(sv))
+             enddo
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+             s = getNodeName(node)
+             call xml_EndElement(xf,char(s))
+
+          case (TEXT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddPcdata(xf,char(s))
+
+          case (CDATA_SECTION_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddCdataSection(xf,char(s))
+
+          case (COMMENT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddComment(xf,char(s))
+
+        end select
+        if (associated(node,StartNode)) exit  ! In case we request the 
+                                              ! dumping of a single element,
+                                              ! do not do siblings
+        node => getNextSibling(node)
+     enddo
+
+    end subroutine dump_xml
+
+  end subroutine xmlize
+
+end module m_dom_utils
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/CHANGES	(revision 3437)
@@ -0,0 +1,28 @@
+April 28, 2004
+
+* New optional argument "record_size" in open_xmlfile. The default record 
+length is 65536, but for overly long lines it might be necessary to specify
+a larger size.
+
+* Wrote "init_" routines to avoid undefined status for the components
+of the buffer, dictionary, and elstack derived types (Fortran90 restriction). 
+They are called just once at the beginning of execution.
+
+The "reset_" routines just zero out the counters in the derived
+types. This leads to substantial savings in overhead.
+
+* Avoided when possible the allocation of temporaries (mostly strings) by
+the compilers. This was particularly acute in the "action" records. The
+typical idiom:
+
+	action =trim("Reading character in name: " // c)
+
+forced the allocation of a temporary.  The number of compiler allocations
+(at least with NAG) has dropped down to just those needed in the processing
+of entities.
+
+* Put the explicit module dependencies in the makefile.
+
+* Increased the standard size of the buffers and dictionaries.
+***** The program now stops when those sizes are not enough.
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/Developer.Guide	(revision 3437)
@@ -0,0 +1,61 @@
+Developer Notes:
+
+The parser is built on several levels:
+
+1. The closest to the user.
+
+   Modules:  m_xml_parser: The main module
+             m_error     : Basic error handling
+
+2. An intermediate layer.
+
+   Modules: m_fsm  (A finite-state machine to parse the input)
+
+3. A layer defining basic data structures and file interfaces:
+
+   Modules: m_reader:  File interface and character handling as per XML specs.
+	    m_buffer:  Basic homemade "variable length string", with some
+                       limitations (size, of course), but avoiding the
+                       use of dynamic structures for now.
+	    m_dictionary: Simple, not dynamic.
+            m_charset: A simple hashing method for sets of characters.
+	    m_elstack: Simple stack to check well-formedness.
+	    m_entities: Entity replacement utilities.
+
+4. Something which does not really belong in the parser but which
+   is useful to massage the data extracted from the file:
+
+	m_converters: Routines to turn pcdata chunks into numerical arrays
+
+
+There are obviously a number of hardwired limitations, which should be
+removed in a later version:
+
+* Buffer size in buffer_t definition. This is not as serious as it
+  looks. Only long unbroken pcdata sections and overly long attribute
+  names or values will be affected. Long SGML declarations and comments
+  might be truncated, but they are not relevant anyway.
+
+* Maximum number of attributes in an element tag (set in m_dictionary)
+
+While the parser does not use any variable-length strings (to keep it
+compatible with existing Fortran90 compilers) or dynamical data
+structures for attribute dictionaries, etc, such improvements could be
+incorporated almost as drop-in replacements for existing sub-modules.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/TODO	(revision 3437)
@@ -0,0 +1,7 @@
+Things to do:
+
+* Make buffer pseudo-dynamical to avoid limitations.
+* Insert code to deal with XML declarations (really processing instructions)
+  which are not of the form
+  
+ <?name  pseudo_att_name="pseudo_att_value" .... ?>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/flib_sax.f90	(revision 3437)
@@ -0,0 +1,19 @@
+module flib_sax
+
+!
+! Stub module to gather all the functionality needed by the user
+! 
+! In future m_dictionary and m_converters could be exported by
+! other parts of a more general fortran library.
+!
+! m_xml_error is necessary in order to use a custom error handler.
+!
+use m_dictionary
+use m_xml_parser
+use m_converters
+use m_xml_error
+
+public
+
+end module flib_sax
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_buffer.f90	(revision 3437)
@@ -0,0 +1,200 @@
+module m_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in m_fsm to avoid buffer overflows
+! caused by pcdata with whitespace.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 10000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 900
+
+!
+
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, len       !! , char
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer, init_buffer
+public :: buffer_to_character
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+   STOP "sax 1 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+  STOP "sax 2 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine init_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+buffer%str=""               ! To avoid "undefined" status
+
+end subroutine init_buffer
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+  buffer%size = 0
+end subroutine reset_buffer
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+!
+subroutine buffer_to_character(buffer,str)
+type(buffer_t), intent(in)          :: buffer
+character(len=*), intent(out)       :: str
+
+str = buffer%str(1:buffer%size)
+end subroutine buffer_to_character
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_buffer
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_charset.f90	(revision 3437)
@@ -0,0 +1,203 @@
+module m_charset
+!
+! One-byte only, sorry
+!
+private
+
+integer, parameter, private  :: small_int = selected_int_kind(1)
+
+!--------------------------------------------------------------------------
+type, public :: charset_t
+! private
+      integer(kind=small_int), dimension(0:255) :: mask
+end type charset_t
+
+
+public  :: operator(.in.), operator(+)
+public  :: assignment(=)
+public  :: print_charset, reset_charset
+
+interface operator(.in.)
+      module procedure belongs
+end interface
+private :: belongs
+
+interface assignment(=)
+      module procedure set_string_to_charset, set_codes_to_charset
+end interface
+private ::  set_string_to_charset, set_codes_to_charset
+
+interface operator(+)
+      module procedure add_string_to_charset, &
+                       add_code_to_charset, add_codes_to_charset
+end interface
+private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset
+
+!--------------------------------------------------------------------------
+
+character(len=*), parameter, private :: &
+            lowercase = "abcdefghijklmnopqrstuvwxyz",  & 
+            uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", &
+            digits    = "0123456789"
+
+integer, parameter, public   :: SPACE           = 32
+integer, parameter, public   :: NEWLINE         = 10
+integer, parameter, public   :: CARRIAGE_RETURN = 13
+integer, parameter, public   :: TAB             =  9
+
+type(charset_t), public    :: initial_name_chars
+type(charset_t), public    :: name_chars
+type(charset_t), public    :: whitespace
+type(charset_t), public    :: valid_chars
+type(charset_t), public    :: uppercase_chars
+
+public  :: setup_xml_charsets
+
+
+CONTAINS !==========================================================
+
+!--------------------------------------------------------------
+function belongs(c,charset)  result(res)
+character(len=1), intent(in)  :: c
+type(charset_t), intent(in)   :: charset
+logical                       :: res
+
+integer  :: code
+
+code = ichar(c)
+res = (charset%mask(code) == 1)
+
+end function belongs
+
+!--------------------------------------------------------------
+
+function add_string_to_charset(charset,str)  result (sum)
+type(charset_t), intent(in)      :: charset
+character(len=*), intent(in)     :: str
+type(charset_t)                  :: sum
+
+integer :: length, code, i
+
+sum%mask = charset%mask
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      sum%mask(code) = 1
+enddo
+end function add_string_to_charset
+
+!--------------------------------------------------------------
+
+function add_code_to_charset(charset,code) result(sum)
+type(charset_t), intent(in)      :: charset
+integer, intent(in)              :: code
+type(charset_t)                  :: sum
+
+if ((code > 255) .or. (code < 0)) return
+sum%mask = charset%mask
+sum%mask(code) = 1
+
+end function add_code_to_charset
+
+!--------------------------------------------------------------
+function add_codes_to_charset(charset,codes) result(sum)
+type(charset_t), intent(in)        :: charset
+integer, dimension(:), intent(in)  :: codes
+type(charset_t)                    :: sum
+
+integer  :: i
+
+sum%mask = charset%mask
+do i = 1, size(codes)
+      if ((codes(i) > 255) .or. (codes(i) < 0)) cycle
+      sum%mask(codes(i)) = 1
+enddo
+end function add_codes_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_string_to_charset(charset,str)      
+type(charset_t), intent(out)   :: charset
+character(len=*), intent(in)   :: str
+
+
+integer :: length, code, i
+
+charset%mask = 0
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      charset%mask(code) = 1
+enddo
+
+end subroutine set_string_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_codes_to_charset(charset,codes)      
+type(charset_t), intent(out)   :: charset
+integer, dimension(:), intent(in)  :: codes
+
+integer :: i
+
+charset%mask = 0
+
+do i = 1, size(codes)
+      charset%mask(codes(i)) = 1
+enddo
+
+end subroutine set_codes_to_charset
+
+
+!--------------------------------------------------------------
+subroutine print_charset(charset)      
+type(charset_t), intent(in)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      if (charset%mask(i) == 1) print *, "Code: ", i
+enddo
+end subroutine print_charset
+
+!--------------------------------------------------------------
+
+subroutine reset_charset(charset)      
+type(charset_t), intent(inout)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      charset%mask(i) = 0
+enddo
+end subroutine reset_charset
+
+!--------------------------------------------------------------
+
+!--------------------------------------------------------
+subroutine setup_xml_charsets()
+
+integer :: i
+
+uppercase_chars = uppercase
+initial_name_chars = (lowercase  // uppercase //  "_:" )
+name_chars = initial_name_chars + ( digits // ".-")
+whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /)
+
+valid_chars = whitespace + (/ (i, i=33,255) /)
+
+end subroutine setup_xml_charsets
+!--------------------------------------------------------
+
+end module m_charset
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_converters.f90	(revision 3437)
@@ -0,0 +1,180 @@
+module m_converters
+
+use m_debug
+
+private
+!
+! Takes a string and turns it into useful data structures,
+! such as numerical arrays.
+!
+! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers,
+! all integers, etc.
+!
+public :: build_data_array
+
+interface build_data_array
+      module procedure build_data_array_real_sp,  &
+                       build_data_array_real_dp,  &
+                       build_data_array_integer
+end interface
+private :: build_data_array_real_sp
+private :: build_data_array_real_dp
+private :: build_data_array_integer
+
+private :: token_analysis, is_separator, is_CR_or_LF
+
+CONTAINS
+
+!---------------------------------------------------------------
+subroutine build_data_array_real_dp(str,x,n)
+integer, parameter  :: dp = selected_real_kind(14)
+!
+character(len=*), intent(in)                ::  str
+real(kind=dp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_dp
+!---------------------------------------------------------------
+
+subroutine build_data_array_real_sp(str,x,n)
+integer, parameter  :: sp = selected_real_kind(6)
+!
+character(len=*), intent(in)                :: str
+real(kind=sp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_sp
+
+!---------------------------------------------------------------
+subroutine build_data_array_integer(str,x,n)
+integer, parameter  :: sp = selected_real_kind(14)
+!
+character(len=*), intent(in)                :: str
+integer, dimension(:), intent(inout)        ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "integer conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_integer
+
+
+!==================================================================
+
+function is_separator(c) result(sep)
+character(len=1), intent(in)          :: c
+logical                               :: sep
+
+ sep = ((c == char(32)) .or. (c == char(10))             &
+         .or. (c == char(9)) .or. (c == char(13)))
+
+end function is_separator
+!----------------------------------------------------------------
+function is_CR_or_LF(c) result(res)
+character(len=1), intent(in)          :: c
+logical                               :: res
+
+ res = ((c == char(10)) .or. (c == char(13)))
+
+end function is_CR_or_LF
+
+!==================================================================
+
+subroutine token_analysis(str,ntokens,last_pos)
+!
+character(len=*), intent(inout)          :: str
+integer, intent(out)                     :: ntokens, last_pos
+!
+!
+! Checks the contents of a string and finds the number of tokens it contains
+! The standard separator is generalized whitespace (space, tab, CR, or LF)
+! It also returns the last useful position in the string (excluding
+! separator characters which are not blanks, and thus not caught by the
+! (len_)trim fortran intrinsic). This is necessary to perform list-directed
+! I/O in the string as an internal file.
+! 
+! Also, replace on the fly CR and LF by blanks. This is necessary if
+! str spans more than one record. In that case, internal reads only 
+! look at the first record. 
+! -- ** Compiler limits on size of internal record??
+!
+integer           :: i, str_length
+logical           :: in_token
+character(len=1)  :: c
+
+in_token = .false.
+ntokens = 0
+last_pos = 0
+
+str_length = len_trim(str)
+!print *, "string length: ", str_length
+
+do i = 1, str_length
+      c = str(i:i)
+
+      if (in_token) then
+         if (is_separator(c)) then
+            in_token = .false.
+            if (is_CR_or_LF(c)) str(i:i) = " "
+         else
+            last_pos = i
+         endif
+
+      else   ! not in token
+         
+         if (is_separator(c)) then
+            if (is_CR_or_LF(c)) str(i:i) = " "
+            ! do nothing
+         else
+            in_token = .true.
+            last_pos = i
+            ntokens = ntokens + 1
+         endif
+      endif
+enddo
+!print *, "ntokens, last_pos: ", ntokens, last_pos
+
+end subroutine token_analysis
+
+
+end module m_converters
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_debug.f90	(revision 3437)
@@ -0,0 +1,5 @@
+module m_debug
+
+logical, public, save   :: debug = .false.
+
+end module m_debug
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_dictionary.f90	(revision 3437)
@@ -0,0 +1,183 @@
+module m_dictionary
+
+use m_buffer
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 64
+type, public :: dictionary_t
+private
+      integer                               :: number_of_items
+      type(buffer_t), dimension(MAX_ITEMS)  :: key
+      type(buffer_t), dimension(MAX_ITEMS)  :: value
+end type dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, init_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+public  :: get_name
+
+interface get_name
+   module procedure get_key
+end interface
+
+interface get_value
+   module procedure sax_get_value
+end interface
+private :: sax_get_value
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine sax_get_value(dict,key,value,status)
+type(dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         value = str(dict%value(i))
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine sax_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = str(dict%key(i))
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+type(buffer_t), intent(in)          :: key
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded ! size= ", max_items
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+type(buffer_t), intent(in)          :: value
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine init_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: i
+
+dict%number_of_items = 0
+do i=1, MAX_ITEMS                      ! To avoid "undefined" status
+   call init_buffer(dict%key(i))       ! (Fortran90 restriction)
+   call init_buffer(dict%value(i))
+enddo
+end subroutine init_dict
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(str(dict%key(i))), " = ", trim(str(dict%value(i)))
+enddo
+
+end subroutine print_dict
+
+
+end module m_dictionary
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_elstack.f90	(revision 3437)
@@ -0,0 +1,153 @@
+module m_elstack
+
+use m_buffer
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 40
+
+type, public :: elstack_t
+private
+      integer                                :: n_items
+      type(buffer_t), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: init_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine init_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                   ! to avoid "undefined status"
+      call init_buffer(elstack%data(i))
+enddo
+end subroutine init_elstack
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                  
+      call reset_buffer(elstack%data(i))
+enddo
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+type(buffer_t), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) str(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = str(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_elstack
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_entities.f90	(revision 3437)
@@ -0,0 +1,134 @@
+module m_entities
+!
+! Entity management
+!
+! It deals with: 
+!    1. The five standard entities (gt,lt,amp,apos,quot)
+!    2. Character entities  (but only within the range of the char intrinsic)
+!
+use m_buffer
+private
+
+integer, parameter, private      :: MAX_REPLACEMENT_SIZE = 200
+!
+type, private :: entity_t
+ character(len=40)                     :: code
+ character(len=MAX_REPLACEMENT_SIZE)   :: replacement
+end type entity_t
+
+integer, parameter, private                          ::  N_ENTITIES  = 5
+
+type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent =  &
+      (/                  &
+      entity_t("gt",">"), &
+      entity_t("lt","<"),  &
+      entity_t("amp","&"),  &
+      entity_t("apos","'"),  &
+      entity_t("quot","""")  &
+      /)
+      
+public :: code_to_str , entity_filter
+
+CONTAINS
+
+subroutine code_to_str(code,str,status)
+character(len=*), intent(in)  :: code
+character(len=*), intent(out) :: str
+integer, intent(out)          :: status         
+integer :: i
+
+integer   :: number, ll
+character(len=4)  :: fmtstr
+
+status = -1
+do i = 1, N_ENTITIES
+      if (code == predefined_ent(i)%code) then
+         str = predefined_ent(i)%replacement
+         status = 0
+         return
+      endif
+enddo
+!
+! Replace character references  (but only within the range of the
+! char intrinsic !!)
+!
+if (code(1:1) == "#") then
+   if (code(2:2) == "x") then       ! hex character reference
+      ll = len_trim(code(3:))
+      write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")"
+      read(unit=code(3:),fmt=fmtstr) number
+      str = char(number)
+      status = 0
+      return
+   else                             ! decimal character reference
+      read(unit=code(2:),fmt=*) number
+      str = char(number)
+      status = 0
+      return
+   endif
+endif
+
+end subroutine code_to_str
+
+!----------------------------------------------------------------
+!
+! Replaces entity references in buf1 and creates a new buffer buf2.
+!
+subroutine entity_filter(buf1,buf2,status,message)
+type(buffer_t), intent(in)    :: buf1
+type(buffer_t), intent(out)   :: buf2
+integer, intent(out)          :: status
+character(len=*), intent(out) :: message
+!
+! Replaces entity references by their value
+!
+integer :: i, k, len1
+character(len=MAX_BUFF_SIZE)           :: s1
+character(len=1)                       :: c
+character(len=MAX_REPLACEMENT_SIZE)    :: repl
+
+call buffer_to_character(buf1,s1)        !! Avoid allocation of temporary
+len1 = len(buf1)
+
+i = 1
+status = 0
+
+call reset_buffer(buf2)
+
+do
+   if (i > len1) exit
+   c = s1(i:i)
+   if (c == "&") then
+      if (i+1 > len1) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      k = index(s1(i+1:),";")
+      if (k == 0) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      call code_to_str(s1(i+1:i+k-1),repl,status)
+      if (status /= 0) then
+         status =  i     ! Could let it continue
+         message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";"
+      else
+         call add_to_buffer(trim(repl),buf2)
+      endif
+      i = i + k + 1
+   else
+     call add_to_buffer(c,buf2)
+     i = i + 1
+   endif
+enddo
+
+end subroutine entity_filter
+
+end module m_entities
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_fsm.f90	(revision 3437)
@@ -0,0 +1,745 @@
+module m_fsm
+!
+use m_buffer
+use m_dictionary
+use m_charset
+use m_entities
+use m_elstack
+
+private
+
+type, public :: fsm_t
+      !
+      ! Contains information about the "finite state machine"
+      ! Some of the components (marked *) could at this point be made into
+      ! saved module variables.
+      ! 
+      !
+      integer              :: state
+      integer              :: context
+      integer              :: nbrackets             !*
+      integer              :: nlts                  !*
+      character(len=1)     :: quote_char            !*
+      type(buffer_t)       :: buffer                !*
+      type(buffer_t)       :: element_name
+      type(dictionary_t)   :: attributes
+      type(buffer_t)       :: pcdata
+      type(elstack_t)      :: element_stack
+      logical              :: root_element_seen
+      type(buffer_t)       :: root_element_name
+      character(len=150)   :: action
+      logical              :: debug
+end type fsm_t
+
+public :: init_fsm, reset_fsm, evolve_fsm
+
+!
+! State parameters
+!
+integer, parameter, public   ::  ERROR = -1
+integer, parameter, public   ::  INIT = 1         
+integer, parameter, private  ::  START_TAG_MARKER = 2
+integer, parameter, private  ::  END_TAG_MARKER = 3
+integer, parameter, private  ::  IN_NAME = 4
+integer, parameter, private  ::  WHITESPACE_IN_TAG = 5
+integer, parameter, private  ::  IN_PCDATA = 6
+integer, parameter, private  ::  SINGLETAG_MARKER = 7
+integer, parameter, private  ::  CLOSINGTAG_MARKER = 8
+integer, parameter, private  ::  IN_COMMENT = 9
+integer, parameter, private  ::  IN_ATT_NAME = 10
+integer, parameter, private  ::  IN_ATT_VALUE = 11
+integer, parameter, private  ::  EQUAL = 12
+integer, parameter, private  ::  SPACE_AFTER_EQUAL = 13
+integer, parameter, private  ::  SPACE_BEFORE_EQUAL = 14
+integer, parameter, private  ::  START_QUOTE = 15
+integer, parameter, private  ::  END_QUOTE = 16
+integer, parameter, private  ::  BANG = 17
+integer, parameter, private  ::  BANG_HYPHEN = 18
+integer, parameter, private  ::  ONE_HYPHEN = 19
+integer, parameter, private  ::  TWO_HYPHEN = 20
+integer, parameter, private  ::  QUESTION_MARK = 21
+integer, parameter, private  ::  START_XML_DECLARATION = 22
+integer, parameter, private  ::  IN_SGML_DECLARATION = 23
+integer, parameter, private  ::  IN_CDATA_SECTION = 24
+integer, parameter, private  ::  ONE_BRACKET = 25
+integer, parameter, private  ::  TWO_BRACKET = 26
+integer, parameter, private  ::  CDATA_PREAMBLE = 27
+integer, parameter, private  ::  IN_PCDATA_AT_EOL = 30
+!
+! Context parameters
+!
+integer, parameter, public   ::  OPENING_TAG  = 100
+integer, parameter, public   ::  CLOSING_TAG  = 110
+integer, parameter, public   ::  SINGLE_TAG   = 120
+integer, parameter, public   ::  COMMENT_TAG  = 130
+integer, parameter, public   ::  XML_DECLARATION_TAG  = 140
+integer, parameter, public   ::  SGML_DECLARATION_TAG  = 150
+integer, parameter, public   ::  CDATA_SECTION_TAG  = 160
+integer, parameter, public   ::  NULL_CONTEXT          = 200
+!
+! Signal parameters
+!
+integer, parameter, public   ::  QUIET             = 1000
+integer, parameter, public   ::  END_OF_TAG        = 1100
+integer, parameter, public   ::  CHUNK_OF_PCDATA   = 1200
+integer, parameter, public   ::  EXCEPTION         = 1500
+
+CONTAINS
+
+!------------------------------------------------------------
+! Initialize once and for all the derived types (Fortran90 restriction)
+!
+subroutine init_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call init_elstack(fx%element_stack)
+ fx%root_element_seen = .false.
+ fx%debug = .false.
+ fx%action = ""
+ call init_buffer(fx%buffer)
+ call init_buffer(fx%element_name)
+ call init_buffer(fx%pcdata)
+ call init_buffer(fx%root_element_name)
+ call init_dict(fx%attributes)
+end subroutine init_fsm
+!------------------------------------------------------------
+subroutine reset_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call reset_elstack(fx%element_stack)
+ fx%action = ""
+ fx%root_element_seen = .false.
+ call reset_buffer(fx%buffer)
+ call reset_buffer(fx%element_name)
+ call reset_buffer(fx%pcdata)
+ call reset_buffer(fx%root_element_name)
+ call reset_dict(fx%attributes)
+end subroutine reset_fsm
+
+!------------------------------------------------------------
+subroutine evolve_fsm(fx,c,signal)
+!
+! Finite-state machine evolution rules for XML parsing.
+!
+type(fsm_t), intent(inout)      :: fx    ! Internal state
+character(len=1), intent(in)    :: c
+integer, intent(out)            :: signal
+
+!
+! Reset signal
+!
+signal = QUIET
+!
+
+if (.not. (c .in. valid_chars)) then
+!
+!      Let it pass (in case the underlying encoding is UTF-8)
+!      But this chars in a name will cause havoc
+!
+!      signal = EXCEPTION
+!      fx%state = ERROR
+!      fx%action = trim("Not a valid character in simple encoding: "//c)
+!      RETURN
+endif
+
+select case(fx%state)
+
+ case (INIT)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without being in one!")
+      else
+         if (fx%debug) fx%action = ("Reading garbage chars")
+      endif
+
+ case (START_TAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of tag!!")
+      else if (c == "/") then
+         fx%state = CLOSINGTAG_MARKER
+         if (fx%debug) fx%action = ("Starting endtag: ")
+         fx%context = CLOSING_TAG
+      else if (c == "?") then
+         fx%state = START_XML_DECLARATION
+         if (fx%debug) fx%action = ("Starting XML declaration ")
+         fx%context = XML_DECLARATION_TAG
+      else if (c == "!") then
+         fx%state = BANG
+         if (fx%debug) fx%action = ("Saw ! -- comment or SGML declaration expected...")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after <")
+      else if (c .in. initial_name_chars) then
+         fx%context = OPENING_TAG
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in tag")
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+
+ case (BANG)
+      if (c == "-") then
+         fx%state = BANG_HYPHEN
+         if (fx%debug) fx%action = ("Almost ready to start comment ")
+      else if (c .in. uppercase_chars) then
+         fx%state = IN_SGML_DECLARATION
+         fx%nlts = 0
+         fx%nbrackets = 0
+         if (fx%debug) fx%action = ("SGML declaration ")
+         fx%context = SGML_DECLARATION_TAG
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "[") then
+         fx%state = CDATA_PREAMBLE
+         if (fx%debug) fx%action = ("Declaration with [ ")
+         fx%context = CDATA_SECTION_TAG
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after ! ")
+      endif
+
+ case (CDATA_PREAMBLE)
+      ! We assume a CDATA[ is forthcoming, we do not check
+      if (c == "[") then
+         fx%state = IN_CDATA_SECTION
+         if (fx%debug) fx%action = ("About to start reading CDATA contents")
+      else if (c == "]") then
+         fx%state = ERROR
+         fx%action = ("Unexpected ] in CDATA preamble")
+      else
+         if (fx%debug) fx%action = ("Reading CDATA preamble")
+      endif
+
+ case (IN_CDATA_SECTION)
+      if (c == "]") then
+         fx%state = ONE_BRACKET
+         if (fx%debug) fx%action = ("Saw a ] in CDATA section")
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading contents of CDATA section")
+      endif
+
+ case (ONE_BRACKET)
+      if (c == "]") then
+         fx%state = TWO_BRACKET
+         if (fx%debug) fx%action = ("Maybe finish a CDATA section")
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (TWO_BRACKET)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal = END_OF_TAG
+         if (fx%debug) fx%action = ("End of CDATA section")
+         fx%pcdata = fx%buffer    ! Not quite the same behavior
+                                  ! as pcdata... (not filtered)
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (IN_SGML_DECLARATION)
+      if (c == "<") then
+         fx%nlts = fx%nlts + 1
+         call add_to_buffer("<",fx%buffer)
+         fx%action = "Read an intermediate < in SGML declaration"
+      else if (c == "[") then
+         fx%nbrackets = fx%nbrackets + 1
+         call add_to_buffer("[",fx%buffer)
+         fx%action = "Read a [ in SGML declaration"
+      else if (c == "]") then
+         fx%nbrackets = fx%nbrackets - 1
+         call add_to_buffer("]",fx%buffer)
+         fx%action = "Read a ] in SGML declaration"
+      else if (c == ">") then
+         if (fx%nlts == 0) then
+            if (fx%nbrackets == 0) then
+               fx%state = END_TAG_MARKER
+               signal  = END_OF_TAG
+               if (fx%debug) fx%action = ("Ending SGML declaration tag")
+               fx%pcdata = fx%buffer       ! Same behavior as pcdata
+               call reset_buffer(fx%buffer)
+            else
+               fx%state = ERROR
+               fx%action = ("Unmatched ] in SGML declaration")
+            endif
+         else
+            fx%nlts = fx%nlts -1
+            call add_to_buffer(">",fx%buffer)
+            fx%action = "Read an intermediate > in SGML declaration"
+         endif
+      else
+         if (fx%debug) fx%action = ("Keep reading SGML declaration")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (BANG_HYPHEN)
+      if (c == "-") then
+         fx%state = IN_COMMENT
+         fx%context = COMMENT_TAG
+         if (fx%debug) fx%action = ("In comment ")
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after <!- ")
+      endif
+
+ case (START_XML_DECLARATION)
+      if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in XML declaration")
+      else
+         fx%state = ERROR
+         fx%action = "Wrong character after ? in start of XML declaration"
+      endif
+
+ case (CLOSINGTAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Closing tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of closing tag!!")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Syntax error (<//)")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after </")
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         if (fx%debug) fx%action = ("Starting to read name inside endtag")
+         call add_to_buffer(c,fx%buffer)
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+ case (IN_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+!         call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag")
+!            call set_element_name(fx%buffer,fx%element)
+            fx%element_name = fx%buffer
+            call reset_buffer(fx%buffer)
+            call reset_dict(fx%attributes)
+         endif
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Ending name chars")
+!            call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading name chars in tag")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for name")
+      endif
+
+ case (IN_ATT_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c .in. whitespace) then
+         fx%state = SPACE_BEFORE_EQUAL  
+         if (fx%debug) fx%action = ("Whitespace after attr. name (specs?)")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("End of attr. name")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading attribute name chars")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for attribute name")
+      endif
+
+ case (EQUAL)
+      if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         if (fx%debug) fx%action = ("Found beginning quote")
+         fx%quote_char = c
+      else if (c .in. whitespace) then
+         fx%state = SPACE_AFTER_EQUAL
+         if (fx%debug) fx%action = ("Whitespace after equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (SPACE_BEFORE_EQUAL)
+      if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace before equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use equal sign for attribute values")
+      endif
+
+ case (SPACE_AFTER_EQUAL)
+      if ( c == "=" ) then
+         fx%state = ERROR
+         fx%action = ("Duplicate Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace after equal sign...")
+      else  if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         fx%quote_char = c
+         if (fx%debug) fx%action = ("Found beginning quote")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (START_QUOTE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("Emtpy attribute value...")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else   ! actually allowed chars in att values... Specs: No "<"        
+         fx%state = IN_ATT_VALUE
+         if (fx%debug) fx%action = ("Starting to read attribute value")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (IN_ATT_VALUE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("End of attribute value")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else if ( (c == char(10)) ) then
+         fx%state = ERROR
+!
+!        Aparently other whitespace is allowed...
+!
+         fx%action = ("No newline allowed in attr. value (specs?)")
+      else        ! all other chars allowed in attr value
+         if (fx%debug) fx%action = ("Reading attribute value chars")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (END_QUOTE)
+      if ((c == """") .or. (c == "'")) then
+         fx%state = ERROR
+         fx%action = ("Duplicate end quote")
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Space in between attributes or to end of tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("Ending tag after some attributes")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag after some attributes")
+         endif
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration")
+         endif
+      else   
+         fx%state = ERROR
+         fx%action = ("Must have some whitespace after att. value")
+      endif
+
+
+ case (WHITESPACE_IN_TAG)
+      if ( c .in. whitespace) then
+         if (fx%debug) fx%action = ("Reading whitespace in tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("End whitespace in tag")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("End whitespace in single tag")
+         endif
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_ATT_NAME
+         if (fx%debug) fx%action = ("Starting Attribute name in tag")
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration after whitespace")
+         endif
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for attribute")
+      endif
+
+ case (QUESTION_MARK)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of XML declaration tag")
+      else
+         fx%state = ERROR
+         fx%action = "No > after ? in XML declaration tag"
+      endif
+
+ case (IN_COMMENT)
+      !
+      ! End of comment is  "-->", and  ">" can appear inside comments
+      !
+      if (c == "-") then
+         fx%state = ONE_HYPHEN
+         if (fx%debug) fx%action = ("Saw - in Comment")
+      else
+         if (fx%debug) fx%action = ("Reading comment")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (ONE_HYPHEN)
+      if (c == "-") then
+         fx%state = TWO_HYPHEN
+         if (fx%debug) fx%action = ("About to end comment")
+      else
+         fx%state = IN_COMMENT
+         if (fx%debug) fx%action = ("Keep reading comment after -: ")
+         call add_to_buffer("-",fx%buffer)
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (TWO_HYPHEN)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of Comment")
+         fx%pcdata = fx%buffer                  ! Same behavior as pcdata
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Cannot have -- in comment")
+      endif
+
+ case (SINGLETAG_MARKER)
+
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+         ! We have to call begin_element AND end_element
+      else 
+         fx%state = ERROR
+         fx%action = ("Wrong ending of single tag")
+      endif
+
+ case (IN_PCDATA)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("End of pcdata -- Starting tag")
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+ case (IN_PCDATA_AT_EOL)
+      !
+      ! Avoid triggering an extra pcdata event
+      !
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("No more pcdata after eol-- Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at repeated newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+
+
+ case (END_TAG_MARKER)
+!
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Double ending of tag!")
+!
+!     We should make this whitespace in general (maybe not?
+!     how about indentation in text chunks?)
+!     See specs.
+!
+      else if (c == char(10)) then
+        ! Ignoring LF after end of tag is probably non standard...
+
+         if (fx%debug) &
+            fx%action = ("---------Discarding newline after end of tag")
+
+        !!!  New code for full compliance
+        ! fx%state = IN_PCDATA_AT_EOL
+        ! call add_to_buffer(c,fx%buffer)
+        ! if (fx%debug) &
+        !    fx%action = ("Found LF after end of tag. Emitting PCDATA event")
+        ! signal = CHUNK_OF_PCDATA
+        ! fx%pcdata = fx%buffer
+        ! call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("End of Tag. Starting to read PCDATA")
+      endif
+
+ case (ERROR)
+
+      stop "Cannot continue after parsing errors!"
+
+ end select
+
+if (fx%state == ERROR) signal  = EXCEPTION
+
+end subroutine evolve_fsm
+
+end module m_fsm
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_io.f90	(revision 3437)
@@ -0,0 +1,94 @@
+module m_io
+
+!
+! Basic  I/O tools
+!
+integer, public, save            :: io_eor, io_eof
+
+public  :: get_unit, setup_io
+private :: find_eor_eof
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+subroutine setup_io()
+  call find_eor_eof(io_eor, io_eof)
+end subroutine setup_io
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+! ----------------------------------------------------------------------
+
+subroutine find_eor_eof(io_eor,io_eof)
+!
+! Determines the values of the iostat values for End of File and 
+! End of Record (in non-advancing I/O)
+!
+integer, intent(out)           :: io_eor
+integer, intent(out)           :: io_eof
+
+integer           :: lun, iostat
+character(len=1)  :: c
+
+call get_unit(lun,iostat)
+
+if (iostat /= 0) stop "Out of unit numbers"
+
+open(unit=lun,status="scratch",form="formatted", &
+     action="readwrite",position="rewind",iostat=iostat)
+if (iostat /= 0)   stop "Cannot open test file"
+
+write(unit=lun,fmt=*)  "a"
+write(unit=lun,fmt=*)  "b"
+
+rewind(unit=lun)
+
+io_eor = 0
+do
+  read(unit=lun,fmt="(a1)",advance="NO",iostat=io_eor) c
+  if (io_eor /= 0) exit
+enddo
+
+io_eof = 0
+do
+  read(unit=lun,fmt=*,iostat=io_eof)
+  if (io_eof /= 0) exit
+enddo
+
+!!!!!!!!print *, "IO_EOR, IO_EOF: ", io_eor, io_eof
+
+close(unit=lun,status="delete")
+
+end subroutine find_eor_eof
+
+! ----------------------------------------------------------------------
+end module m_io
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_reader.f90	(revision 3437)
@@ -0,0 +1,298 @@
+module m_reader
+
+use m_io
+
+private
+
+integer, parameter, public              :: BUFFER_NOT_CONNECTED = -2048
+integer, private, parameter             :: MAXLENGTH = 1024
+
+type, public :: file_buffer_t
+private
+      logical                           :: connected
+      logical                           :: eof
+      integer                           :: lun
+      character(len=50)                 :: filename
+      integer                           :: counter
+      character(len=MAXLENGTH)          :: buffer
+      integer                           :: line
+      integer                           :: col
+      integer                           :: pos 
+      integer                           :: nchars
+      logical                           :: debug
+end type file_buffer_t
+
+public  :: get_character, sync_file
+public  :: line, column, nchars_processed
+public  :: open_file, close_file_buffer, rewind_file, mark_eof_file
+public  :: eof_file
+
+private :: fill_buffer
+
+CONTAINS
+
+!-----------------------------------------
+!
+subroutine open_file(fname,fb,iostat,record_size,verbose)
+character(len=*), intent(in)      :: fname
+type(file_buffer_t), intent(out)  :: fb
+integer, intent(out)              :: iostat
+integer, intent(in), optional     :: record_size
+logical, intent(in), optional     :: verbose
+
+iostat = 0
+
+call setup_io()
+
+fb%connected = .false.
+
+call get_unit(fb%lun,iostat)
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot get unit"
+   return
+endif
+
+if (present(verbose)) then
+   fb%debug = verbose
+else
+   fb%debug = .false.
+endif
+
+if (present(record_size)) then
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=record_size,iostat=iostat)
+else
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=65536,iostat=iostat)
+endif
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat
+   return
+endif
+
+fb%connected = .true.
+fb%counter = 0
+fb%eof = .false.
+fb%line = 1
+fb%col = 0
+fb%filename = fname
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+end subroutine open_file
+
+!-------------------------------------------------
+subroutine rewind_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .false.
+fb%counter = 0
+fb%line = 1
+fb%col = 0
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+rewind(unit=fb%lun)
+
+end subroutine rewind_file
+!-----------------------------------------
+subroutine mark_eof_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .true.
+
+end subroutine mark_eof_file
+
+!-----------------------------------------
+subroutine close_file_buffer(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+if (fb%connected) then
+    close(unit=fb%lun)
+    fb%connected = .false.
+endif
+
+end subroutine close_file_buffer
+
+!-------------------------------------------------
+function eof_file(fb) result (res)
+type(file_buffer_t), intent(in)  :: fb
+logical                          :: res
+
+res = fb%eof
+
+end function eof_file
+!-----------------------------------------
+!-----------------------------------------
+! New version, able to cope with arbitrarily long lines 
+! (still need to specify a big enough record_size if necessary)
+!
+subroutine fill_buffer(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)  :: iostat
+! 
+!
+character(len=41)  :: str       ! 40 seems like a good compromise?
+                                ! (1 extra for added newline, see below)
+integer            :: len
+!
+read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a40)") str
+
+if (iostat == io_eof) then
+   
+   ! End of file
+   if (fb%debug) print *, "End of file."
+   return
+
+else if (iostat > 0) then
+
+   ! Hard i/o error
+   if (fb%debug) print *, "Hard i/o error. iostat:", iostat
+   RETURN
+
+else
+!
+ if (fb%debug) then
+   print *, "Buffer: len, iostat", len, iostat
+   print *, trim(str)
+ endif
+
+   fb%pos = 0
+
+   if (iostat == 0) then
+
+      !  Normal read, with more stuff left on the line
+      !
+      fb%buffer = str(1:len) 
+      fb%nchars = len
+
+   else         ! (end of record)
+      !
+      !  End of record. We mark it with an LF, whatever it is the native marker.
+      !
+!!      fb%buffer = str(1:len) // char(10)
+      fb%buffer = str(1:len)             !! Avoid allocation of string
+      len = len + 1                      !! by compiler
+      fb%buffer(len:len) = char(10)   
+      fb%nchars = len
+      iostat = 0
+   endif
+
+endif
+
+end subroutine fill_buffer
+
+!---------------------------------------------------------------
+subroutine get_character(fb,c,iostat)
+character(len=1), intent(out) :: c
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)          :: iostat
+
+character(len=1)   :: c_next
+
+if (.not. fb%connected) then
+      iostat = BUFFER_NOT_CONNECTED
+      return
+endif
+
+if (fb%pos >= fb%nchars) then
+      call fill_buffer(fb,iostat)
+      if (iostat /= 0) return
+endif
+fb%pos = fb%pos + 1
+c = fb%buffer(fb%pos:fb%pos)
+fb%counter = fb%counter + 1              ! Raw counter
+fb%col = fb%col + 1
+!
+! Deal with end-of-line handling on the processor...
+!
+if (c == char(10)) then
+   ! Our own marker for end of line
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+if (c == char(13)) then
+   c_next = fb%buffer(fb%pos+1:fb%pos+1)
+   if (c_next == char(10)) then
+      !
+      ! Found CRLF. We replace it by LF, as per specs.
+      c = c_next
+      fb%pos = fb%pos + 1
+      if (fb%debug) print *, "-/-> Removed CR before LF in get_character"
+   else
+      ! Replace single CR by LF
+      c = char(10)
+      if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++"
+      !
+   endif
+   ! In both cases we increase the line counter and reset the column
+   !
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+
+iostat = 0
+
+end subroutine get_character
+
+!----------------------------------------------------
+!----------------------------------------------------
+! Error Location functions
+!
+function line(fb) result (ll)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: ll
+
+ll = fb%line
+end function line
+
+!----------------------------------------------------
+function column(fb) result (col)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: col
+
+col = fb%col
+end function column
+!----------------------------------------------------
+!----------------------------------------------------
+function nchars_processed(fb) result (nc)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: nc
+
+nc = fb%counter
+end function nchars_processed
+!----------------------------------------------------
+
+subroutine sync_file(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)                :: iostat
+!
+! Repositions the file so that it matches with
+! the stored file_buffer information
+!
+integer          :: target_counter
+character(len=1) :: c
+
+target_counter = fb%counter
+call rewind_file(fb)
+iostat = 0
+do
+   if (fb%counter == target_counter) exit
+   call get_character(fb,c,iostat)
+   if (iostat /= 0) return
+enddo
+
+end subroutine sync_file
+
+end module m_reader
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_error.f90	(revision 3437)
@@ -0,0 +1,84 @@
+module m_xml_error
+!
+! Error handling
+!
+use m_elstack
+private
+
+type, public  :: xml_error_t
+      character(len=100)  :: message
+      integer             :: line
+      integer             :: column
+      type(elstack_t)     :: stack
+      integer             :: severity
+end type xml_error_t
+
+integer, public             ::  xml_stderr = 0    ! Unit for error info
+integer, public, parameter  ::  SEVERE_ERROR_CODE=0, WARNING_CODE=1
+
+public  :: build_error_info, default_error_handler
+public  :: set_xml_stderr
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+subroutine build_error_info(error_info,message,line,column,stack,severity)
+type(xml_error_t), intent(out)        :: error_info
+integer, intent(in)                   :: line, column
+character(len=*), intent(in)          :: message
+type(elstack_t), intent(in)           :: stack
+integer, intent(in)                   :: severity
+
+error_info%message = message
+error_info%line = line
+error_info%column = column
+error_info%stack = stack
+error_info%severity = severity
+
+end subroutine build_error_info
+
+!--------------------------------------------------
+
+subroutine default_error_handler(error_info)
+type(xml_error_t), intent(in)            :: error_info
+!
+! Default error handling
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:"
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:"
+endif
+write(unit=xml_stderr,fmt="(a)") trim(error_info%message)
+write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", &
+                                         error_info%line, &
+                                         " Column: ", &
+                                         error_info%column
+write(unit=xml_stderr,fmt="(a)") "Element traceback:"
+call print_elstack(error_info%stack,unit=xml_stderr)
+!
+!   If there is a severe error the program should stop...
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+      STOP
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..."
+endif
+
+end subroutine default_error_handler
+
+!-------------------------------------------------------------------------
+subroutine set_xml_stderr(unit)
+integer, intent(in)  :: unit
+
+xml_stderr  = unit
+
+end subroutine set_xml_stderr
+
+end module m_xml_error
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/sax/m_xml_parser.f90	(revision 3437)
@@ -0,0 +1,506 @@
+module m_xml_parser
+
+!
+! Basic module to parse XML in the SAX spirit.
+!
+
+use m_buffer
+use m_reader
+use m_fsm
+use m_dictionary
+use m_debug
+use m_xml_error
+use m_elstack          ! For element nesting checks
+use m_entities
+!
+private
+
+!
+!  XML file handle
+!
+type, public :: xml_t
+private
+      type(file_buffer_t)  :: fb
+      type(fsm_t)          :: fx
+      character(len=200)   :: path_mark
+end type xml_t
+
+!
+public :: xml_parse
+public :: open_xmlfile, close_xmlfile
+public :: endfile_xmlfile, rewind_xmlfile
+public :: eof_xmlfile, sync_xmlfile
+public :: xml_char_count
+public :: xml_path, xml_mark_path, xml_get_path_mark
+public :: xml_name, xml_attributes
+
+CONTAINS  !=============================================================
+
+subroutine open_xmlfile(fname,fxml,iostat,record_size)
+character(len=*), intent(in)      :: fname
+integer, intent(out)              :: iostat
+type(xml_t), intent(out)          :: fxml
+integer, intent(in), optional     :: record_size
+
+call open_file(fname,fxml%fb,iostat,record_size)
+call init_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine open_xmlfile
+!-------------------------------------------------------------------------
+
+subroutine rewind_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call rewind_file(fxml%fb)
+call reset_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine rewind_xmlfile
+
+!-----------------------------------------
+subroutine endfile_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call mark_eof_file(fxml%fb) 
+
+end subroutine endfile_xmlfile
+
+!-----------------------------------------
+subroutine close_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call close_file_buffer(fxml%fb)
+call reset_fsm(fxml%fx)         ! just in case
+fxml%path_mark = ""             ! ""
+
+end subroutine close_xmlfile
+
+!-----------------------------------------
+subroutine sync_xmlfile(fxml,iostat)
+type(xml_t), intent(inout) :: fxml
+integer, intent(out)       :: iostat
+
+call sync_file(fxml%fb,iostat)
+! Do not reset fx: that's the whole point of synching.
+
+end subroutine sync_xmlfile
+
+!----------------------------------------------------
+function eof_xmlfile(fxml) result (res)
+type(xml_t), intent(in)          :: fxml
+logical                          :: res
+
+res = eof_file(fxml%fb)
+
+end function eof_xmlfile
+!
+!----------------------------------------------------
+!----------------------------------------------------
+function xml_char_count(fxml) result (nc)
+type(xml_t), intent(in)          :: fxml
+integer                          :: nc
+
+nc = nchars_processed(fxml%fb)
+
+end function xml_char_count
+!
+!----------------------------------------------------
+!
+
+subroutine xml_parse(fxml, begin_element_handler,    &
+                           end_element_handler,      &
+                           pcdata_chunk_handler,     &
+                           comment_handler,          &
+                           xml_declaration_handler,  &
+                           cdata_section_handler,     &
+                           sgml_declaration_handler, &
+                           error_handler,            &
+                           signal_handler,            &
+                           verbose,                  &
+                           empty_element_handler)
+
+type(xml_t), intent(inout), target  :: fxml
+
+optional                            :: begin_element_handler
+optional                            :: end_element_handler
+optional                            :: pcdata_chunk_handler
+optional                            :: comment_handler
+optional                            :: xml_declaration_handler
+optional                            :: sgml_declaration_handler
+optional                            :: cdata_section_handler
+optional                            :: error_handler
+optional                            :: signal_handler
+logical, intent(in), optional       :: verbose
+optional                            :: empty_element_handler
+
+interface
+   subroutine begin_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine begin_element_handler
+
+   subroutine end_element_handler(name)
+   character(len=*), intent(in)     :: name
+   end subroutine end_element_handler
+
+   subroutine pcdata_chunk_handler(chunk)
+   character(len=*), intent(in) :: chunk
+   end subroutine pcdata_chunk_handler
+
+   subroutine comment_handler(comment)
+   character(len=*), intent(in) :: comment
+   end subroutine comment_handler
+
+   subroutine xml_declaration_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine xml_declaration_handler
+
+   subroutine sgml_declaration_handler(sgml_declaration)
+   character(len=*), intent(in) :: sgml_declaration
+   end subroutine sgml_declaration_handler
+
+   subroutine cdata_section_handler(cdata)
+   character(len=*), intent(in) :: cdata
+   end subroutine cdata_section_handler
+
+   subroutine error_handler(error_info)
+   use m_xml_error
+   type(xml_error_t), intent(in)            :: error_info
+   end subroutine error_handler
+
+   subroutine signal_handler(code)
+   logical, intent(out) :: code
+   end subroutine signal_handler
+
+   subroutine empty_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine empty_element_handler
+
+end interface
+
+character(len=1)     :: c
+integer              :: iostat, status
+
+character(len=150)   :: message
+integer              :: signal
+
+type(buffer_t)       :: translated_pcdata
+type(buffer_t)       :: name, oldname, dummy
+
+logical              :: have_begin_handler, have_end_handler, &
+                        have_pcdata_handler, have_comment_handler, &
+                        have_xml_declaration_handler, &
+                        have_sgml_declaration_handler, &
+                        have_cdata_section_handler, have_empty_handler, &
+                        have_error_handler, have_signal_handler
+
+logical              :: pause_signal
+
+type(xml_error_t)            :: error_info
+type(file_buffer_t), pointer :: fb
+type(fsm_t), pointer         :: fx
+
+have_begin_handler = present(begin_element_handler)
+have_end_handler = present(end_element_handler)
+have_pcdata_handler = present(pcdata_chunk_handler)
+have_comment_handler = present(comment_handler)
+have_xml_declaration_handler = present(xml_declaration_handler)
+have_sgml_declaration_handler = present(sgml_declaration_handler)
+have_cdata_section_handler = present(cdata_section_handler)
+have_error_handler = present(error_handler)
+have_signal_handler = present(signal_handler)
+have_empty_handler = present(empty_element_handler)
+
+fb => fxml%fb
+fx => fxml%fx
+if (present(verbose)) then
+   debug = verbose                 ! For m_converters
+   fx%debug = verbose              ! job-specific flag
+endif
+
+if (fx%debug) print *, " Entering xml_parse..."
+
+!---------------------------------------------------------------------
+do
+      call get_character(fb,c,iostat)
+
+      if (iostat /= 0) then          ! End of file...
+         if (.not. is_empty(fx%element_stack)) then
+            call build_error_info(error_info, &
+                 "Early end of file.", &
+                 line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+            if (have_error_handler) then
+               call error_handler(error_info)
+            else
+               call default_error_handler(error_info)
+            endif
+         endif
+         call endfile_xmlfile(fxml)  ! Mark it as eof
+         EXIT
+      endif
+
+      call evolve_fsm(fx,c,signal)
+
+      if (fx%debug) print *, c, " ::: ", trim(fx%action)
+
+      if (signal == END_OF_TAG) then
+         !
+         ! We decide whether we have ended an opening tag or a closing tag
+         !
+         if (fx%context == OPENING_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found an opening tag"
+            if (fx%root_element_seen) then
+               if (name .equal. fx%root_element_name) then
+                  call build_error_info(error_info, &
+                  "Duplicate root element: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+               if (is_empty(fx%element_stack)) then
+                  call build_error_info(error_info, &
+                  "Opening tag beyond root context: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            else
+               fx%root_element_name = name
+               fx%root_element_seen = .true.
+            endif
+            call push_elstack(name,fx%element_stack)
+            if (have_begin_handler) &
+                call begin_element_handler(str(name),fx%attributes)
+
+         else if (fx%context == CLOSING_TAG) then
+            name = fx%element_name
+         
+            if (fx%debug) print *, "We have found a closing tag"
+            if (is_empty(fx%element_stack)) then
+               call build_error_info(error_info, &
+                  "Nesting error: End tag: " // str(name) //  &
+                  " does not match -- too many end tags", &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               call get_top_elstack(fx%element_stack,oldname)
+               if (oldname .equal. name) then
+                  call pop_elstack(fx%element_stack,oldname)
+                  if (have_end_handler) call end_element_handler(str(name))
+!!                  call pop_elstack(fx%element_stack,oldname)
+               else
+                  call build_error_info(error_info, &
+                       "Nesting error: End tag: " // str(name) //  &
+                       ". Expecting end of : " // str(oldname), &
+                       line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            endif
+         else if (fx%context == SINGLE_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found a single (empty) tag: ", &
+                                char(name)
+            !
+            ! Push name on to stack to reveal true xpath
+            !
+            call push_elstack(name,fx%element_stack)
+            if (have_empty_handler) then
+               if (fx%debug) print *, "--> calling empty_element_handler."
+               call empty_element_handler(str(name),fx%attributes)
+               call pop_elstack(fx%element_stack,dummy)
+            else
+               if (have_begin_handler) then
+                  if (fx%debug) print *, "--> calling begin_element_handler..."
+                  call begin_element_handler(str(name),fx%attributes)
+               endif
+               call pop_elstack(fx%element_stack,dummy)
+               if (have_end_handler) then
+                  if (fx%debug) print *, "--> ... and end_element_handler."
+                  call end_element_handler(str(name))
+               endif
+            endif
+!!            call pop_elstack(fx%element_stack,dummy)
+
+         else if (fx%context == CDATA_SECTION_TAG) then
+
+            if (fx%debug) print *, "We found a CDATA section"
+            if (is_empty(fx%element_stack)) then
+               if (fx%debug) print *, &
+                   "... Warning: CDATA section outside element context"
+            else
+               if (have_cdata_section_handler) then
+                  call cdata_section_handler(str(fx%pcdata))
+               else
+                  if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(fx%pcdata))
+               endif
+            endif
+
+         else if (fx%context == COMMENT_TAG) then
+
+            if (fx%debug) print *, "We found a comment tag"
+            if (have_comment_handler)  &
+                 call comment_handler(str(fx%pcdata))
+
+         else if (fx%context == SGML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an sgml declaration"
+            if (have_sgml_declaration_handler)  &
+                      call sgml_declaration_handler(str(fx%pcdata))
+
+         else if (fx%context == XML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an XML declaration"
+            name = fx%element_name
+            if (have_xml_declaration_handler)  &
+                      call xml_declaration_handler(str(name),fx%attributes)
+
+         else
+
+            ! do nothing
+
+         endif
+
+      else if (signal == CHUNK_OF_PCDATA) then
+
+         if (fx%debug) print *, "We found a chunk of PCDATA"
+         if (is_empty(fx%element_stack)) then
+            if (fx%debug) print *, "... Warning: PCDATA outside element context"
+               ! Just a warning
+               call build_error_info(error_info, &
+                  "PCDATA outside of element context", &
+                  line(fb),column(fb),fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+         else
+            !
+            ! Replace entities by their value
+            !
+            call entity_filter(fx%pcdata,translated_pcdata,status,message)
+            if (status < 0) then
+               call build_error_info(error_info, message, &
+                  line(fb),-status,fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else if (status > 0) then
+               ! Just a warning
+               call build_error_info(error_info, message, &
+                  line(fb),status,fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(translated_pcdata))
+            endif
+         endif
+
+      else if (signal == EXCEPTION) then
+         call build_error_info(error_info, fx%action, &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+         if (have_error_handler) then
+            call error_handler(error_info)
+         else
+            call default_error_handler(error_info)
+         endif
+      else
+         ! QUIET, do nothing
+      endif
+      if (signal /= QUIET) then
+         if (have_signal_handler) then
+            call signal_handler(pause_signal)
+            if (pause_signal) exit
+         endif
+      endif
+
+enddo
+
+end subroutine xml_parse
+
+!-----------------------------------------
+subroutine xml_path(fxml,path)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,path)
+
+end subroutine xml_path
+
+!-----------------------------------------
+subroutine xml_mark_path(fxml,path)
+!
+! Marks the current path
+!
+type(xml_t), intent(inout) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,fxml%path_mark)
+path = fxml%path_mark
+
+end subroutine xml_mark_path
+
+!-----------------------------------------
+subroutine xml_get_path_mark(fxml,path)
+!
+! Returns the currently markd path (or an empty string if there are no marks)
+!
+type(xml_t), intent(in)        :: fxml
+character(len=*), intent(out)  :: path
+
+path = fxml%path_mark
+
+end subroutine xml_get_path_mark
+
+!-----------------------------------------
+subroutine xml_name(fxml,name)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: name
+
+name = char(fxml%fx%element_name)
+
+end subroutine xml_name
+!-----------------------------------------
+subroutine xml_attributes(fxml,attributes)
+type(xml_t), intent(in) :: fxml
+type(dictionary_t), intent(out)  :: attributes
+
+attributes = fxml%fx%attributes
+
+end subroutine xml_attributes
+
+end module m_xml_parser
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/strings/m_strings.f90	(revision 3437)
@@ -0,0 +1,6323 @@
+!*******************************************************************************
+! module STRINGS
+! Mart Rentmeester, Mart.Rentmeester@sci.kun.nl
+! http://nn-online.sci.kun.nl/fortran
+! Version 1.0
+!*******************************************************************************
+
+      module m_strings
+
+      private
+
+      type string
+          private
+          integer                 :: len = 0
+          integer                 :: size = 0
+
+          character, pointer      :: chars(:) => null()
+
+      end type string
+
+      character, parameter :: blank = ' '
+
+!     GENERIC PROCEDURE INTERFACE DEFINITIONS
+
+!---- LEN interface
+      interface len
+          module procedure len_s
+      end interface
+
+!---- Conversion (to CHAR) procedure interfaces
+      interface char
+          module procedure s_to_c, &! string to character
+                           s_to_slc       ! string to specified length character
+      end interface
+
+!---- ASSIGNMENT interfaces
+      interface assignment(=)
+          module procedure assign_s_to_s, &! string = string
+                           assign_s_to_c, &! character = string
+                           assign_c_to_s        ! string = character
+      end interface
+
+!---- // operator interfaces
+      interface operator(//)
+          module procedure s_concat_s, &! string // string
+                           s_concat_c, &! string // character
+                           c_concat_s     ! character // string
+      end interface
+
+!---- INSERT_IN_STRING interface
+      interface insert_in_string
+          module procedure insert_in_string_c, insert_in_string_s
+      end interface
+
+!---- PREPEND_TO_STRING interface
+      interface prepend_to_string
+          module procedure prepend_to_string_c, prepend_to_string_s
+      end interface
+
+!---- APPEND_TO_STRING interface
+      interface append_to_string
+          module procedure append_to_string_c, append_to_string_s
+      end interface
+
+!---- REPLACE_IN_STRING interface
+      interface replace_in_string
+          module procedure replace_in_string_sc_s,   replace_in_string_ss_s,   &
+                           replace_in_string_sc_sf,  replace_in_string_ss_sf,  &
+                           replace_in_string_scc,    replace_in_string_ssc,    &
+                           replace_in_string_scs,    replace_in_string_sss,    &
+                           replace_in_string_scc_f,  replace_in_string_ssc_f,  &
+                           replace_in_string_scs_f,  replace_in_string_sss_f
+      end interface
+
+
+!---- REPEAT interface
+      interface repeat
+          module procedure repeat_s
+      end interface
+
+!---- ==  .eq. comparison operator interfaces
+      interface operator(==)
+          module procedure s_eq_s, &! string == string
+                           s_eq_c, &! string == character
+                           c_eq_s         ! character == string
+      end interface
+
+!---- /=  .ne. comparison operator interfaces
+      interface operator(/=)
+          module procedure s_ne_s, &! string /= string
+                           s_ne_c, &! string /= character
+                           c_ne_s         ! character /= string
+      end interface
+
+!---- <  .lt. comparison operator interfaces
+      interface operator(<)
+          module procedure s_lt_s, &! string < string
+                           s_lt_c, &! string < character
+                           c_lt_s         ! character < string
+      end interface
+
+!---- <=  .le. comparison operator interfaces
+      interface operator(<=)
+          module procedure s_le_s, &! string <= string
+                           s_le_c, &! string <= character
+                           c_le_s         ! character <= string
+      end interface
+
+!---- >=  .ge. comparison operator interfaces
+      interface operator(>=)
+          module procedure s_ge_s, &! string >= string
+                           s_ge_c, &! string >= character
+                           c_ge_s         ! character >= string
+      end interface
+
+!---- >  .gt. comparison operator interfaces
+      interface operator(>)
+          module procedure s_gt_s, &! string > string
+                           s_gt_c, &! string > character
+                           c_gt_s         ! character > string
+      end interface
+
+!---- .aeq. comparison operator interfaces
+      interface operator(.aeq.)
+          module procedure a_eq_a, &! array == array
+                           a_eq_c, &! array == character
+                           c_eq_a         ! character == array
+      end interface
+
+!---- .ane. comparison operator interfaces
+      interface operator(.ane.)
+          module procedure a_ne_a, &! array /= array
+                           a_ne_c, &! array /= character
+                           c_ne_a         ! character /= array
+      end interface
+
+!---- .alt. comparison operator interfaces
+      interface operator(.alt.)
+          module procedure a_lt_a, &! array < array
+                           a_lt_c, &! array < character
+                           c_lt_a         ! character < array
+      end interface
+
+!---- .ale. comparison operator interfaces
+      interface operator(.ale.)
+          module procedure a_le_a, &! array <= array
+                           a_le_c, &! array <= character
+                           c_le_a         ! character <= array
+      end interface
+
+!---- .age. comparison operator interfaces
+      interface operator(.age.)
+          module procedure a_ge_a, &! array >= array
+                           a_ge_c, &! array >= character
+                           c_ge_a         ! character >= array
+      end interface
+
+!---- .agt. comparison operator interfaces
+      interface operator(.agt.)
+          module procedure a_gt_a, &! array > array
+                           a_gt_c, &! array > character
+                           c_gt_a         ! character > array
+      end interface
+
+!---- LLT comparison function interfaces
+      interface llt
+          module procedure s_llt_s, &! llt(string,string)
+                           s_llt_c, &! llt(string,character)
+                           c_llt_s        ! llt(character,string)
+      end interface
+
+!---- LLE comparison function interfaces
+      interface lle
+          module procedure s_lle_s, &! lle(string,string)
+                           s_lle_c, &! lle(string,character)
+                           c_lle_s        ! lle(character,string)
+      end interface
+
+!---- LGE comparison function interfaces
+      interface lge
+          module procedure s_lge_s, &! lge(string,string)
+                           s_lge_c, &! lge(string,character)
+                           c_lge_s        ! lge(character,string)
+      end interface
+
+!---- LGT comparison function interfaces
+      interface lgt
+          module procedure s_lgt_s, &! lgt(string,string)
+                           s_lgt_c, &! lgt(string,character)
+                           c_lgt_s        ! lgt(character,string)
+      end interface
+
+!---- ALLT comparison function interfaces
+      interface allt
+          module procedure a_allt_a, &! allt(array,array)
+                           a_allt_c, &! allt(array,character)
+                           c_allt_a        ! allt(character,array)
+      end interface
+
+!---- ALLE comparison function interfaces
+      interface alle
+          module procedure a_alle_a, &! alle(array,array)
+                           a_alle_c, &! alle(array,character)
+                           c_alle_a        ! alle(character,array)
+      end interface
+
+!---- ALGE comparison function interfaces
+      interface alge
+          module procedure a_alge_a, &! alge(array,array)
+                           a_alge_c, &! alge(array,character)
+                           c_alge_a        ! alge(character,array)
+      end interface
+
+!---- ALGT comparison function interfaces
+      interface algt
+          module procedure a_algt_a, &! algt(array,array)
+                           a_algt_c, &! algt(array,character)
+                           c_algt_a        ! algt(character,array)
+      end interface
+
+!---- INDEX procedure
+      interface index
+          module procedure index_ss, index_sc, index_cs
+      end interface
+
+!---- AINDEX procedure
+      interface aindex
+          module procedure aindex_aa, aindex_ac, aindex_ca
+      end interface
+
+!---- SCAN procedure
+      interface scan
+          module procedure scan_ss, scan_sc, scan_cs
+      end interface
+
+!---- ASCAN procedure
+      interface ascan
+          module procedure ascan_aa, ascan_ac, ascan_ca
+      end interface
+
+!---- VERIFY procedure
+      interface verify
+          module procedure verify_ss, verify_sc, verify_cs
+      end interface
+
+!---- AVERIFY procedure
+      interface averify
+          module procedure averify_aa, averify_ac, averify_ca
+      end interface
+
+!---- TRIM interface
+      interface len_trim
+          module procedure len_trim_s
+      end interface
+
+!---- LEN_TRIM interface
+      interface trim
+          module procedure trim_s
+      end interface
+
+!---- IACHAR interface
+      interface iachar
+          module procedure iachar_s
+      end interface
+
+!---- ICHAR interface
+      interface ichar
+          module procedure ichar_s
+      end interface
+
+!---- ADJUSTL interface
+      interface adjustl
+          module procedure adjustl_s
+      end interface
+
+!---- ADJUSTR interface
+      interface adjustr
+          module procedure adjustr_s
+      end interface
+
+!---- LEN_STRIP interface
+      interface len_strip
+          module procedure len_strip_c, len_strip_s
+      end interface
+
+!---- STRIP interface
+      interface strip
+          module procedure strip_c, strip_s
+      end interface
+
+!---- UPPERCASE interface
+      interface uppercase
+          module procedure uppercase_s, uppercase_c
+      end interface
+
+!---- TO_UPPERCASE interface
+      interface to_uppercase
+          module procedure to_uppercase_s, to_uppercase_c
+      end interface
+
+!---- LOWERCASE interface
+      interface lowercase
+          module procedure lowercase_s, lowercase_c
+      end interface
+
+!---- TO_LOWERCASE interface
+      interface to_lowercase
+          module procedure to_lowercase_s, to_lowercase_c
+      end interface
+
+!---- EXTRACT interface
+      interface extract
+          module procedure extract_s, extract_c
+      end interface
+
+!---- SUBSTRING interface
+      interface substring
+          module procedure extract_s, extract_c
+      end interface
+
+!---- REMOVE interface
+      interface remove
+          module procedure remove_s, remove_c
+      end interface
+
+!---- INSERT interface
+      interface insert
+          module procedure insert_ss, insert_cs, insert_sc, insert_cc
+      end interface
+
+!---- REPLACE interface
+      interface replace
+          module procedure replace_cc_s,   replace_cs_s,   &
+                           replace_sc_s,   replace_ss_s,   &
+                           replace_cc_sf,  replace_cs_sf,  &
+                           replace_sc_sf,  replace_ss_sf,  &
+                           replace_ccc,    replace_csc,    &
+                           replace_ccs,    replace_css,    &
+                           replace_scc,    replace_ssc,    &
+                           replace_scs,    replace_sss,    &
+                           replace_ccc_f,  replace_csc_f,  &
+                           replace_ccs_f,  replace_css_f,  &
+                           replace_scc_f,  replace_ssc_f,  &
+                           replace_scs_f,  replace_sss_f
+      end interface
+
+!---- SORT interface
+      interface sort
+          module procedure sort_c, sort_s
+      end interface
+
+!---- LSORT interface
+      interface lsort
+          module procedure lsort_c, lsort_s
+      end interface
+
+!---- RANK interface
+      interface rank
+          module procedure rank_c, rank_s
+      end interface
+
+!---- LRANK interface
+      interface lrank
+          module procedure lrank_c, lrank_s
+      end interface
+
+
+
+!---- Publically accessible entities
+      public :: string
+      public :: assignment(=),unstring
+      public :: insert,replace,remove,extract,substring
+      public :: repeat,index,scan,verify
+      public :: operator(//)
+      public :: operator(==),operator(/=)
+      public :: operator(<),operator(<=)
+      public :: operator(>),operator(>=)
+      public :: llt,lle,lge,lgt
+      public :: char,len,len_trim,trim,iachar,ichar,adjustl,adjustr
+      public :: lowercase,to_lowercase,uppercase,to_uppercase
+      public :: strip,len_strip
+      public :: sort,rank,lsort,lrank
+
+      public :: resize_string,string_size,swap_strings
+      public :: trim_string,strip_string
+      public :: adjustl_string,adjustr_string
+      public :: insert_in_string,remove_from_string
+      public :: prepend_to_string,append_to_string
+      public :: replace_in_string
+
+
+
+
+      contains
+
+!*******************************************************************************
+!     LEN
+!*******************************************************************************
+
+      elemental function len_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_s
+
+
+      len_s = s%len
+
+      end function len_s
+
+!*******************************************************************************
+!     STRING_SIZE
+!*******************************************************************************
+
+      elemental function string_size(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: string_size
+
+
+      string_size = s%size
+
+      end function string_size
+
+!*******************************************************************************
+!     CHAR
+!*******************************************************************************
+!     Returns the characters of string as an automatically sized character
+
+      pure function s_to_c(s)
+
+      implicit none
+      type(string),intent(in)   :: s
+      character(len(s))         :: s_to_c
+
+
+      s_to_c = transfer(s%chars(1:len(s)),s_to_c)
+
+      end function s_to_c
+
+!*******************************************************************************
+!     Returns the character of fixed length, length, containing the characters
+!     of string either padded with blanks or truncated on the right to fit
+
+      pure function s_to_slc(s,length)
+
+      implicit none
+      type(string),intent(in)  :: s
+      integer, intent(in)      :: length
+      character(length)        :: s_to_slc
+      integer                  :: i,lc
+
+
+      lc = min(len(s),length)
+      s_to_slc(1:lc) = transfer(s%chars(1:lc),s_to_slc)
+
+!     Result longer than string: padding needed
+      if (lc < length) s_to_slc(lc+1:length) = blank
+
+      end function s_to_slc
+
+!*******************************************************************************
+! Assign a string value to a string variable overriding default assignement.
+! Reallocates string variable to size of string value and copies characters.
+
+      elemental subroutine assign_s_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      type(string), intent(in)   :: expr
+
+
+
+      if (associated(var%chars,expr%chars)) then
+!         Identity assignment: nothing to be done
+          continue
+      else
+          if (associated(var%chars)) deallocate(var%chars)
+
+          var%size = expr%size
+          var%len = expr%len
+!AG
+          if (associated(expr%chars)) then
+             allocate(var%chars(1:var%size))
+             var%chars(1:var%len) = expr%chars(1:var%len)
+          endif
+      endif
+
+
+      end subroutine assign_s_to_s
+
+!*******************************************************************************
+! Assign a string value to a character variable.
+! If the string is longer than the character truncate the string on the right.
+! If the string is shorter the character is blank padded on the right.
+
+      elemental subroutine assign_s_to_c(var,expr)
+
+      implicit none
+      character(*), intent(out)  :: var
+      type(string), intent(in)   :: expr
+      integer                    :: i,lc,ls
+
+
+      lc = len(var);
+      ls = min(len(expr),lc)
+
+      var(1:ls) = transfer(expr%chars(1:ls),var(1:ls))
+
+      do i=ls+1,lc
+          var(i:i) = blank
+      enddo
+
+      end subroutine assign_s_to_c
+
+!*******************************************************************************
+!     Assign a character value to a string variable.
+!     Disassociates the string variable from its current value, allocates new
+!     space to hold the characters and copies them from the character value
+!     into this space.
+
+      elemental subroutine assign_c_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      character(*), intent(in)   :: expr
+      integer                    :: i,lc
+
+
+
+      if (associated(var%chars)) deallocate(var%chars)
+
+
+      lc = len(expr)
+      var%len = lc
+      var%size = lc
+      allocate(var%chars(1:lc))
+!!AG: NAG compiler uses temporaries here:
+      var%chars(:) = (/ (expr(i:i), i=1,lc) /)
+
+      endsubroutine assign_c_to_s
+
+!*******************************************************************************
+!     RESIZE_STRING procedure
+!*******************************************************************************
+
+!*** return code
+!*** n < 0  --> deallocate?
+
+!     pure subroutine resize_string(s,newsize,status)
+      pure subroutine resize_string(s,newsize)
+
+      implicit none
+      type(string), intent(inout)     :: s
+      integer, intent(in)             :: newsize
+!     integer, intent(out), optional  :: status
+
+      character, pointer              :: c(:)
+
+      integer                         :: i
+
+
+      if (newsize <= 0) return
+
+
+      if (associated(s%chars)) then
+
+          i = min(newsize,s%len)
+          allocate(c(i))
+          c(:) = s%chars(1:i)
+          deallocate(s%chars)
+
+          s%chars => c
+
+          s%len = i
+          s%size = newsize
+      else
+          s%size = newsize
+          s%len = 0
+          allocate(s%chars(s%size))
+      endif
+
+      end subroutine resize_string
+
+!*******************************************************************************
+!     SWAP_STRINGS
+!*******************************************************************************
+      subroutine swap_strings(s1,s2)
+
+
+      implicit none
+      type(string), intent(inout)  :: s1,s2
+      integer                      :: l,s
+      character, pointer           :: c(:)
+
+
+      l = s1%len
+      s = s1%size
+      c => s1%chars
+      s1%len = s2%len
+      s1%size = s2%size
+      s1%chars => s2%chars
+      s2%len = l
+      s2%size = s
+      s2%chars => c
+
+      end subroutine swap_strings
+
+!*******************************************************************************
+!     TRIM_STRINGSIZE
+!*******************************************************************************
+
+      subroutine trim_stringsize(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      call resize_string(s,len(s))
+
+      end subroutine trim_stringsize
+
+!*******************************************************************************
+!     TRIM_STRING
+!*******************************************************************************
+
+      subroutine trim_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      s%len = len_trim(s)
+
+      end subroutine trim_string
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure subroutine strip_string(s)
+
+     implicit none
+     type(string), intent(inout)  :: s
+     integer                      :: i,i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     do i=i1,i2
+         s%chars(i-i1+1) = s%chars(i)
+     enddo
+     s%len = i2 - i1 + 1
+
+     end subroutine strip_string
+
+!*******************************************************************************
+!     ADJUSTL_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure subroutine adjustl_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j
+
+
+      do i=1,len(s)
+          if (s%chars(i) /= blank) exit
+      enddo
+      do j=i,len(s)
+          s%chars(j-i:j-i) = s%chars(j)
+      enddo
+      s%chars(j+1:) = blank
+
+      end subroutine adjustl_string
+
+!*******************************************************************************
+!     ADJUSTR_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure subroutine adjustr_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j,l,lt
+
+
+      l = len(s)
+      lt = len_trim(s)
+
+      i = l - lt
+
+      do j=1,lt
+          s%chars(j+i:j+i) = s%chars(j)
+      enddo
+      s%chars(1:i) = blank
+
+
+      end subroutine adjustr_string
+
+!*******************************************************************************
+!     PREPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls2
+              ss(i) = s2%chars(i)
+          enddo
+          do i=1,ls1
+              ss(ls2+i) = s1%chars(i)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1,1,-1
+              s1%chars(ls2+i) = s1%chars(i)
+          enddo
+          do i=1,ls2
+              s1%chars(i) = s2%chars(i)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine prepend_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,lc
+              ss(i) = c(i:i)
+          enddo
+          do i=1,ls
+              ss(lc+i) = s%chars(i)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls,1,-1
+              s%chars(lc+i) = s%chars(i)
+          enddo
+          do i=1,lc
+              s%chars(i) = c(i:i)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine prepend_to_string_c
+
+!*******************************************************************************
+!     APPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine append_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ls1+1,ls1+ls2
+              ss(i) = s2%chars(i-ls1)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1+1,ls1+ls2
+              s1%chars(i) = s2%chars(i-ls1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine append_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine append_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,ls
+              ss(i) = s%chars(i)
+          enddo
+          do i=ls+1,ls+lc
+              ss(i) = c(i-ls:i-ls)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls+1,ls+lc
+              s%chars(i) = c(i-ls:i-ls)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine append_to_string_c
+
+!*******************************************************************************
+!     INSERT_IN_STRING
+!*******************************************************************************
+
+      pure subroutine insert_in_string_s(s1,start,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=1,ip-1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ip,ip+ls2-1
+              ss(i) = s2%chars(i-ip+1)
+          enddo
+          do i=ip+ls2,ls1+ls2
+              ss(i) = s1%chars(i-ls2)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=ls1+ls2,ip+ls2,-1
+              s1%chars(i) = s1%chars(i-ls2)
+          enddo
+          do i=ip,ip+ls2-1
+              s1%chars(i) = s2%chars(i-ip+1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine insert_in_string_s
+
+!*******************************************************************************
+
+      pure subroutine insert_in_string_c(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=1,ip-1
+              ss(i) = s%chars(i)
+          enddo
+          do i=ip,ip+lc-1
+              ss(i) = c(i-ip+1:i-ip+1)
+          enddo
+          do i=ip+lc,ls+lc
+              ss(i) = s%chars(i-lc)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=ls+lc,ip+lc,-1
+              s%chars(i) = s%chars(i-lc)
+          enddo
+          do i=ip,ip+lc-1
+              s%chars(i) = c(i-ip+1:i-ip+1)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine insert_in_string_c
+
+!*******************************************************************************
+!     REPLACE_IN_STRING
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_s(s,start,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start
+!
+!
+!     call replace_in_string_sc_s(s,start,char(ss))
+!
+!     end subroutine replace_in_string_ss_s
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_s(s,start,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lr,lss,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_s(s,start,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lss,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lss,1,-1
+          rs(ip-1+i) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_s
+
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start,finish
+!
+!
+!     call replace_in_string_sc_sf(s,start,finish,char(ss))
+!
+!     end subroutine replace_in_string_ss_sf
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lr,ls,lss
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_sf(s,start,finish,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lss+1
+          rs(i+ip+lss-1) = s%chars(if+i)
+      enddo
+      do i=lss,1,-1
+          rs(i+ip-1) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_sf
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_s(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_s(s,start,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lc,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lc,1,-1
+          rs(ip-1+i) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_s
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_sf(s,start,finish,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_sf(s,start,finish,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lc+1
+          rs(i+ip+lc-1) = s%chars(if+i)
+      enddo
+      do i=lc,1,-1
+          rs(i+ip-1) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_sf
+
+!*******************************************************************************
+!*******************************************************************************
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss
+
+
+      call x_replace_in_string_scc(s,target,ss,'first')
+
+
+      end subroutine replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+
+
+      call x_replace_in_string_scc(s,target,ss,action)
+
+      end subroutine replace_in_string_scc_f
+
+!*******************************************************************************
+
+      pure subroutine x_replace_in_string_scc(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+      logical                      :: every,back
+      integer                      :: lr,ls,lt,lss
+      integer                      :: i,i1,i2,k1,k2,m1,m2
+
+      character, pointer           :: rs(:)
+
+
+
+      lr = lr_scc(s,target,ss,action)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              do i=1,lss
+                  s%chars(i) = ss(i:i)
+              enddo
+              s%len = lss
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      allocate(rs(lr))
+
+      if (back) then
+!         Backwards search
+
+!         k2 points to the absolute position one before the target in string
+          k2 = ls
+          m2 = lr
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk after it
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              rs(m1:m2) = s%chars(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+          enddo
+      else
+!         Forward search
+
+!         k1 points to the absolute position one after target in string
+          k1 = 1
+          m1 = 1
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+              i1 = k1 + (i1 - 1)
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk before it
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              rs(m1:m2) = s%chars(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+          enddo
+      endif
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      s%chars => rs
+
+      s%len = lr
+      s%size = size(s%chars)
+
+      end subroutine x_replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss
+
+
+      call x_replace_in_string_scc(s,char(target),ss,'first')
+
+      end subroutine replace_in_string_ssc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss,action
+
+
+      call x_replace_in_string_scc(s,char(target),ss,action)
+
+      end subroutine replace_in_string_ssc_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target
+
+
+      call x_replace_in_string_scc(s,target,char(ss),'first')
+
+      end subroutine replace_in_string_scs
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target,action
+
+
+      call x_replace_in_string_scc(s,target,char(ss),action)
+
+      end subroutine replace_in_string_scs_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),'first')
+
+      end subroutine replace_in_string_sss
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+      character(*), intent(in)     :: action
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),action)
+
+      end subroutine replace_in_string_sss_f
+
+!*******************************************************************************
+!     REMOVE_FROM_STRING
+!*******************************************************************************
+
+      pure subroutine remove_from_string(s,start,finish)
+
+      implicit none
+      type(string), intent(inout)                      :: s
+      integer, intent(in)                              :: start,finish
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) return
+
+      le = if - is + 1            ! = len_extract
+      do i=if+1,ls
+          s%chars(i-le) = s%chars(i)
+      enddo
+      s%len = s%len - le
+
+      end subroutine remove_from_string
+
+!*******************************************************************************
+!     UNSTRING procedure
+!*******************************************************************************
+!     Deallocate the chars in the string to avoid leaking of memory
+!     Use this in functions and subroutines on locally declared variables
+!     of type string after their use. (I.e. garbage collecting).
+
+      elemental subroutine unstring(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      nullify(s%chars)
+
+      s%size = 0
+      s%len = 0
+
+      end subroutine unstring
+
+!*******************************************************************************
+!     //
+!*******************************************************************************
+!     string // string
+
+      pure function s_concat_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      character(len(s1)+len(s2))  :: s_concat_s
+      integer                     :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      s_concat_s(1:l1) = s1
+      s_concat_s(1+l1:l1+l2) = s2
+
+      end function s_concat_s
+
+!*******************************************************************************
+!     string // character
+
+      pure function s_concat_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      character(len(s)+len(c))  :: s_concat_c
+      integer                   :: ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      s_concat_c(1:ls) = s
+      s_concat_c(1+ls:ls+lc) = c
+
+      end function s_concat_c
+
+!*******************************************************************************
+!     character // string
+
+      pure function c_concat_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(len(s)+len(c))  :: c_concat_s
+      integer                   :: lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      c_concat_s(1:lc) = c
+      c_concat_s(1+lc:lc+ls) = s
+
+      end function c_concat_s
+
+!*******************************************************************************
+!     REPEAT
+!*******************************************************************************
+
+      function repeat_s(s,ncopies)
+
+      implicit none
+      type(string), intent(in)   :: s
+      integer, intent(in)        :: ncopies
+      character(ncopies*len(s))  :: repeat_s
+
+
+      if (ncopies < 0) stop 'Negative ncopies requested in REPEAT'
+      repeat_s = repeat(char(s),ncopies)
+
+      end function repeat_s
+
+!*******************************************************************************
+!     LEN_TRIM
+!*******************************************************************************
+
+      elemental function len_trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_trim_s
+
+      if (len(s) == 0) then
+        len_trim_s = 0
+        return
+      endif
+      do len_trim_s = len(s),1,-1
+          if (s%chars(len_trim_s) /= blank) return
+      end do
+
+      end function len_trim_s
+
+!*******************************************************************************
+!     TRIM
+!*******************************************************************************
+
+      pure function trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len_trim(s))    :: trim_s
+      integer                   :: i
+
+
+      do i=1,len(trim_s)
+          trim_s(i:i) = s%chars(i)
+      enddo
+
+      end function trim_s
+
+!*******************************************************************************
+!     IACHAR
+!*******************************************************************************
+! Returns the position of the character string in the ISO 646 collating
+! sequence. String must be of length one, otherwise result is as for
+! intrinsic iachar.
+
+      elemental function iachar_s(s)
+
+      implicit none
+      type(string), intent(in) :: s
+      integer                  :: iachar_s
+
+
+      iachar_s = iachar(char(s))
+
+      end function iachar_s
+
+!*******************************************************************************
+!     ICHAR
+!*******************************************************************************
+! Returns the position of character from string in the processor collating
+! sequence. String must be of length one, otherwise it will behave as the
+! intrinsic ichar with the equivalent character string.
+
+      elemental function ichar_s(s)
+
+      implicit none
+      type(string), intent(in) ::  s
+      integer                  ::  ichar_s
+
+
+      ichar_s = ichar(char(s))
+
+      end function ichar_s
+
+!*******************************************************************************
+!     ADJUSTL
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure function adjustl_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustl_s
+
+
+      adjustl_s = adjustl(char(s))
+
+      end function adjustl_s
+
+!*******************************************************************************
+!     ADJUSTR
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure function adjustr_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustr_s
+
+
+      adjustr_s = adjustr(char(s))
+
+      end function adjustr_s
+
+!*******************************************************************************
+!    LEN_STRIP
+!*******************************************************************************
+
+     elemental function len_strip_s(s)
+
+     implicit none
+     type(string), intent(in) :: s
+     integer                  :: len_strip_s
+     integer                  :: i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     len_strip_s = max(0,i2-i1+1)
+
+     end function len_strip_s
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure function strip_s(s)
+
+     implicit none
+     type(string), intent(in)  :: s
+     character(len_strip(s))   :: strip_s
+     integer                   :: i,j
+
+
+     do i=1,len(s)
+         if (s%chars(i) /= blank) exit
+     enddo
+     do j=1,len(strip_s)
+         strip_s(j:j) = s%chars(i+j-1)
+     enddo
+
+     end function strip_s
+
+!*******************************************************************************
+
+     elemental function len_strip_c(c)
+
+     implicit none
+     character(*), intent(in) :: c
+     integer                  :: len_strip_c
+     integer                  :: i1,i2
+
+
+     do i1=1,len(c)
+         if (c(i1:i1) /= blank) exit
+     enddo
+     i2 = len_trim(c)
+     len_strip_c = max(0,i2-i1+1)
+
+     end function len_strip_c
+
+!*******************************************************************************
+
+     pure function strip_c(c)
+
+     implicit none
+     character(*), intent(in)  :: c
+     character(len_strip(c))   :: strip_c
+     integer                   :: i
+
+
+     do i=1,len(c)
+         if (c(i:i) /= blank) exit
+     enddo
+     strip_c(1:) = c(i:)
+
+     end function strip_c
+
+!*******************************************************************************
+!     EXTRACT
+!*******************************************************************************
+      elemental FUNCTION len_extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_s
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          len_extract_s = 0
+      else
+          len_extract_s = max(0,if-is) + 1
+      endif
+
+      end function len_extract_s
+
+!*****************************************************
+      pure function extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                  :: s
+      integer, intent(in)                       :: start,finish
+      character(len_extract_s(s,start,finish))  :: extract_s
+      integer                                   :: i,is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          extract_s = ''
+      else
+          do i=1,max(0,if-is+1)
+              extract_s(i:i) = s%chars(is+i-1)
+          enddo
+      endif
+
+      end function extract_s
+
+!*******************************************************************************
+
+!      elemental FUNCTION len_extract_s(s,start,finish)
+
+!      implicit none
+!      type(string), intent(in)  :: s
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_s
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(s),finish)
+!      if (if < is) then
+!          len_extract_s = 0
+!      else
+!          len_extract_s = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_s
+
+!*******************************************************************************
+
+      elemental function len_extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)  :: c
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_c
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          len_extract_c = 0
+      else
+          len_extract_c = max(0,if-is) + 1
+      endif
+
+      end function len_extract_c
+
+!*******************************************************************************
+
+      pure function extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                  :: c
+      integer, intent(in)                       :: start,finish
+      character(len_extract_c(c,start,finish))  :: extract_c
+      integer                                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          extract_c = ''
+      else
+          extract_c(1:if-is+1) = c(is:if)
+      endif
+
+      end function extract_c
+
+!*******************************************************************************
+
+!      elemental function len_extract_c(c,start,finish)
+
+!      implicit none
+!      character(*), intent(in)  :: c
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_c
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(c),finish)
+!      if (if < is) then
+!          len_extract_c = 0
+!      else
+!          len_extract_c = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_c
+
+!*******************************************************************************
+!     INSERT
+!*******************************************************************************
+
+      pure function insert_ss(s1,start,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      integer, intent(in)         :: start
+      character(len(s1)+len(s2))  :: insert_ss
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_ss(i:i) = s1%chars(i)
+      enddo
+      do i=ip,ip+ls2-1
+          insert_ss(i:i) = s2%chars(i-ip+1)
+      enddo
+      do i=ip+ls2,ls1+ls2
+          insert_ss(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_ss
+
+!*******************************************************************************
+
+      pure function insert_sc(s1,start,c2)
+
+      implicit none
+      type(string), intent(in)    :: s1
+      character(*), intent(in)    :: c2
+      integer, intent(in)         :: start
+      character(len(s1)+len(c2))  :: insert_sc
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_sc(i:i) = s1%chars(i)
+      enddo
+      insert_sc(ip:ip+ls2-1) = c2
+      do i=ip+ls2,ls1+ls2
+          insert_sc(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_sc
+
+!*******************************************************************************
+
+      pure function insert_cs(c1,start,s2)
+
+      implicit none
+      character(*), intent(in)    :: c1
+      type(string), intent(in)    :: s2
+      integer, intent(in)         :: start
+      character(len(c1)+len(s2))  :: insert_cs
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cs(1:ip-1) = c1(1:ip-1)
+      do i=ip,ip+ls2-1
+          insert_cs(i:i) = s2%chars(i-ip+1)
+      enddo
+      insert_cs(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cs
+
+!*******************************************************************************
+
+      pure function insert_cc(c1,start,c2)
+
+      implicit none
+      character(*), intent(in)    :: c1,c2
+      integer, intent(in)         :: start
+      character(len(c1)+len(c2))  :: insert_cc
+      integer                     :: ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cc(1:ip-1) = c1(1:ip-1)
+      insert_cc(ip:ip+ls2-1) = c2
+      insert_cc(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cc
+
+!*******************************************************************************
+!     REMOVE
+!*******************************************************************************
+
+      pure function remove_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                         :: c
+      integer, intent(in)                              :: start,finish
+      character(len(c)-len_extract_c(c,start,finish))  :: remove_c
+      integer                                          :: if,is,ls
+
+
+      is = max(1,start)
+      ls = len(c)
+      if = min(ls,finish)
+      if (if < is) then
+          remove_c = c
+      else
+          remove_c = c(1:is-1) // c(if+1:)
+      endif
+
+      end function remove_c
+
+!*******************************************************************************
+
+      pure function remove_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                         :: s
+      integer, intent(in)                              :: start,finish
+      character(len(s)-len_extract_s(s,start,finish))  :: remove_s
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) then
+           remove_s = s
+      else
+          le = if - is + 1
+          do i=1,is-1
+              remove_s(i:i) = s%chars(i)
+          enddo
+          do i=if+1,ls
+              remove_s(i-le:i-le) = s%chars(i)
+          enddo
+      endif
+
+      end function remove_s
+
+!*******************************************************************************
+!     REPLACE
+!*******************************************************************************
+
+      pure function lr_cc_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cc_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_cc_s(s,start,ss))  :: r
+      integer                         :: ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = ss
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cc_s
+
+!*******************************************************************************
+
+      pure function lr_cc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cc_sf
+
+!*******************************************************************************
+
+      pure function lr_cs_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cs_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cs_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s
+      type(string), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_cs_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cs_s
+
+!*******************************************************************************
+
+      pure function lr_cs_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cs_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cs_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s
+      type(string), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cs_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+
+      r(i+ip:i+ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cs_sf
+
+!*******************************************************************************
+
+      pure function lr_sc_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_sc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_sc_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s
+      character(*), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_sc_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_sc_s
+
+!*******************************************************************************
+
+      pure function lr_sc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_sc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_sc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_sc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      r(ip:ip+lss-1) = ss
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_sc_sf
+
+!*******************************************************************************
+
+      pure function lr_ss_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_ss_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_ss_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_ss_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(ip-1+i:ip-1+i) = ss%chars(i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_ss_s
+
+!*******************************************************************************
+
+      pure function lr_ss_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_ss_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_ss_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_ss_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_ss_sf
+
+!*******************************************************************************
+
+      pure function lr_ccc(s,target,ss,action) result(l)
+
+      implicit none
+      character(*), intent(in)       :: s,target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = index(s(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = index(s(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+              ipos = ipos + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_ccc
+
+!*******************************************************************************
+
+      function replace_ccc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,target,ss
+      character(lr_ccc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,target,ss,'first',r)
+
+      end function replace_ccc
+
+!*******************************************************************************
+
+      function replace_ccc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(lr_ccc(s,target,ss,action))  :: r
+
+
+      call x_replace_ccc(s,target,ss,action,r)
+
+      end function replace_ccc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_ccc(s,target,ss,action,r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = index(s(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = s(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not. every) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = index(s(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = s(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not. every) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_ccc
+
+!*******************************************************************************
+
+      function replace_csc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,ss
+      type(string), intent(in)                      :: target
+      character(lr_ccc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,'first',r)
+
+      end function replace_csc
+
+!*******************************************************************************
+
+      function replace_csc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,ss,action
+      type(string), intent(in)                     :: target
+      character(lr_ccc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,action,r)
+
+      end function replace_csc_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_ccs(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,target
+      type(string), intent(in)                      :: ss
+      character(lr_ccc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),'first',r)
+
+      end function replace_ccs
+
+!*******************************************************************************
+
+      function replace_ccs_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,target,action
+      type(string), intent(in)                     :: ss
+      character(lr_ccc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),action,r)
+
+      end function replace_ccs_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_css(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                            :: s
+      type(string), intent(in)                            :: ss,target
+      character(lr_ccc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),'first',r)
+
+      end function replace_css
+
+!*******************************************************************************
+
+      function replace_css_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                           :: s,action
+      type(string), intent(in)                           :: ss,target
+      character(lr_ccc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),action,r)
+
+      end function replace_css_f
+
+!*******************************************************************************
+!*******************************************************************************
+      pure function lr_scc(s,target,ss,action) result(l)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = aindex(s%chars(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = aindex(s%chars(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_scc
+
+!*******************************************************************************
+
+      function replace_scc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: target,ss
+      character(lr_scc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_scc(s,target,ss,'first',r)
+
+
+      end function replace_scc
+
+!*******************************************************************************
+
+      function replace_scc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(lr_scc(s,target,ss,action))  :: r
+
+
+      call x_replace_scc(s,target,ss,action,r)
+
+      end function replace_scc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_scc(s,target,ss,action,r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_scc
+
+!*******************************************************************************
+
+      function replace_ssc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,target
+      character(*), intent(in)                      :: ss
+      character(lr_scc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,'first',r)
+
+
+      end function replace_ssc
+
+!*******************************************************************************
+
+      function replace_ssc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,target
+      character(*), intent(in)                     :: ss,action
+      character(lr_scc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,action,r)
+
+      end function replace_ssc_f
+
+!*******************************************************************************
+
+      function replace_scs(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,ss
+      character(*), intent(in)                      :: target
+      character(lr_scc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),'first',r)
+
+      end function replace_scs
+
+!*******************************************************************************
+
+      function replace_scs_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,ss
+      character(*), intent(in)                     :: target,action
+      character(lr_scc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),action,r)
+
+      end function replace_scs_f
+
+!*******************************************************************************
+
+      function replace_sss(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                            :: s,ss,target
+      character(lr_scc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),'first',r)
+
+      end function replace_sss
+
+!*******************************************************************************
+
+      function replace_sss_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                           :: s,ss,target
+      character(*), intent(in)                           :: action
+      character(lr_scc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),action,r)
+
+      end function replace_sss_f
+
+!*******************************************************************************
+!     SORT, LSORT
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (a(i) > t) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (a(j) < t) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (a(i) > t) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (a(i) <= t) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine sort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (a(i) > t) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (a(j) < t) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (a(i) > t) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (a(i) <= t) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine sort_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine lsort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (lgt(a(i),t)) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (llt(a(j),t)) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (lgt(a(i),t)) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine lsort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lsort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (lgt(a(i),t)) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (llt(a(j),t)) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (lgt(a(i),t)) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lsort_s
+
+!*******************************************************************************
+!     RANK, LRANK
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine rank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine rank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine rank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine rank_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (llt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine lrank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (lgt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lrank_s
+
+!*******************************************************************************
+!     COMPARE, LCOMPARE, ACOMPARE, ALCOMPARE
+!*******************************************************************************
+!*******************************************************************************
+
+      elemental function compare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (s1%chars(i) < s2%chars(i)) then
+              css = 'LT'
+              return
+          elseif (s1%chars(i) > s2%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < s2%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s2%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (s1%chars(i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (s1%chars(i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_ss
+
+!*******************************************************************************
+
+      elemental function compare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) < s%chars(i)) then
+              css = 'LT'
+              return
+          elseif (c(i:i) > s%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (blank < s%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (c(i:i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_cs
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! string == string
+
+      elemental function s_eq_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_eq_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_eq_s = all(s1%chars(1:l2) == s2%chars) .and.  &
+                   all(s1%chars(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          s_eq_s = all(s1%chars == s2%chars(1:l1)) .and.  &
+                   all(blank == s2%chars(l1+1:l2))
+      else
+          s_eq_s = all(s1%chars == s2%chars)
+      endif
+
+      end function s_eq_s
+
+!*******************************************************************************
+! string == character
+
+      elemental function s_eq_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_eq_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i)) then
+              s_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(lc+1:ls) /= blank)) then
+          s_eq_c = .false.
+      elseif ((ls < lc) .and. (blank /= c(ls+1:lc))) then
+          s_eq_c = .false.
+      else
+          s_eq_c = .true.
+      endif
+
+      end function s_eq_c
+
+!*******************************************************************************
+! character == string
+
+      elemental function c_eq_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_eq_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_eq_s = .false.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. (c(ls+1:lc) /= blank)) then
+          c_eq_s = .false.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls) ) )then
+          c_eq_s = .false.
+      else
+          c_eq_s = .true.
+      endif
+
+      end function c_eq_s
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! string /= string
+
+      elemental function s_ne_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_ne_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_ne_s = any(s1%chars(1:l2) /= s2%chars) .or.  &
+                   any(s1%chars(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          s_ne_s = any(s1%chars /= s2%chars(1:l1)) .or. &
+                   any(blank /= s2%chars(l1+1:l2))
+      else
+          s_ne_s = any(s1%chars /= s2%chars)
+      endif
+
+      end function s_ne_s
+
+!*******************************************************************************
+! string /= character
+
+      elemental function s_ne_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ne_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i) )then
+              s_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(ls+1:lc) /= blank)) then
+          s_ne_c = .true.
+      elseif ((ls < lc) .and. blank /= c(ls+1:lc)) then
+          s_ne_c = .true.
+      else
+          s_ne_c = .false.
+      endif
+
+      end function s_ne_c
+
+!*******************************************************************************
+! character /= string
+
+      elemental function c_ne_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ne_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_ne_s = .true.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. c(ls+1:lc) /= blank) then
+          c_ne_s = .true.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls))) then
+          c_ne_s = .true.
+      else
+          c_ne_s = .false.
+      endif
+
+      end function c_ne_s
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! string < string
+
+      elemental function s_lt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lt_s
+
+
+      s_lt_s = compare_ss(s1,s2) == 'LT'
+
+      end function s_lt_s
+
+!*******************************************************************************
+! string < character
+
+      elemental function s_lt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_lt_c
+
+
+      s_lt_c = compare_cs(c,s) == 'GT'
+
+      end function s_lt_c
+
+!*******************************************************************************
+! character < string
+
+      elemental function c_lt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_lt_s
+
+
+      c_lt_s = compare_cs(c,s) == 'LT'
+
+      end function c_lt_s
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! string <= string
+
+      elemental function s_le_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_le_s
+
+
+      s_le_s = compare_ss(s1,s2) /= 'GT'
+
+      end function s_le_s
+
+!*******************************************************************************
+! string <= character
+
+      elemental function s_le_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_le_c
+
+
+      s_le_c = compare_cs(c,s) /= 'LT'
+
+      end function s_le_c
+
+!*******************************************************************************
+! character <= string
+
+      elemental function c_le_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_le_s
+
+
+      c_le_s = compare_cs(c,s) /= 'GT'
+
+      end function c_le_s
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! string >= string
+
+      elemental function s_ge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_ge_s
+
+
+      s_ge_s = compare_ss(s1,s2) /= 'LT'
+
+      end function s_ge_s
+
+!*******************************************************************************
+! string >= character
+
+      elemental function s_ge_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ge_c
+
+
+      s_ge_c = compare_cs(c,s) /= 'GT'
+
+      end function s_ge_c
+
+!*******************************************************************************
+! character >= string
+
+      elemental function c_ge_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ge_s
+
+
+      c_ge_s = compare_cs(c,s) /= 'LT'
+
+      end function c_ge_s
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! string > string
+
+      elemental function s_gt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_gt_s
+
+
+      s_gt_s = compare_ss(s1,s2) == 'GT'
+
+      end function s_gt_s
+
+!*******************************************************************************
+! string > character
+
+      elemental function s_gt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_gt_c
+
+
+      s_gt_c = compare_cs(c,s) == 'LT'
+
+      end function s_gt_c
+
+!*******************************************************************************
+! character > string
+
+      elemental function c_gt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_gt_s
+
+
+      c_gt_s = compare_cs(c,s) == 'GT'
+
+      end function c_gt_s
+
+!*******************************************************************************
+
+      elemental function lcompare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (llt(s1%chars(i),s2%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(s1%chars(i),s2%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,s2%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s2%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(s1%chars(i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(s1%chars(i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_ss
+
+!*******************************************************************************
+
+      elemental function lcompare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (llt(c(i:i),s%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(c(i:i),s%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (llt(blank,s%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (llt(c(i:i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_cs
+
+!*******************************************************************************
+!     LLT function
+!*******************************************************************************
+!     llt(string,string)
+
+      elemental function s_llt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_llt_s
+
+      s_llt_s = (lcompare_ss(s1,s2) == 'LT')
+
+      end function s_llt_s
+
+!*******************************************************************************
+!     llt(string,character)
+
+      elemental function s_llt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_llt_c
+
+      s_llt_c = (lcompare_cs(c2,s1) == 'GT')
+
+      end function s_llt_c
+
+!*******************************************************************************
+!     llt(character,string)
+
+      elemental function c_llt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_llt_s
+
+      c_llt_s = (lcompare_cs(c1,s2) == 'LT')
+
+      end function c_llt_s
+
+!*******************************************************************************
+!     LGT function
+!*******************************************************************************
+!     lgt(string,string)
+
+      elemental function s_lgt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lgt_s
+
+      s_lgt_s = (lcompare_ss(s1,s2) == 'GT')
+
+      end function s_lgt_s
+
+!*******************************************************************************
+!     lgt(string,character)
+
+      elemental function s_lgt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lgt_c
+
+      s_lgt_c = (lcompare_cs(c2,s1) == 'LT')
+
+      end function s_lgt_c
+
+!*******************************************************************************
+!     lgt(character,string)
+
+      elemental function c_lgt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lgt_s
+
+      c_lgt_s = (lcompare_cs(c1,s2) == 'GT')
+
+      end function c_lgt_s
+
+!*******************************************************************************
+!     LGE function
+!*******************************************************************************
+!     lge(string,string)
+
+      elemental function s_lge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lge_s
+
+      s_lge_s = (lcompare_ss(s1,s2) /= 'LT')
+
+      end function s_lge_s
+
+!*******************************************************************************
+!     lge(string,character)
+
+      elemental function s_lge_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lge_c
+
+      s_lge_c = (lcompare_cs(c2,s1) /= 'GT')
+
+      end function s_lge_c
+
+!*******************************************************************************
+!     lge(character,string)
+
+      elemental function c_lge_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lge_s
+
+      c_lge_s = (lcompare_cs(c1,s2) /= 'LT')
+
+      end function c_lge_s
+
+!*******************************************************************************
+!     LLE function
+!*******************************************************************************
+!     lle(string,string)
+
+      elemental function s_lle_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lle_s
+
+      s_lle_s = (lcompare_ss(s1,s2) /= 'GT')
+
+      end function s_lle_s
+
+!*******************************************************************************
+!     lle(string,character)
+
+      elemental function s_lle_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lle_c
+
+      s_lle_c = (lcompare_cs(c2,s1) /= 'LT')
+
+      end function s_lle_c
+
+!*******************************************************************************
+!     lle(character,string)
+
+      elemental function c_lle_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lle_s
+
+      c_lle_s = (lcompare_cs(c1,s2) /= 'GT')
+
+      end function c_lle_s
+
+!*******************************************************************************
+
+      pure function acompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (a1(i) < a2(i)) then
+              caa = 'LT'
+              return
+          elseif (a1(i) > a2(i)) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < a2(i)) then
+                  caa = 'LT'
+                  return
+              elseif (blank > a2(i)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (a1(i) < blank) then
+                  caa = 'LT'
+                  return
+              elseif (a1(i) > blank) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function acompare_aa
+
+!*******************************************************************************
+
+      pure function acompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (c(i:i) < a(i)) then
+              cca = 'LT'
+              return
+          elseif (c(i:i) > a(i)) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (blank < a(i)) then
+                  cca = 'LT'
+                  return
+              elseif (blank > a(i)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (c(i:i) < blank) then
+                  cca = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function acompare_ca
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! array == array
+
+      pure function a_eq_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_eq_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_eq_a = all(a1(1:l2) == a2) .and.  &
+                   all(a1(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          a_eq_a = all(a1 == a2(1:l1)) .and.  &
+                   all(blank == a2(l1+1:l2))
+      else
+          a_eq_a = all(a1 == a2)
+      endif
+
+      end function a_eq_a
+
+!*******************************************************************************
+! array == character
+
+      pure function a_eq_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_eq_c
+      integer                   :: i,la,lc
+
+
+      la = len(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i)) then
+              a_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(lc+1:la) /= blank)) then
+          a_eq_c = .false.
+      elseif ((la < lc) .and. (blank /= c(la+1:lc))) then
+          a_eq_c = .false.
+      else
+          a_eq_c = .true.
+      endif
+
+      end function a_eq_c
+
+!*******************************************************************************
+! character == array
+
+      pure function c_eq_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_eq_a
+
+
+      c_eq_a = a_eq_c(a,c)
+
+      end function c_eq_a
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! array /= array
+
+      pure function a_ne_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ne_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_ne_a = any(a1(1:l2) /= a2) .or.  &
+                   any(a1(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          a_ne_a = any(a1 /= a2(1:l1)) .or. &
+                   any(blank /= a2(l1+1:l2))
+      else
+          a_ne_a = any(a1 /= a2)
+      endif
+
+      end function a_ne_a
+
+!*******************************************************************************
+! array /= character
+
+      pure function a_ne_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ne_c
+      integer                   :: i,la,lc
+
+
+      la = size(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i) )then
+              a_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(la+1:lc) /= blank)) then
+          a_ne_c = .true.
+      elseif ((la < lc) .and. blank /= c(la+1:lc)) then
+          a_ne_c = .true.
+      else
+          a_ne_c = .false.
+      endif
+
+      end function a_ne_c
+
+!*******************************************************************************
+! character /= array
+
+      pure function c_ne_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ne_a
+
+
+      c_ne_a = acompare_ca(c,a) /= 'EQ'
+
+      end function c_ne_a
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! array < array
+
+      pure function a_lt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_lt_a
+
+
+      a_lt_a = acompare_aa(a1,a2) == 'LT'
+
+      end function a_lt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_lt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_lt_c
+
+
+      a_lt_c = acompare_ca(c,a) == 'GT'
+
+      end function a_lt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_lt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_lt_a
+
+
+      c_lt_a = acompare_ca(c,a) == 'LT'
+
+      end function c_lt_a
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_le_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_le_a
+
+
+      a_le_a = acompare_aa(a1,a2) /= 'GT'
+
+      end function a_le_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_le_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_le_c
+
+
+      a_le_c = acompare_ca(c,a) /= 'LT'
+
+      end function a_le_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_le_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_le_a
+
+
+      c_le_a = acompare_ca(c,a) /= 'GT'
+
+      end function c_le_a
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_ge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ge_a
+
+
+      a_ge_a = acompare_aa(a1,a2) /= 'LT'
+
+      end function a_ge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_ge_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ge_c
+
+
+      a_ge_c = acompare_ca(c,a) /= 'GT'
+
+      end function a_ge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_ge_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ge_a
+
+
+      c_ge_a = acompare_ca(c,a) /= 'LT'
+
+      end function c_ge_a
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_gt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_gt_a
+
+
+      a_gt_a = acompare_aa(a1,a2) == 'GT'
+
+      end function a_gt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_gt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_gt_c
+
+
+      a_gt_c = acompare_ca(c,a) == 'LT'
+
+      end function a_gt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_gt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_gt_a
+
+
+      c_gt_a = acompare_ca(c,a) == 'GT'
+
+      end function c_gt_a
+
+!*******************************************************************************
+
+      pure function alcompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (llt(a1(i),a2(i))) then
+              caa = 'LT'
+              return
+          elseif (lgt(a1(i),a2(i))) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,a2(i))) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(blank,a2(i))) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(a1(i),blank)) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(a1(i),blank)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function alcompare_aa
+
+!*******************************************************************************
+
+      pure function alcompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (llt(c(i:i),a(i))) then
+              cca = 'LT'
+              return
+          elseif (lgt(c(i:i),a(i))) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (llt(blank,a(i))) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(blank,a(i))) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (llt(c(i:i),blank)) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function alcompare_ca
+
+!*******************************************************************************
+!     LLT operators
+!*******************************************************************************
+! array < array
+
+      pure function a_allt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_allt_a
+
+
+      a_allt_a = alcompare_aa(a1,a2) == 'LT'
+
+      end function a_allt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_allt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_allt_c
+
+
+      a_allt_c = alcompare_ca(c2,a1) == 'GT'
+
+      end function a_allt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_allt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_allt_a
+
+
+      c_allt_a = alcompare_ca(c1,a2) == 'LT'
+
+      end function c_allt_a
+
+!*******************************************************************************
+!     LLE  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_alle_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alle_a
+
+
+      a_alle_a = alcompare_aa(a1,a2) /= 'GT'
+
+      end function a_alle_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_alle_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alle_c
+
+
+      a_alle_c = alcompare_ca(c2,a1) /= 'LT'
+
+      end function a_alle_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_alle_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alle_a
+
+
+      c_alle_a = alcompare_ca(c1,a2) /= 'GT'
+
+      end function c_alle_a
+
+!*******************************************************************************
+!     LGE  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_alge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alge_a
+
+
+      a_alge_a = alcompare_aa(a1,a2) /= 'LT'
+
+      end function a_alge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_alge_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alge_c
+
+
+      a_alge_c = alcompare_ca(c2,a1) /= 'GT'
+
+      end function a_alge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_alge_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alge_a
+
+
+      c_alge_a = alcompare_ca(c1,a2) /= 'LT'
+
+      end function c_alge_a
+
+!*******************************************************************************
+!     LGT  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_algt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_algt_a
+
+
+      a_algt_a = alcompare_aa(a1,a2) == 'GT'
+
+      end function a_algt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_algt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_algt_c
+
+
+      a_algt_c = alcompare_ca(c2,a1) == 'LT'
+
+      end function a_algt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_algt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_algt_a
+
+
+      c_algt_a = alcompare_ca(c1,a2) == 'GT'
+
+      end function c_algt_a
+
+!*******************************************************************************
+!     INDEX
+!*******************************************************************************
+
+      elemental function index_ss(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s,sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lsub
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lsub = len(sub)
+      index_ss = aindex(s%chars(:ls),sub%chars(:lsub),dir_switch)
+
+      end function index_ss
+
+!*******************************************************************************
+
+      elemental function index_sc(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      index_sc = aindex(s%chars(:ls),sub,dir_switch)
+
+      end function index_sc
+
+!*******************************************************************************
+
+      elemental function index_cs(s,sub,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_cs
+      logical                        :: dir_switch
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      index_cs = index(s,char(sub),dir_switch)
+
+      end function index_cs
+
+!*******************************************************************************
+!     AINDEX
+!*******************************************************************************
+
+      pure function aindex_aa(s,sub,back) result(index_aa)
+
+      implicit none
+      character, intent(in)          :: s(:),sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_aa = ls + 1
+          else
+              index_aa = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+!         backwards search
+          do i=ls-lss+1,1,-1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      else
+!         forward search
+          do i=1,ls-lss+1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      endif
+
+      end function aindex_aa
+
+!*******************************************************************************
+
+      pure function aindex_ac(s,sub,back) result(index_ac)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = len(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ac = ls + 1
+          else
+              index_ac = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          index_ac = 0
+          do i=ls-lss+1,1,-1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      else
+          index_ac = 0
+          do i=1,ls-lss+1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      endif
+
+      end function aindex_ac
+
+!*******************************************************************************
+
+      pure function aindex_ca(s,sub,back) result(index_ca)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ca = ls + 1
+          else
+              index_ca = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          do i=ls-lss+1,1,-1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      else
+          do i=1,ls-lss+1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      endif
+
+      end function aindex_ca
+
+!*******************************************************************************
+!     SCAN
+!*******************************************************************************
+
+      elemental function scan_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      scan_ss = ascan_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function scan_ss
+
+!*******************************************************************************
+
+      elemental function scan_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      scan_sc = ascan_ac(s%chars(1:ls),set,dir_switch)
+
+      end function scan_sc
+
+!*******************************************************************************
+
+      elemental function scan_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      scan_cs = ascan_ca(s,set%chars(1:lset),dir_switch)
+
+      end function scan_cs
+!*******************************************************************************
+!     ASCAN
+!*******************************************************************************
+
+      pure function ascan_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      endif
+
+      end function ascan_aa
+
+!*******************************************************************************
+
+      pure function ascan_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      endif
+
+      end function ascan_ac
+
+!*******************************************************************************
+
+      pure function ascan_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      endif
+
+      end function ascan_ca
+
+!*******************************************************************************
+!     VERIFY
+!*******************************************************************************
+
+      elemental function verify_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      verify_ss = averify_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function verify_ss
+
+!*******************************************************************************
+
+      elemental function verify_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      verify_sc = averify_ac(s%chars(1:ls),set,dir_switch)
+
+      end function verify_sc
+
+!*******************************************************************************
+
+      elemental function verify_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      verify_cs = averify_ca(s,set%chars(1:lset),dir_switch)
+
+      end function verify_cs
+
+!*******************************************************************************
+!     AVERIFY
+!*******************************************************************************
+
+      pure function averify_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      endif
+
+      end function averify_aa
+
+!*******************************************************************************
+
+      pure function averify_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ac
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle b
+              enddo
+              averify_ac = i
+              return
+          enddo b
+          averify_ac = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle f
+              enddo
+              averify_ac = i
+              return
+          enddo f
+          averify_ac = 0
+      endif
+
+      end function averify_ac
+
+!*******************************************************************************
+
+      pure function averify_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ca
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle b
+              enddo
+              averify_ca = i
+              return
+          enddo b
+          averify_ca = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle f
+              enddo
+              averify_ca = i
+              return
+          enddo f
+          averify_ca = 0
+      endif
+
+      end function averify_ca
+
+!*******************************************************************************
+!     UPPERCASE
+!*******************************************************************************
+
+      pure function uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: uppercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              uppercase_s(i:i) = achar(j-32)
+          case default
+              uppercase_s(1:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function uppercase_s
+
+!*******************************************************************************
+
+      pure function uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: uppercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      uppercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              uppercase_c(i:i) = achar(j-32)
+          case default
+              uppercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      uppercase_c(i2+1:) = c(i2+1:)
+
+      end function uppercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              s%chars(i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              c(i:i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_c
+
+!*******************************************************************************
+!     LOWERCASE
+!*******************************************************************************
+
+      pure function lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: lowercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              lowercase_s(i:i) = achar(j+32)
+          case default
+              lowercase_s(i:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function lowercase_s
+
+!*******************************************************************************
+
+      pure function lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: lowercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      lowercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              lowercase_c(i:i) = achar(j+32)
+          case default
+              lowercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      lowercase_c(i2+1:) = c(i2+1:)
+
+      end function lowercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              s%chars(i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              c(i:i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_c
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      end module m_strings
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/flib_wxml.f90	(revision 3437)
@@ -0,0 +1,11 @@
+module flib_wxml
+
+!use m_wxml_buffer
+!use m_wxml_dictionary
+!use m_wxml_elstack
+use m_wxml_text
+use m_wxml_core
+
+public
+
+end module flib_wxml
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 3437)
@@ -0,0 +1,176 @@
+module m_wxml_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in the parser module  m_fsm to avoid buffer overflows
+! caused by pcdata values.
+!
+! This module is re-used from the parser package.
+! Most of the routines are superfluous at this point.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 2000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 1750
+!
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, char, len
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+!
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+
+end subroutine reset_buffer
+
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_wxml_buffer
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_core.f90	(revision 3437)
@@ -0,0 +1,380 @@
+module m_wxml_core
+
+use m_wxml_buffer
+use m_wxml_elstack
+use m_wxml_dictionary
+
+logical, private, save  :: pcdata_advance_line_default = .false.
+logical, private, save  :: pcdata_advance_space_default = .false.
+
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+private
+
+type, public :: xmlf_t
+   integer            :: lun
+   type(buffer_t)     :: buffer
+   type(elstack_t)    :: stack
+   type(wxml_dictionary_t) :: dict
+   logical            :: start_tag_closed
+   logical            :: root_element_output
+   logical            :: indenting_requested
+end type xmlf_t
+
+public :: xml_OpenFile, xml_NewElement, xml_EndElement, xml_Close
+public :: xml_AddPcdata, xml_AddAttribute, xml_AddXMLDeclaration
+public :: xml_AddComment, xml_AddCdataSection
+
+public :: xml_AddArray
+interface xml_AddArray
+   module procedure  xml_AddArray_integer,  &
+                xml_AddArray_real_dp, xml_AddArray_real_sp
+end interface
+private :: xml_AddArray_integer,  xml_AddArray_real_dp, xml_AddArray_real_sp
+
+private :: get_unit
+private :: add_eol
+private :: write_attributes
+
+
+integer, private, parameter  :: COLUMNS = 80
+
+CONTAINS
+
+!-------------------------------------------------------------------
+subroutine xml_OpenFile(filename, xf, indent)
+character(len=*), intent(in)  :: filename
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: indent
+
+integer :: iostat
+
+call get_unit(xf%lun,iostat)
+if (iostat /= 0) stop "cannot open file"
+open(unit=xf%lun, file=filename, form="formatted", status="replace", &
+     action="write", position="rewind") ! , recl=65536)
+
+call reset_elstack(xf%stack)
+call reset_dict(xf%dict)
+call reset_buffer(xf%buffer)
+
+xf%start_tag_closed = .true.
+xf%root_element_output = .false.
+
+xf%indenting_requested = .false.
+if (present(indent)) then
+   xf%indenting_requested = indent
+endif
+end subroutine xml_OpenFile
+
+!-------------------------------------------------------------------
+subroutine xml_AddXMLDeclaration(xf,encoding)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in), optional :: encoding
+
+if (present(encoding)) then
+   call add_to_buffer("<?xml version=""1.0"" encoding=""" &
+                     // trim(encoding) // """ ?>", xf%buffer)
+else
+   call add_to_buffer("<?xml version=""1.0"" ?>", xf%buffer)
+endif
+end subroutine xml_AddXMLDeclaration
+
+!-------------------------------------------------------------------
+subroutine xml_AddComment(xf,comment)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: comment
+
+call close_start_tag(xf,">")
+call add_eol(xf)
+call add_to_buffer("<!--", xf%buffer)
+call add_to_buffer(comment, xf%buffer)
+call add_to_buffer("-->", xf%buffer)
+end subroutine xml_AddComment
+
+!-------------------------------------------------------------------
+subroutine xml_AddCdataSection(xf,cdata)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: cdata
+
+call close_start_tag(xf,">")
+call add_to_buffer("<![CDATA[", xf%buffer)
+call add_to_buffer(cdata, xf%buffer)
+call add_to_buffer("]]>", xf%buffer)
+end subroutine xml_AddCdataSection
+
+!-------------------------------------------------------------------
+subroutine xml_NewElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+if (is_empty(xf%stack)) then
+   if (xf%root_element_output) stop "two root elements"
+   xf%root_element_output = .true.
+endif
+
+call close_start_tag(xf,">")
+call push_elstack(name,xf%stack)
+call add_eol(xf)
+call add_to_buffer("<" // trim(name),xf%buffer)
+xf%start_tag_closed = .false.
+call reset_dict(xf%dict)
+
+end subroutine xml_NewElement
+!-------------------------------------------------------------------
+subroutine xml_AddPcdata(xf,pcdata,space,line_feed)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: pcdata
+logical, intent(in), optional  :: space
+logical, intent(in), optional  :: line_feed
+
+logical :: advance_line , advance_space
+integer :: n, i, jmax
+integer, parameter   :: chunk_size = 128
+
+advance_line = pcdata_advance_line_default 
+if (present(line_feed)) then
+   advance_line = line_feed
+endif
+
+advance_space = pcdata_advance_space_default 
+if (present(space)) then
+   advance_space = space
+endif
+
+if (is_empty(xf%stack)) then
+   stop "pcdata outside element content"
+endif
+
+call close_start_tag(xf,">")
+
+if (advance_line) then
+   call add_eol(xf)
+   advance_space = .false.
+else
+   if (xf%indenting_requested) then
+      if ((len(xf%buffer) + len_trim(pcdata) + 1) > COLUMNS ) then
+         call add_eol(xf)
+         advance_space = .false.
+      endif
+   endif
+endif
+if (advance_space) call add_to_buffer(" ",xf%buffer)
+if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.false.)
+!
+! We bypass the buffer for the bulk of the dump
+!
+n = len(pcdata)
+!print *, "writing pcdata of length: ", n
+i = 1
+do
+   jmax = min(i+chunk_size-1,n)
+!   print *, "writing chunk: ", i, jmax
+   write(unit=xf%lun,fmt="(a)",advance="no") pcdata(i:jmax)
+   if (jmax == n) exit
+   i = jmax + 1
+enddo
+end subroutine xml_AddPcdata
+
+!-------------------------------------------------------------------
+subroutine xml_AddAttribute(xf,name,value)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+character(len=*), intent(in)  :: value
+
+if (is_empty(xf%stack)) then
+   stop "attributes outside element content"
+endif
+
+if (xf%start_tag_closed)  then
+   stop "attributes outside start tag"
+endif
+if (has_key(xf%dict,name)) then
+   stop "duplicate att name"
+endif
+
+call add_key_to_dict(trim(name),xf%dict)
+call add_value_to_dict(trim(value),xf%dict)
+
+end subroutine xml_AddAttribute
+
+!-----------------------------------------------------------
+subroutine xml_EndElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+character(len=100)  :: current
+
+if (is_empty(xf%stack)) then
+   stop "Out of elements to close"
+endif
+
+call get_top_elstack(xf%stack,current)
+if (current /= name) then
+   print *, "current, name: ", trim(current), " ", trim(name)
+   stop
+endif
+if (.not. xf%start_tag_closed)  then                ! Empty element
+   if (len(xf%dict) > 0) call write_attributes(xf)
+   call add_to_buffer(" />",xf%buffer)
+   xf%start_tag_closed = .true.
+else
+   call add_eol(xf)
+   call add_to_buffer("</" // trim(name) // ">", xf%buffer)
+endif
+call pop_elstack(xf%stack,current)
+
+end subroutine xml_EndElement
+
+!----------------------------------------------------------------
+
+subroutine xml_Close(xf)
+type(xmlf_t), intent(in)   :: xf
+
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+close(unit=xf%lun)
+
+end subroutine xml_Close
+
+!==================================================================
+!-------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+!----------------------------------------------------------
+subroutine add_eol(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer :: indent_level
+character(len=100), parameter  ::  blanks =  ""
+
+indent_level = len(xf%stack) - 1
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+call reset_buffer(xf%buffer)
+
+if (xf%indenting_requested) &
+   call add_to_buffer(blanks(1:indent_level),xf%buffer)
+
+end subroutine add_eol
+!------------------------------------------------------------
+subroutine dump_buffer(xf,lf)
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: lf
+
+if (present(lf)) then
+   if (lf) then
+      write(unit=xf%lun,fmt="(a)",advance="yes") char(xf%buffer)
+   else
+      write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+   endif
+else
+   write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+endif
+call reset_buffer(xf%buffer)
+
+end subroutine dump_buffer
+
+!------------------------------------------------------------
+subroutine close_start_tag(xf,s)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: s
+
+if (.not. xf%start_tag_closed)  then
+   if (len(xf%dict) > 0)  call write_attributes(xf)
+   call add_to_buffer(s, xf%buffer)
+   xf%start_tag_closed = .true.
+endif
+
+end subroutine close_start_tag
+
+!-------------------------------------------------------------
+subroutine write_attributes(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer  :: i, status, size
+character(len=100)  :: key, value
+
+do i = 1, len(xf%dict)
+   call get_key(xf%dict,i,key,status)
+   call get_value(xf%dict,key,value,status)
+   key = adjustl(key)
+   value = adjustl(value)
+   size = len_trim(key) + len_trim(value) + 4
+   if ((len(xf%buffer) + size) > COLUMNS) call add_eol(xf)
+   call add_to_buffer(" ", xf%buffer)
+   call add_to_buffer(trim(key), xf%buffer)
+   call add_to_buffer("=", xf%buffer)
+   call add_to_buffer("""",xf%buffer)
+   call add_to_buffer(trim(value), xf%buffer)
+   call add_to_buffer("""", xf%buffer)
+enddo
+
+end subroutine write_attributes
+
+!---------------------------------------------------------------
+    subroutine xml_AddArray_integer(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      integer, intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(6(i12))") a
+      endif
+    end subroutine xml_AddArray_integer
+
+!-------------------------------------------------------------------
+    subroutine xml_AddArray_real_dp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=dp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_dp
+
+!------------------------------------------------------------------
+    subroutine xml_AddArray_real_sp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=sp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_sp
+
+end module m_wxml_core
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 3437)
@@ -0,0 +1,162 @@
+module m_wxml_dictionary
+
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 30
+type, public :: wxml_dictionary_t
+private
+      integer                               :: number_of_items ! = 0
+      character(len=100), dimension(MAX_ITEMS)  :: key
+      character(len=100), dimension(MAX_ITEMS)  :: value
+end type wxml_dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+interface get_value
+   module procedure wxml_get_value
+end interface
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(wxml_dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(wxml_dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine wxml_get_value(dict,key,value,status)
+type(wxml_dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         value = dict%value(i)
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine wxml_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(wxml_dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = dict%key(i)
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+character(len=*), intent(in)          :: key
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded !"
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+character(len=*), intent(in)          :: value
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(wxml_dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(dict%key(i)), " = ", trim(dict%value(i))
+enddo
+
+end subroutine print_dict
+
+end module m_wxml_dictionary
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 3437)
@@ -0,0 +1,143 @@
+module m_wxml_elstack
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 20
+
+type, public :: elstack_t
+private
+      integer                                    :: n_items
+      character(len=100), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+public  :: len
+
+interface len
+   module procedure number_of_items
+end interface
+private :: number_of_items
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+elstack%n_items = 0
+
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+function number_of_items(elstack) result(n)
+type(elstack_t), intent(in)  :: elstack
+integer                      :: n
+
+n = elstack%n_items
+end function number_of_items
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+character(len=*), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) trim(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len_trim(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = trim(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_wxml_elstack
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/wxml/m_wxml_text.f90	(revision 3437)
@@ -0,0 +1,73 @@
+module m_wxml_text
+!
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+!
+! TODO : Add optional format parameter
+!
+private
+
+public :: str
+
+interface str
+   module procedure  str_integer,  str_real_dp, str_real_sp, &
+                     str_logical
+end interface
+private :: str_integer,  str_real_dp, str_real_sp, str_logical
+
+CONTAINS
+
+      function str_integer(int,format) result(s)
+      integer, intent(in)   :: int
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) int
+      else
+         write(s,"(i25)") int
+      endif
+      s = adjustl(s)
+      end function str_integer
+
+      function str_logical(log,format) result(s)
+      logical, intent(in)   :: log
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) log
+      else
+         write(s,"(l1)") log
+      endif
+      s = adjustl(s)
+      end function str_logical
+
+      function str_real_dp(x,format) result(s)
+      real(kind=dp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_dp
+
+      function str_real_sp(x,format) result(s)
+      real(kind=sp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_sp
+
+
+end module m_wxml_text
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Ba.xml	(revision 3437)
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<atom version="0.1">
+
+  <job type="pseudopotential-generation">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>pg Ba with 5s as semicore, 5p in valence -- soft Vf </title>
+  <symbol>Ba</symbol>
+  <pseudo flavor="tm2" core-corrections="no" />
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00" rc="1.75" />
+     <shell n="5" l="1" occupation="6.00" rc="2.00" />
+     <shell n="5" l="2" occupation="0.00" rc="2.50" />
+     <shell n="4" l="3" occupation="0.00" rc="2.50" />
+  </configuration>
+  <analysis logder="3.0" />
+
+  </job>
+  <job type="pseudopotential-test">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>test Ba </title>
+  <symbol>Ba</symbol>
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00"  />
+     <shell n="5" l="1" occupation="5.00"  />
+     <shell n="5" l="2" occupation="1.00"  />
+     <shell n="4" l="3" occupation="0.00"  />
+  </configuration>
+
+  </job>
+</atom>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/Developer.Guide	(revision 3437)
@@ -0,0 +1,63 @@
+Developer Notes for the XPATH-lite API
+
+This API is built on top of the more fundamental SAX one. The basic
+idea is to have a set of programable handlers that communicate among
+themselves and with the parser via module variables.
+
+A new pseudo-handler, "signal_handler", has been added to the optional
+argument list of xml_parse(). In the current implementation it just
+checks whether a stop signal has been raised by the user side of the
+program (for example, after a "begin tag" event, or after going out
+of the scope of a parent element).
+
+Since the SAX parser is stream-oriented, and XPATH searches can be
+done in any order, there are new routines to rewind the XML file and
+to synchronize the physical file reader with a previously saved point
+in the XML tree. 
+
+These tools, and the rather sophisticated path-matching routine
+provided (which allows for wildcards and the "//" construction) would
+be enough for standard use, as implemented in the routine
+"get_node". However, there is also the possibility of performing
+searches constrained to a given ancestor element ("context" searches)
+so that blocks of logically related information can be processed
+together. A context is implicitly created by a call to
+"mark_node". Contexts can be saved and "synched" to, allowing for
+repeated constrained searches (calls with relative paths). Contexts
+can even be passed to subroutines to package the parsing of common
+elements once and for all. (See for example Examples/xpath/pseudo.f90).
+This feature is nevertheless in need of a more rigorous specification:
+
+* What should be the behavior if a "mark_node" is followed by a
+  call to "get_node" with an absolute path?
+* Should there always be an "automatic rewind" to the beginning of the
+  context before any successive calls to "get_node"?
+
+
+LIMITATIONS
+
+The pcdata buffer provided by the user as a character variable could
+overflow.  Note that the parser itself uses a string of length
+MAX_PCDATA_SIZE (currently 65536) as a buffer to hold PCDATA. A
+warning is issued if there is not enough space (in the user or in the
+system buffer) to hold the data.
+
+Support for converting PCDATA characters to numerical arrays "on the
+fly" is planned for a forthcoming version.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/flib_xpath.f90	(revision 3437)
@@ -0,0 +1,12 @@
+module flib_xpath
+
+!
+! Stub module to gather all the XML functionality needed by the user
+! 
+use flib_sax
+use m_path
+
+public
+
+end module flib_xpath
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path.f90	(revision 3437)
@@ -0,0 +1,617 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save :: global_status
+integer, public, parameter :: END_OF_FILE = -1
+integer, public, parameter :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter :: PCDATA_OVERFLOW = 7
+
+logical, private, save :: debug_xpath = .false.
+logical, private, save :: debug_sax = .false.
+character(len=500), private, save :: path_required
+character(len=100), private, save :: target_path ! *** Hard limit
+
+
+logical, private, save :: in_target_element = .false.
+logical, private, save :: in_pcdata_level = .false.
+
+logical, private, save :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save :: full_node = .true.
+
+logical, private, save :: relative_path = .false.
+logical, private, save :: looking_for_current_element
+
+logical, private, save :: attributes_requested
+type(dictionary_t), private, save, pointer :: attributes_recovered
+
+integer, parameter, private :: MAX_PCDATA_SIZE = 65536
+logical, private, save :: pcdata_requested
+character(len=MAX_PCDATA_SIZE), private, &
+                                save :: pcdata_recovered !*** Hard
+integer, private, save :: len_pcdata
+integer, private, save :: max_len_pcdata
+
+type(xml_t), pointer, save, private :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml'
+! ready to process the rest of the element's contents (child elements'
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+
+
+character(len=200) :: ancestor_path ! local variable
+
+     full_node = .false.
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes, &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained'
+! in the element's scope (but not child elements). It leaves the file handle'
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present'
+! after the end of the element's end tag if 'pcdata' is present'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).'
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes,pcdata, &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3) :: any_path = "//*"
+character(len=200) :: local_path, ancestor_path ! *** Hard limit
+character(len=500) :: value ! *** Hard limit
+integer :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0 ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints
+
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0) EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value) then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle ! We keep searching
+            endif
+         else ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle ! keep searching
+      endif
+   else ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in) :: path
+type(dictionary_t), intent(out), optional, target :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+! Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml, &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element, &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node) then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else
+   !
+   ! If we are at the pcdata level and we enter another element,
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level) in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+character(len=300) :: path ! *** Hard limit
+character(len=300) :: left_path ! *** Hard limit
+character(len=300) :: ancestor_path ! *** Hard limit
+!
+
+call xml_path(xp,path) ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      !
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node) then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+integer :: len_chunk
+
+if (in_pcdata_level) then
+   !
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out) :: res
+
+res = stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data      
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf ! *** Hard limit
+
+res_match = .false.
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We process // in the middle below
+
+   res_match = .true.
+   return
+
+else ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then ! keep searching
+            len_target = pos_target
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else if (p(pos_path+1:len_path) == &
+             ptarget(pos_target+1:len_target)) then
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/m_path_orig.f90	(revision 3437)
@@ -0,0 +1,629 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save                   :: global_status
+integer, public, parameter               :: END_OF_FILE  = -1
+integer, public, parameter               :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter               :: PCDATA_OVERFLOW = 7
+
+logical, private, save                   :: debug_xpath = .false.
+logical, private, save                   :: debug_sax = .false.
+character(len=500), private, save        :: path_required
+character(len=100), private, save        :: target_path      ! *** Hard limit
+
+
+logical, private, save                   :: in_target_element = .false.
+logical, private, save                   :: in_pcdata_level = .false.
+
+logical, private, save                   :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save                   :: full_node = .true.
+
+logical, private, save                   :: relative_path = .false.
+logical, private, save                   :: looking_for_current_element
+                             
+logical, private, save                        :: attributes_requested
+type(dictionary_t), private, save, pointer    :: attributes_recovered
+
+integer, parameter, private                   :: MAX_PCDATA_SIZE = 65536
+logical, private, save                        :: pcdata_requested 
+character(len=MAX_PCDATA_SIZE), private, &
+                                save          :: pcdata_recovered !*** Hard 
+integer, private, save                        :: len_pcdata
+integer, private, save                        :: max_len_pcdata
+
+type(xml_t), pointer, save, private           :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional  :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml
+! ready to process the rest of the element's contents (child elements
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction 
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+integer, intent(out), optional               :: status
+
+
+character(len=200)         :: ancestor_path           ! local variable
+
+     full_node = .false.
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,              &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained
+! in the element's scope (but not child elements). It leaves the file handle
+! physically and logically positioned:
+!
+!     after the end of the element's start tag if 'pcdata' is not present
+!     after the end of the element's end tag if 'pcdata' is present
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction (such as the overflow of the 
+!   user's pcdata buffer).
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,pcdata,       &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3)   :: any_path  = "//*"
+character(len=200) :: local_path, ancestor_path      ! *** Hard limit
+character(len=500) :: value                          ! *** Hard limit
+integer            :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0           ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.    
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints 
+   
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0)  EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value)  then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle        ! We keep searching
+            endif
+         else           ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else              ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle          ! keep searching
+      endif
+   else                 ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+   
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in)                 :: path
+type(dictionary_t), intent(out), optional, target    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional                       :: status  
+
+logical            :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+!  Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN              ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml,  &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element,  &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status  
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node)  then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else 
+   !
+   ! If we are at the pcdata level and we enter another element, 
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level)   in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in)   :: name
+
+character(len=300)   :: path             ! *** Hard limit
+character(len=300)   :: left_path        ! *** Hard limit
+character(len=300)   :: ancestor_path    ! *** Hard limit
+!
+
+call xml_path(xp,path)   ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      ! 
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else  if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+   
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+    
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+  
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node)  then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in)   :: chunk
+
+integer  :: len_chunk
+
+if (in_pcdata_level) then
+   ! 
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out)  :: res
+
+res =  stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf                     ! *** Hard limit
+
+res_match = .false.       
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLF90/src/xpath/match_tester.f90	(revision 3437)
@@ -0,0 +1,148 @@
+program m
+
+character(len=100) :: p, t
+logical            :: result
+
+do
+   write(unit=*,fmt="(a)",advance="no")  "Target path: "
+   read(unit=*,fmt="(a)") t
+   write(unit=*,fmt="(a)",advance="no")  "Path: "
+   read(unit=*,fmt="(a)") p
+
+   result = match(p,t)
+   print *, "Result: ", result
+
+enddo
+
+
+CONTAINS
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf
+
+res_match = .false.       
+
+ print *, ":testing: "
+ print *, "          ", trim(p)
+ print *, " against: ", trim(ptarget)
+ print *, "-----------------------------------------"
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   print *, "outright equality"
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   print *, "target begins by //"
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   print *, " Path leaf: ", p(pos_path+1:len_path) 
+   print *, " Target leaf: ", ptarget(pos_target+1:len_target)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         print *, "looking for anchor in: ", ptarget(1:len_target-1)
+         print *, "press enter"
+         read *
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         print *, "pos_target in anchor search: ", pos_target
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            print *, "reached initial /.// in target"
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         print *, " Anchor leaf: ", trim(anchor_leaf)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      print *, " Searching anchor in : ", trim(p(1:len_path))
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         print *, "empty element. len_path, pos_path: ", len_path, pos_path
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end program m
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/init_vampir.f90	(revision 3437)
@@ -0,0 +1,5 @@
+SUBROUTINE init_vampir
+USE mpitrace
+
+  CALL InitVampir
+END SUBROUTINE init_vampir
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/ios_mpif.h	(revision 3437)
@@ -0,0 +1,405 @@
+       INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+       PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5)
+       INTEGER MPI_STATUS_SIZE
+       PARAMETER (MPI_STATUS_SIZE=5)
+       INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
+       INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1)
+       INTEGER MPI_ERRCODES_IGNORE(1)
+       CHARACTER*1 MPI_ARGVS_NULL(1,1)
+       CHARACTER*1 MPI_ARGV_NULL(1)
+       INTEGER MPI_SUCCESS
+       PARAMETER (MPI_SUCCESS=0)
+       INTEGER MPI_ERR_OTHER
+       PARAMETER (MPI_ERR_OTHER=15)
+       INTEGER MPI_ERR_WIN
+       PARAMETER (MPI_ERR_WIN=45)
+       INTEGER MPI_ERR_FILE
+       PARAMETER (MPI_ERR_FILE=27)
+       INTEGER MPI_ERR_COUNT
+       PARAMETER (MPI_ERR_COUNT=2)
+       INTEGER MPI_ERR_SPAWN
+       PARAMETER (MPI_ERR_SPAWN=42)
+       INTEGER MPI_ERR_BASE
+       PARAMETER (MPI_ERR_BASE=46)
+       INTEGER MPI_ERR_RMA_CONFLICT
+       PARAMETER (MPI_ERR_RMA_CONFLICT=49)
+       INTEGER MPI_ERR_IN_STATUS
+       PARAMETER (MPI_ERR_IN_STATUS=17)
+       INTEGER MPI_ERR_INFO_KEY
+       PARAMETER (MPI_ERR_INFO_KEY=29)
+       INTEGER MPI_ERR_LOCKTYPE
+       PARAMETER (MPI_ERR_LOCKTYPE=47)
+       INTEGER MPI_ERR_OP
+       PARAMETER (MPI_ERR_OP=9)
+       INTEGER MPI_ERR_ARG
+       PARAMETER (MPI_ERR_ARG=12)
+       INTEGER MPI_ERR_READ_ONLY
+       PARAMETER (MPI_ERR_READ_ONLY=40)
+       INTEGER MPI_ERR_SIZE
+       PARAMETER (MPI_ERR_SIZE=51)
+       INTEGER MPI_ERR_BUFFER
+       PARAMETER (MPI_ERR_BUFFER=1)
+       INTEGER MPI_ERR_DUP_DATAREP
+       PARAMETER (MPI_ERR_DUP_DATAREP=24)
+       INTEGER MPI_ERR_UNSUPPORTED_DATAREP
+       PARAMETER (MPI_ERR_UNSUPPORTED_DATAREP=43)
+       INTEGER MPI_ERR_LASTCODE
+       PARAMETER (MPI_ERR_LASTCODE=1073741823)
+       INTEGER MPI_ERR_TRUNCATE
+       PARAMETER (MPI_ERR_TRUNCATE=14)
+       INTEGER MPI_ERR_DISP
+       PARAMETER (MPI_ERR_DISP=52)
+       INTEGER MPI_ERR_PORT
+       PARAMETER (MPI_ERR_PORT=38)
+       INTEGER MPI_ERR_INFO_NOKEY
+       PARAMETER (MPI_ERR_INFO_NOKEY=31)
+       INTEGER MPI_ERR_ASSERT
+       PARAMETER (MPI_ERR_ASSERT=53)
+       INTEGER MPI_ERR_FILE_EXISTS
+       PARAMETER (MPI_ERR_FILE_EXISTS=25)
+       INTEGER MPI_ERR_PENDING
+       PARAMETER (MPI_ERR_PENDING=18)
+       INTEGER MPI_ERR_COMM
+       PARAMETER (MPI_ERR_COMM=5)
+       INTEGER MPI_ERR_KEYVAL
+       PARAMETER (MPI_ERR_KEYVAL=48)
+       INTEGER MPI_ERR_NAME
+       PARAMETER (MPI_ERR_NAME=33)
+       INTEGER MPI_ERR_REQUEST
+       PARAMETER (MPI_ERR_REQUEST=19)
+       INTEGER MPI_ERR_GROUP
+       PARAMETER (MPI_ERR_GROUP=8)
+       INTEGER MPI_ERR_TOPOLOGY
+       PARAMETER (MPI_ERR_TOPOLOGY=10)
+       INTEGER MPI_ERR_TYPE
+       PARAMETER (MPI_ERR_TYPE=3)
+       INTEGER MPI_ERR_TAG
+       PARAMETER (MPI_ERR_TAG=4)
+       INTEGER MPI_ERR_INFO_VALUE
+       PARAMETER (MPI_ERR_INFO_VALUE=30)
+       INTEGER MPI_ERR_NOT_SAME
+       PARAMETER (MPI_ERR_NOT_SAME=35)
+       INTEGER MPI_ERR_RMA_SYNC
+       PARAMETER (MPI_ERR_RMA_SYNC=50)
+       INTEGER MPI_ERR_INFO
+       PARAMETER (MPI_ERR_INFO=28)
+       INTEGER MPI_ERR_NO_MEM
+       PARAMETER (MPI_ERR_NO_MEM=34)
+       INTEGER MPI_ERR_BAD_FILE
+       PARAMETER (MPI_ERR_BAD_FILE=22)
+       INTEGER MPI_ERR_FILE_IN_USE
+       PARAMETER (MPI_ERR_FILE_IN_USE=26)
+       INTEGER MPI_ERR_UNKNOWN
+       PARAMETER (MPI_ERR_UNKNOWN=13)
+       INTEGER MPI_ERR_UNSUPPORTED_OPERATION
+       PARAMETER (MPI_ERR_UNSUPPORTED_OPERATION=44)
+       INTEGER MPI_ERR_QUOTA
+       PARAMETER (MPI_ERR_QUOTA=39)
+       INTEGER MPI_ERR_AMODE
+       PARAMETER (MPI_ERR_AMODE=21)
+       INTEGER MPI_ERR_ROOT
+       PARAMETER (MPI_ERR_ROOT=7)
+       INTEGER MPI_ERR_RANK
+       PARAMETER (MPI_ERR_RANK=6)
+       INTEGER MPI_ERR_DIMS
+       PARAMETER (MPI_ERR_DIMS=11)
+       INTEGER MPI_ERR_NO_SUCH_FILE
+       PARAMETER (MPI_ERR_NO_SUCH_FILE=37)
+       INTEGER MPI_ERR_SERVICE
+       PARAMETER (MPI_ERR_SERVICE=41)
+       INTEGER MPI_ERR_INTERN
+       PARAMETER (MPI_ERR_INTERN=16)
+       INTEGER MPI_ERR_IO
+       PARAMETER (MPI_ERR_IO=32)
+       INTEGER MPI_ERR_ACCESS
+       PARAMETER (MPI_ERR_ACCESS=20)
+       INTEGER MPI_ERR_NO_SPACE
+       PARAMETER (MPI_ERR_NO_SPACE=36)
+       INTEGER MPI_ERR_CONVERSION
+       PARAMETER (MPI_ERR_CONVERSION=23)
+       INTEGER MPI_ERRORS_ARE_FATAL
+       PARAMETER (MPI_ERRORS_ARE_FATAL=1409286144)
+       INTEGER MPI_ERRORS_RETURN
+       PARAMETER (MPI_ERRORS_RETURN=1409286145)
+       INTEGER MPI_IDENT
+       PARAMETER (MPI_IDENT=0)
+       INTEGER MPI_CONGRUENT
+       PARAMETER (MPI_CONGRUENT=1)
+       INTEGER MPI_SIMILAR
+       PARAMETER (MPI_SIMILAR=2)
+       INTEGER MPI_UNEQUAL
+       PARAMETER (MPI_UNEQUAL=3)
+       INTEGER MPI_MAX
+       PARAMETER (MPI_MAX=1476395009)
+       INTEGER MPI_MIN
+       PARAMETER (MPI_MIN=1476395010)
+       INTEGER MPI_SUM
+       PARAMETER (MPI_SUM=1476395011)
+       INTEGER MPI_PROD
+       PARAMETER (MPI_PROD=1476395012)
+       INTEGER MPI_LAND
+       PARAMETER (MPI_LAND=1476395013)
+       INTEGER MPI_BAND
+       PARAMETER (MPI_BAND=1476395014)
+       INTEGER MPI_LOR
+       PARAMETER (MPI_LOR=1476395015)
+       INTEGER MPI_BOR
+       PARAMETER (MPI_BOR=1476395016)
+       INTEGER MPI_LXOR
+       PARAMETER (MPI_LXOR=1476395017)
+       INTEGER MPI_BXOR
+       PARAMETER (MPI_BXOR=1476395018)
+       INTEGER MPI_MINLOC
+       PARAMETER (MPI_MINLOC=1476395019)
+       INTEGER MPI_MAXLOC
+       PARAMETER (MPI_MAXLOC=1476395020)
+       INTEGER MPI_REPLACE
+       PARAMETER (MPI_REPLACE=1476395021)
+       INTEGER MPI_COMM_WORLD
+       PARAMETER (MPI_COMM_WORLD=1140850688)
+       INTEGER MPI_COMM_SELF
+       PARAMETER (MPI_COMM_SELF=1140850689)
+       INTEGER MPI_GROUP_EMPTY
+       PARAMETER (MPI_GROUP_EMPTY=1207959552)
+       INTEGER MPI_COMM_NULL
+       PARAMETER (MPI_COMM_NULL=67108864)
+       INTEGER MPI_WIN_NULL
+       PARAMETER (MPI_WIN_NULL=536870912)
+       INTEGER MPI_FILE_NULL
+       PARAMETER (MPI_FILE_NULL=0)
+       INTEGER MPI_GROUP_NULL
+       PARAMETER (MPI_GROUP_NULL=134217728)
+       INTEGER MPI_OP_NULL
+       PARAMETER (MPI_OP_NULL=402653184)
+       INTEGER MPI_DATATYPE_NULL
+       PARAMETER (MPI_DATATYPE_NULL=201326592)
+       INTEGER MPI_REQUEST_NULL
+       PARAMETER (MPI_REQUEST_NULL=738197504)
+       INTEGER MPI_ERRHANDLER_NULL
+       PARAMETER (MPI_ERRHANDLER_NULL=335544320)
+       INTEGER MPI_INFO_NULL
+       PARAMETER (MPI_INFO_NULL=469762048)
+       INTEGER MPI_TAG_UB
+       PARAMETER (MPI_TAG_UB=1681915906)
+       INTEGER MPI_HOST
+       PARAMETER (MPI_HOST=1681915908)
+       INTEGER MPI_IO
+       PARAMETER (MPI_IO=1681915910)
+       INTEGER MPI_WTIME_IS_GLOBAL
+       PARAMETER (MPI_WTIME_IS_GLOBAL=1681915912)
+       INTEGER MPI_UNIVERSE_SIZE
+       PARAMETER (MPI_UNIVERSE_SIZE=1681915914)
+       INTEGER MPI_LASTUSEDCODE
+       PARAMETER (MPI_LASTUSEDCODE=1681915916)
+       INTEGER MPI_APPNUM
+       PARAMETER (MPI_APPNUM=1681915918)
+       INTEGER MPI_WIN_BASE
+       PARAMETER (MPI_WIN_BASE=1711276034)
+       INTEGER MPI_WIN_SIZE
+       PARAMETER (MPI_WIN_SIZE=1711276036)
+       INTEGER MPI_WIN_DISP_UNIT
+       PARAMETER (MPI_WIN_DISP_UNIT=1711276038)
+       INTEGER MPI_MAX_ERROR_STRING
+       PARAMETER (MPI_MAX_ERROR_STRING=512)
+       INTEGER MPI_MAX_NAME_STRING
+       PARAMETER (MPI_MAX_NAME_STRING=63)
+       INTEGER MPI_MAX_PORT_NAME
+       PARAMETER (MPI_MAX_PORT_NAME=256)
+       INTEGER MPI_MAX_OBJECT_NAME
+       PARAMETER (MPI_MAX_OBJECT_NAME=128)
+       INTEGER MPI_MAX_INFO_KEY
+       PARAMETER (MPI_MAX_INFO_KEY=255)
+       INTEGER MPI_MAX_INFO_VAL
+       PARAMETER (MPI_MAX_INFO_VAL=1024)
+       INTEGER MPI_MAX_PROCESSOR_NAME
+       PARAMETER (MPI_MAX_PROCESSOR_NAME=128)
+       INTEGER MPI_MAX_DATAREP_STRING
+       PARAMETER (MPI_MAX_DATAREP_STRING=128)
+       INTEGER MPI_UNDEFINED, MPI_UNDEFINED_RANK
+       PARAMETER (MPI_UNDEFINED=(-32766))
+       PARAMETER (MPI_UNDEFINED_RANK=(-32766))
+       INTEGER MPI_KEYVAL_INVALID
+       PARAMETER (MPI_KEYVAL_INVALID=603979776)
+       INTEGER MPI_BSEND_OVERHEAD
+       PARAMETER (MPI_BSEND_OVERHEAD=95)
+       INTEGER MPI_PROC_NULL
+       PARAMETER (MPI_PROC_NULL=-1)
+       INTEGER MPI_ANY_SOURCE
+       PARAMETER (MPI_ANY_SOURCE=-2)
+       INTEGER MPI_ANY_TAG
+       PARAMETER (MPI_ANY_TAG=-1)
+       INTEGER MPI_ROOT
+       PARAMETER (MPI_ROOT=-3)
+       INTEGER MPI_GRAPH
+       PARAMETER (MPI_GRAPH=1)
+       INTEGER MPI_CART
+       PARAMETER (MPI_CART=2)
+       INTEGER MPI_VERSION
+       PARAMETER (MPI_VERSION=2)
+       INTEGER MPI_SUBVERSION
+       PARAMETER (MPI_SUBVERSION=0)
+       INTEGER MPI_LOCK_EXCLUSIVE
+       PARAMETER (MPI_LOCK_EXCLUSIVE=234)
+       INTEGER MPI_LOCK_SHARED
+       PARAMETER (MPI_LOCK_SHARED=235)
+       INTEGER MPI_COMPLEX
+       PARAMETER (MPI_COMPLEX=1275072554)
+       INTEGER MPI_DOUBLE_COMPLEX
+       PARAMETER (MPI_DOUBLE_COMPLEX=1275072546)
+       INTEGER MPI_LOGICAL
+       PARAMETER (MPI_LOGICAL=1275069469)
+       INTEGER MPI_REAL
+       PARAMETER (MPI_REAL=1275070505)
+       INTEGER MPI_DOUBLE_PRECISION
+       PARAMETER (MPI_DOUBLE_PRECISION=1275070495)
+       INTEGER MPI_INTEGER
+       PARAMETER (MPI_INTEGER=1275069467)
+       INTEGER MPI_2INTEGER
+       PARAMETER (MPI_2INTEGER=1275070496)
+       INTEGER MPI_2COMPLEX
+       PARAMETER (MPI_2COMPLEX=1275072548)
+       INTEGER MPI_2DOUBLE_PRECISION
+       PARAMETER (MPI_2DOUBLE_PRECISION=1275072547)
+       INTEGER MPI_2REAL
+       PARAMETER (MPI_2REAL=1275070497)
+       INTEGER MPI_2DOUBLE_COMPLEX
+       PARAMETER (MPI_2DOUBLE_COMPLEX=1275076645)
+       INTEGER MPI_CHARACTER
+       PARAMETER (MPI_CHARACTER=1275068698)
+       INTEGER MPI_BYTE
+       PARAMETER (MPI_BYTE=1275068685)
+       INTEGER MPI_UB
+       PARAMETER (MPI_UB=(1275068433))
+       INTEGER MPI_LB
+       PARAMETER (MPI_LB=(1275068432))
+       INTEGER MPI_PACKED
+       PARAMETER (MPI_PACKED=(1275068687))
+       INTEGER MPI_INTEGER1
+       PARAMETER (MPI_INTEGER1=1275068717)
+       INTEGER MPI_INTEGER2
+       PARAMETER (MPI_INTEGER2=1275068975)
+       INTEGER MPI_INTEGER4
+       PARAMETER (MPI_INTEGER4=1275069488)
+       INTEGER MPI_INTEGER8
+       PARAMETER (MPI_INTEGER8=1275070513)
+       INTEGER MPI_INTEGER16
+       PARAMETER (MPI_INTEGER16=MPI_DATATYPE_NULL)
+       INTEGER MPI_REAL4
+       PARAMETER (MPI_REAL4=1275069479)
+       INTEGER MPI_REAL8
+       PARAMETER (MPI_REAL8=1275070505)
+       INTEGER MPI_REAL16
+       PARAMETER (MPI_REAL16=1275072555)
+       INTEGER MPI_COMPLEX8
+       PARAMETER (MPI_COMPLEX8=1275070504)
+       INTEGER MPI_COMPLEX16
+       PARAMETER (MPI_COMPLEX16=1275072554)
+       INTEGER MPI_COMPLEX32
+       PARAMETER (MPI_COMPLEX32=1275076652)
+       INTEGER MPI_ADDRESS_KIND, MPI_OFFSET_KIND
+       PARAMETER (MPI_ADDRESS_KIND=8)
+       PARAMETER (MPI_OFFSET_KIND=8)
+       INTEGER MPI_COMBINER_NAMED
+       PARAMETER (MPI_COMBINER_NAMED=1)
+       INTEGER MPI_COMBINER_DUP
+       PARAMETER (MPI_COMBINER_DUP=2)
+       INTEGER MPI_COMBINER_CONTIGUOUS
+       PARAMETER (MPI_COMBINER_CONTIGUOUS=3)
+       INTEGER MPI_COMBINER_VECTOR
+       PARAMETER (MPI_COMBINER_VECTOR=4)
+       INTEGER MPI_COMBINER_HVECTOR_INTEGER
+       PARAMETER (MPI_COMBINER_HVECTOR_INTEGER=5)
+       INTEGER MPI_COMBINER_HVECTOR
+       PARAMETER (MPI_COMBINER_HVECTOR=6)
+       INTEGER MPI_COMBINER_INDEXED
+       PARAMETER (MPI_COMBINER_INDEXED=7)
+       INTEGER MPI_COMBINER_HINDEXED_INTEGER
+       PARAMETER (MPI_COMBINER_HINDEXED_INTEGER=8)
+       INTEGER MPI_COMBINER_HINDEXED
+       PARAMETER (MPI_COMBINER_HINDEXED=9)
+       INTEGER MPI_COMBINER_INDEXED_BLOCK
+       PARAMETER (MPI_COMBINER_INDEXED_BLOCK=10)
+       INTEGER MPI_COMBINER_STRUCT_INTEGER
+       PARAMETER (MPI_COMBINER_STRUCT_INTEGER=11)
+       INTEGER MPI_COMBINER_STRUCT
+       PARAMETER (MPI_COMBINER_STRUCT=12)
+       INTEGER MPI_COMBINER_SUBARRAY
+       PARAMETER (MPI_COMBINER_SUBARRAY=13)
+       INTEGER MPI_COMBINER_DARRAY
+       PARAMETER (MPI_COMBINER_DARRAY=14)
+       INTEGER MPI_COMBINER_F90_REAL
+       PARAMETER (MPI_COMBINER_F90_REAL=15)
+       INTEGER MPI_COMBINER_F90_COMPLEX
+       PARAMETER (MPI_COMBINER_F90_COMPLEX=16)
+       INTEGER MPI_COMBINER_F90_INTEGER
+       PARAMETER (MPI_COMBINER_F90_INTEGER=17)
+       INTEGER MPI_COMBINER_RESIZED
+       PARAMETER (MPI_COMBINER_RESIZED=18)
+       INTEGER MPI_MODE_NOCHECK
+       PARAMETER (MPI_MODE_NOCHECK=1024)
+       INTEGER MPI_MODE_NOSTORE
+       PARAMETER (MPI_MODE_NOSTORE=2048)
+       INTEGER MPI_MODE_NOPUT
+       PARAMETER (MPI_MODE_NOPUT=4096)
+       INTEGER MPI_MODE_NOPRECEDE
+       PARAMETER (MPI_MODE_NOPRECEDE=8192)
+       INTEGER MPI_MODE_NOSUCCEED
+       PARAMETER (MPI_MODE_NOSUCCEED=16384)
+       INTEGER MPI_THREAD_SINGLE
+       PARAMETER (MPI_THREAD_SINGLE=0)
+       INTEGER MPI_THREAD_FUNNELED
+       PARAMETER (MPI_THREAD_FUNNELED=1)
+       INTEGER MPI_THREAD_SERIALIZED
+       PARAMETER (MPI_THREAD_SERIALIZED=2)
+       INTEGER MPI_THREAD_MULTIPLE
+       PARAMETER (MPI_THREAD_MULTIPLE=3)
+       INTEGER MPI_MODE_RDONLY
+       PARAMETER (MPI_MODE_RDONLY=2)
+       INTEGER MPI_MODE_RDWR
+       PARAMETER (MPI_MODE_RDWR=8)
+       INTEGER MPI_MODE_WRONLY
+       PARAMETER (MPI_MODE_WRONLY=4)
+       INTEGER MPI_MODE_DELETE_ON_CLOSE
+       PARAMETER (MPI_MODE_DELETE_ON_CLOSE=16)
+       INTEGER MPI_MODE_UNIQUE_OPEN
+       PARAMETER (MPI_MODE_UNIQUE_OPEN=32)
+       INTEGER MPI_MODE_CREATE
+       PARAMETER (MPI_MODE_CREATE=1)
+       INTEGER MPI_MODE_EXCL
+       PARAMETER (MPI_MODE_EXCL=64)
+       INTEGER MPI_MODE_APPEND
+       PARAMETER (MPI_MODE_APPEND=128)
+       INTEGER MPI_MODE_SEQUENTIAL
+       PARAMETER (MPI_MODE_SEQUENTIAL=256)
+       INTEGER MPI_SEEK_SET
+       PARAMETER (MPI_SEEK_SET=600)
+       INTEGER MPI_SEEK_CUR
+       PARAMETER (MPI_SEEK_CUR=602)
+       INTEGER MPI_SEEK_END
+       PARAMETER (MPI_SEEK_END=604)
+       INTEGER MPI_ORDER_C
+       PARAMETER (MPI_ORDER_C=56)
+       INTEGER MPI_ORDER_FORTRAN
+       PARAMETER (MPI_ORDER_FORTRAN=57)
+       INTEGER MPI_DISTRIBUTE_BLOCK
+       PARAMETER (MPI_DISTRIBUTE_BLOCK=121)
+       INTEGER MPI_DISTRIBUTE_CYCLIC
+       PARAMETER (MPI_DISTRIBUTE_CYCLIC=122)
+       INTEGER MPI_DISTRIBUTE_NONE
+       PARAMETER (MPI_DISTRIBUTE_NONE=123)
+       INTEGER MPI_DISTRIBUTE_DFLT_DARG
+       PARAMETER (MPI_DISTRIBUTE_DFLT_DARG=-49767)
+       INTEGER MPI_DISPLACEMENT_CURRENT
+       PARAMETER (MPI_DISPLACEMENT_CURRENT=-54278278)
+       INTEGER MPI_BOTTOM, MPI_IN_PLACE
+       EXTERNAL MPI_DUP_FN, MPI_NULL_DELETE_FN, MPI_NULL_COPY_FN
+       EXTERNAL MPI_WTIME, MPI_WTICK
+       EXTERNAL PMPI_WTIME, PMPI_WTICK
+       EXTERNAL MPI_COMM_DUP_FN, MPI_COMM_NULL_DELETE_FN
+       EXTERNAL MPI_COMM_NULL_COPY_FN
+       EXTERNAL MPI_WIN_DUP_FN, MPI_WIN_NULL_DELETE_FN
+       EXTERNAL MPI_WIN_NULL_COPY_FN
+       EXTERNAL MPI_TYPE_DUP_FN, MPI_TYPE_NULL_DELETE_FN
+       EXTERNAL MPI_TYPE_NULL_COPY_FN
+       DOUBLE PRECISION MPI_WTIME, MPI_WTICK
+       DOUBLE PRECISION PMPI_WTIME, PMPI_WTICK
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/main.f90	(revision 3437)
@@ -0,0 +1,70 @@
+PROGRAM ioslave
+USE mod_pack, ONLY : set_pack_buffer,pack_data,unpack_data
+USE mod_wait
+IMPLICIT NONE
+
+  INTEGER,DIMENSION(3) :: a=(/1,2,3/)
+  REAL                 :: b = 4.5
+  REAL                 :: c = 6.7
+  INTEGER,DIMENSION(3) :: aout
+  REAL                 :: bout,cout
+  LOGICAL,DIMENSION(5) :: d=(/.TRUE.,.FALSE.,.FALSE.,.TRUE.,.TRUE./)
+  LOGICAL,DIMENSION(5) :: dout
+  CHARACTER            :: e='C'
+  CHARACTER            :: eout
+  CHARACTER(len=11)    :: f(3)
+  CHARACTER(len=11)    :: fout(3)
+  INTEGER(kind=8),dimension(:),POINTER :: buffer
+  REAL,dimension(:),POINTER :: buffer_field
+  DOUBLE PRECISION :: t
+  
+  ALLOCATE(buffer(1024))
+  ALLOCATE(buffer_field(1024))
+  
+  CALL set_pack_buffer(buffer,1)
+  
+  f(1)="COUCOU1"
+  f(2)="COUCOU2"
+  f(3)="COUCOU3"
+  
+  CALL pack_data(b)
+  CALL pack_data(f)
+  CALL pack_data(a)
+  CALL pack_data(d)
+  CALL pack_data(e)
+  CALL pack_data(c)
+  
+  CALL set_pack_buffer(buffer,1)
+  CALL unpack_data(bout)
+  CALL unpack_data(fout)
+  CALL unpack_data(aout)
+  CALL unpack_data(dout)
+  CALL unpack_data(eout)
+  CALL unpack_data(cout)
+  
+  PRINT *,a,b,c,d,e,"  ",f
+  PRINT *,aout,bout,cout,dout,eout,"  ",fout
+
+  CALL Init_wait
+  
+  t=top()
+  CALL wait_us(10)
+  t=top()
+  
+  PRINT *,"ATTENTE 10 us",t
+
+  t=top()
+  CALL wait_us(250)
+  t=top()
+  
+  PRINT *,"ATTENTE 250 us",t
+
+  t=top()
+  CALL wait_us(1235)
+  t=top()
+  
+  PRINT *,"ATTENTE 1235 us",t
+
+
+END PROGRAM ioslave
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_box_grid.f90	(revision 3437)
@@ -0,0 +1,170 @@
+MODULE box_grid
+  
+  INTEGER, PARAMETER :: nb_grid_max=100
+  INTEGER            :: nb_grid=0
+
+  TYPE domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE domain
+  
+  TYPE grid
+    TYPE(domain)         :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER                          :: ni
+    INTEGER                          :: nj
+    INTEGER                          :: nb_task
+  END TYPE grid
+  
+  TYPE(grid),SAVE,TARGET :: grids(nb_grid_max)
+  
+  INTEGER,SAVE :: max_ni
+  INTEGER,SAVE :: max_nj
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:) 
+  
+CONTAINS
+
+  SUBROUTINE create_new_grid(ni_glo,nj_glo,nb_task,id)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: ni_glo
+    INTEGER,INTENT(IN)  :: nj_glo
+    INTEGER,INTENT(IN)  :: nb_task
+    INTEGER,INTENT(OUT) :: id
+  
+    nb_grid=nb_grid+1
+    id=nb_grid
+    
+    grids(id)%ni=ni_glo
+    grids(id)%nj=nj_glo
+    grids(id)%nb_task=nb_task
+   
+    ALLOCATE(grids(id)%task_domain(nb_task))
+ 
+  END SUBROUTINE create_new_grid
+ 
+  SUBROUTINE Init_task_domain(id,task,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: id
+    INTEGER, INTENT(IN) :: task
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin
+    INTEGER, INTENT(IN) :: jbegin
+    REAL,    INTENT(IN) :: lon(ni,nj)
+    REAL,    INTENT(IN) :: lat(ni,nj)
+ 
+    TYPE(domain), POINTER :: Pt_dom
+    
+    Pt_dom=>grids(id)%task_domain(task)
+    
+    Pt_dom%ni=ni
+    Pt_dom%nj=nj
+    Pt_dom%ibegin=ibegin
+    Pt_dom%jbegin=jbegin   
+    Pt_dom%iend=ibegin+ni-1
+    Pt_dom%jend=jbegin+nj-1
+    ALLOCATE(Pt_dom%lon(ni,nj))
+    ALLOCATE(Pt_dom%lat(ni,nj))
+    Pt_dom%lon(:,:)=lon(:,:)
+    Pt_dom%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_task_domain
+
+  
+  SUBROUTINE Init_grids
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    TYPE(grid),POINTER :: Pt_grid
+    TYPE(domain),POINTER :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER :: id
+    
+      max_ni=0
+      max_nj=0
+    
+      DO id=1,nb_grid
+        pt_grid=>grids(id)
+        local_domain=>pt_grid%local_domain
+        task_domain=>pt_grid%task_domain
+        
+        local_domain%ibegin=task_domain(1)%ibegin
+        local_domain%iend=task_domain(1)%iend
+        local_domain%jbegin=task_domain(1)%jbegin
+        local_domain%jend=task_domain(1)%jend
+      
+      DO rank=1,pt_grid%nb_task
+        IF (task_domain(rank)%ibegin < local_domain%ibegin)   local_domain%ibegin = task_domain(rank)%ibegin
+        IF (task_domain(rank)%iend   > local_domain%iend  )   local_domain%iend   = task_domain(rank)%iend
+        IF (task_domain(rank)%jbegin < local_domain%jbegin)   local_domain%jbegin = task_domain(rank)%jbegin
+        IF (task_domain(rank)%jend   > local_domain%jend  )   local_domain%jend   = task_domain(rank)%jend
+      ENDDO
+    
+      local_domain%ni = local_domain%iend-local_domain%ibegin+1
+      local_domain%nj = local_domain%jend-local_domain%jbegin+1
+      ALLOCATE(local_domain%lon(local_domain%ni,local_domain%nj))
+      ALLOCATE(local_domain%lat(local_domain%ni,local_domain%nj))
+      
+      DO rank=1,pt_grid%nb_task
+        ib=task_domain(rank)%ibegin-local_domain%ibegin+1
+        ie=task_domain(rank)%iend-local_domain%ibegin+1
+        jb=task_domain(rank)%jbegin-local_domain%jbegin+1
+        je=task_domain(rank)%jend-local_domain%jbegin+1
+
+        task_domain(rank)%ibegin=ib
+        task_domain(rank)%iend=ie
+        task_domain(rank)%jbegin=jb
+        task_domain(rank)%jend=je
+      
+        local_domain%lon(ib:ie,jb:je)=task_domain(rank)%lon(:,:)
+        local_domain%lat(ib:ie,jb:je)=task_domain(rank)%lat(:,:)
+      ENDDO
+  
+      IF (local_domain%ni > max_ni) max_ni=local_domain%ni
+      IF (local_domain%nj > max_nj) max_nj=local_domain%nj
+    ENDDO
+  
+    ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    
+  END SUBROUTINE Init_grids
+  
+  SUBROUTINE bufferize_field2d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+
+    Pt=>grids(id)%task_domain(task)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+   
+    Pt=>grids(id)%task_domain(task)
+
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+    
+END MODULE box_grid
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_boxed_domain.f90	(revision 3437)
@@ -0,0 +1,145 @@
+MODULE boxed_domain
+
+  INTEGER,SAVE :: ni_glo
+  INTEGER,SAVE :: nj_glo
+  INTEGER,SAVE :: nb_proc
+  
+  TYPE local_domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE local_domain
+  
+  TYPE(local_domain),ALLOCATABLE,SAVE,TARGET :: domains(:)
+  
+  
+  INTEGER,SAVE :: ni
+  INTEGER,SAVE :: nj
+  INTEGER,SAVE :: ibegin
+  INTEGER,SAVE :: iend
+  INTEGER,SAVE :: jbegin
+  INTEGER,SAVE :: jend
+  
+  REAL,SAVE,ALLOCATABLE :: lon(:,:)
+  REAL,SAVE,ALLOCATABLE :: lat(:,:)
+  
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:)  
+  
+CONTAINS
+
+  SUBROUTINE Init_global_domain(ni_glo_,nj_glo_,nb_proc_)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: ni_glo_
+  INTEGER, INTENT(IN) :: nj_glo_
+  INTEGER, INTENT(IN) :: nb_proc_
+  
+    ni_glo=ni_glo_
+    nj_glo=nj_glo_
+    nb_proc=nb_proc_
+    
+    ALLOCATE(domains(nb_proc))
+ 
+  END SUBROUTINE Init_global_domain
+
+
+  SUBROUTINE Init_local_domain(rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: rank
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin    
+    INTEGER, INTENT(IN) :: jbegin
+    REAL, INTENT(IN)    :: lon(ni,nj)
+    REAL, INTENT(IN)    :: lat(ni,nj)
+    
+    domains(rank)%ni=ni
+    domains(rank)%nj=nj
+    domains(rank)%ibegin=ibegin
+    domains(rank)%jbegin=jbegin   
+    domains(rank)%iend=ibegin+ni-1
+    domains(rank)%jend=jbegin+nj-1
+    ALLOCATE(domains(rank)%lon(ni,nj))
+    ALLOCATE(domains(rank)%lat(ni,nj))
+    domains(rank)%lon(:,:)=lon(:,:)
+    domains(rank)%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_local_domain
+  
+  
+  SUBROUTINE Init_domain
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    ibegin=domains(1)%ibegin
+    iend=domains(1)%iend
+    jbegin=domains(1)%jbegin
+    jend=domains(1)%jend
+    
+    DO rank=1,nb_proc
+      IF (domains(rank)%ibegin<ibegin) ibegin=domains(rank)%ibegin
+      IF (domains(rank)%iend>iend) iend=domains(rank)%iend
+      IF (domains(rank)%jbegin<jbegin) jbegin=domains(rank)%jbegin
+      IF (domains(rank)%jend>jend) jend=domains(rank)%jend
+    ENDDO
+    
+    ni=iend-ibegin+1
+    nj=jend-jbegin+1
+    ALLOCATE(lon(ni,nj))
+    ALLOCATE(lat(ni,nj))
+    
+    DO rank=1,nb_proc
+      ib=domains(rank)%ibegin-ibegin+1
+      ie=domains(rank)%iend-ibegin+1
+      jb=domains(rank)%jbegin-jbegin+1
+      je=domains(rank)%jend-jbegin+1
+
+      domains(rank)%ibegin=ib
+      domains(rank)%iend=ie
+      domains(rank)%jbegin=jb
+      domains(rank)%jend=je
+      
+      lon(ib:ie,jb:je)=domains(rank)%lon(:,:)
+      lat(ib:ie,jb:je)=domains(rank)%lat(:,:)
+    ENDDO
+  
+    ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    
+  END SUBROUTINE 
+  
+  SUBROUTINE bufferize_field2d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+
+    Pt=>domains(rank)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+   
+    Pt=>domains(rank)
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+
+    
+END MODULE boxed_domain
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_client.f90	(revision 3437)
@@ -0,0 +1,340 @@
+MODULE mod_event_client
+  USE mod_pack, ONLY : pack_data, pack_field
+  USE mod_mpi_buffer_client, ONLY : create_request, finalize_request,is_last_request
+  USE mod_event_parameters 
+  USE mod_ioserver_namelist
+      
+CONTAINS
+
+  SUBROUTINE event__swap_context(id)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_swap_context)
+      CALL pack_data(LEN(TRIM(id)))
+      CALL pack_data(TRIM(id))
+      CALL Finalize_request
+    ELSE
+      CALL iom__swap_context(TRIM(id))
+    ENDIF
+    
+  END SUBROUTINE  event__swap_context
+  
+  
+  SUBROUTINE event__parse_xml_file(filename)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_parse_xml_file)
+      CALL pack_data(LEN(TRIM(filename)))
+      CALL pack_data(TRIM(filename))
+      CALL Finalize_request
+    ELSE
+      CALL iom__parse_xml_file(filename)
+    ENDIF
+    
+  END SUBROUTINE  event__parse_xml_file
+
+  SUBROUTINE event__set_vert_axis(vert_name,vert_value)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: vert_name
+    REAL,INTENT(IN)             :: vert_value(:)
+    
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_vert_axis)
+      CALL pack_data(LEN(TRIM(vert_name)))
+      CALL pack_data(TRIM(vert_name))
+      CALL pack_data(SIZE(vert_value))
+      CALL pack_data(vert_value)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_vert_axis(vert_name,vert_value)
+    ENDIF
+    
+  END SUBROUTINE  event__set_vert_axis
+
+  SUBROUTINE event__set_grid_dimension(name,ni_glo,nj_glo)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_dimension)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(ni_glo)
+      CALL pack_data(nj_glo)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+    ENDIF
+    
+  END SUBROUTINE event__set_grid_dimension
+
+  
+  SUBROUTINE event__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_domain)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(ni)
+      CALL pack_data(nj)
+      CALL pack_data(ibegin)
+      CALL pack_data(jbegin)
+      CALL pack_data(lon)
+      CALL pack_data(lat)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_domain
+
+  SUBROUTINE event__set_grid_type_nemo(name)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_nemo)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_nemo(name)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_nemo
+  
+  SUBROUTINE event__set_grid_type_lmdz(name,nbp,offset)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_lmdz)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(nbp)
+      CALL pack_data(offset)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_lmdz(name,nbp,offset)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_lmdz
+  
+  SUBROUTINE event__set_time_parameters(itau0,zjulian,zdt)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: itau0
+    REAL,   INTENT(IN)  :: zjulian
+    REAL,   INTENT(IN)  :: zdt
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_time_parameters)
+      CALL pack_data(itau0)
+      CALL pack_data(zjulian)
+      CALL pack_data(zdt)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_time_parameters(itau0,zjulian,zdt)
+    ENDIF
+    
+  END SUBROUTINE event__set_time_parameters
+
+
+  SUBROUTINE event__set_calendar(str_calendar)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: str_calendar
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_calendar)
+      CALL pack_data(LEN(TRIM(str_calendar)))
+      CALL pack_data(TRIM(str_calendar))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_calendar(str_calendar)
+    ENDIF
+      
+  END SUBROUTINE event__set_calendar
+  
+  
+  SUBROUTINE event__enable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_enable_field)
+      CALL pack_data(len(varname))
+      CALL pack_data(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__enable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__enable_field
+
+  SUBROUTINE event__disable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_disable_field)
+      CALL pack_data(len(varname))
+      CALL pack_data(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__disable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__disable_field
+  
+  SUBROUTINE event__write_field1d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field1d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field1d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field2d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(size(var,2))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field2d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field2d
+  
+  SUBROUTINE event__write_field3d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field3d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(size(var,2))
+      CALL pack_data(size(var,3))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field3d(varname,var)
+    ENDIF
+  END SUBROUTINE event__write_field3d
+  
+
+  SUBROUTINE event__set_timestep(timestep)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_timestep)
+      CALL pack_data(timestep)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_timestep(timestep)
+    ENDIF
+
+  END SUBROUTINE event__set_timestep
+    
+    
+  SUBROUTINE event__close_io_definition
+  USE iomanager
+  IMPLICIT NONE
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_close_io_definition)
+      CALL Finalize_request
+    ELSE
+      CALL iom__close_io_definition
+    ENDIF
+
+  END SUBROUTINE event__close_io_definition
+
+  
+  SUBROUTINE event__set_attribut(id,attrib)
+  USE iomanager
+  USE mod_attribut
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN)   :: attrib
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_set_attribut)
+      CALL pack_data(len(id))
+      CALL pack_data(id)
+      CALL pack_data(attrib)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_attribut(id,attrib)
+    ENDIF
+ 
+  END SUBROUTINE event__set_attribut  
+
+  SUBROUTINE event__stop_ioserver
+  USE iomanager
+  IMPLICIT NONE
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_stop_ioserver)
+      is_last_request=.TRUE.
+      CALL Finalize_request
+    ELSE
+      CALL iom__finalize
+    ENDIF
+
+  END SUBROUTINE event__stop_ioserver
+    
+  
+END MODULE mod_event_client
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_parameters.f90	(revision 3437)
@@ -0,0 +1,21 @@
+MODULE mod_event_parameters
+  INTEGER, PARAMETER :: event_id_parse_xml_file        = 100
+  INTEGER, PARAMETER :: event_id_set_local_domain      = 101
+  INTEGER, PARAMETER :: event_id_set_vert_axis         = 102
+  INTEGER, PARAMETER :: event_id_set_time_parameters   = 103
+  INTEGER, PARAMETER :: event_id_set_timestep          = 104
+  INTEGER, PARAMETER :: event_id_write_field2d         = 105
+  INTEGER, PARAMETER :: event_id_write_field3d         = 106
+  INTEGER, PARAMETER :: event_id_close_io_definition   = 107
+  INTEGER, PARAMETER :: event_id_set_grid_dimension    = 108
+  INTEGER, PARAMETER :: event_id_set_grid_domain       = 109
+  INTEGER, PARAMETER :: event_id_set_grid_type_nemo    = 110
+  INTEGER, PARAMETER :: event_id_enable_field          = 111
+  INTEGER, PARAMETER :: event_id_disable_field         = 112
+  INTEGER, PARAMETER :: event_id_swap_context          = 113
+  INTEGER, PARAMETER :: event_id_set_grid_type_lmdz    = 114
+  INTEGER, PARAMETER :: event_id_write_field1d         = 115
+  INTEGER, PARAMETER :: event_id_set_attribut          = 116
+  INTEGER, PARAMETER :: event_id_set_calendar          = 117
+  INTEGER, PARAMETER :: event_id_stop_ioserver         = 999
+END MODULE mod_event_parameters
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_event_server.f90	(revision 3437)
@@ -0,0 +1,465 @@
+MODULE mod_event_server
+  USE mod_pack, ONLY : unpack_data, unpack_field
+  USE mod_event_parameters
+  USE iomanager
+  
+CONTAINS
+
+  SUBROUTINE Process_event(current_rank,is_terminated)
+  IMPLICIT NONE
+    INTEGER :: event_id
+    INTEGER, INTENT(IN) :: current_rank
+    LOGICAL,INTENT(OUT) :: is_terminated
+     
+    CALL iom__set_current_rank(current_rank)
+     
+    is_terminated=.FALSE.
+    
+    CALL unpack_data(event_id)
+    
+    SELECT CASE (event_id)
+    
+      CASE (event_id_swap_context)
+        CALL event__swap_context
+        
+      CASE (event_id_parse_xml_file)
+        CALL event__parse_xml_file 
+
+      CASE (event_id_set_vert_axis)
+        CALL event__set_vert_axis 
+     
+      CASE (event_id_set_grid_dimension)
+        CALL event__set_grid_dimension
+      
+      CASE (event_id_set_grid_domain)
+        CALL event__set_grid_domain
+
+      CASE (event_id_set_grid_type_nemo)
+        CALL event__set_grid_type_nemo
+
+      CASE (event_id_set_grid_type_lmdz)
+        CALL event__set_grid_type_lmdz
+
+      CASE (event_id_set_time_parameters)
+        CALL event__set_time_parameters
+
+      CASE (event_id_close_io_definition)
+        CALL event__close_io_definition  
+
+      CASE (event_id_set_timestep)
+        CALL event__set_timestep
+
+      CASE (event_id_set_calendar)
+        CALL event__set_calendar
+
+      CASE (event_id_enable_field)
+        CALL event__enable_field
+      
+      CASE (event_id_disable_field)
+        CALL event__disable_field
+
+      CASE (event_id_write_Field1d)
+        CALL event__write_Field1d
+
+      CASE (event_id_write_Field2d)
+        CALL event__write_Field2d
+
+      CASE (event_id_write_Field3d)
+        CALL event__write_Field3d
+
+      CASE (event_id_set_attribut)
+        CALL event__set_attribut
+
+      CASE (event_id_stop_ioserver)
+        is_terminated=.TRUE.  
+        PRINT *,"TERMINATE_EVENT RECEIVED"
+        
+
+      CASE DEFAULT 
+        STOP 'UNDEFINED EVENT'
+      
+     END SELECT
+     
+   END SUBROUTINE Process_event
+   
+  SUBROUTINE event__swap_context
+  IMPLICIT NONE
+    INTEGER :: id_size
+   
+    CALL unpack_data(id_size)
+    CALL sub_internal(id_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(id_size)
+      INTEGER :: id_size
+      CHARACTER(LEN=id_size) :: id     
+     
+       CALL unpack_data(id)
+     
+       CALL iom__swap_context(id)
+       
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__swap_context
+  
+
+  SUBROUTINE event__parse_xml_file
+  IMPLICIT NONE
+    INTEGER :: name_size
+   
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: filename     
+     
+       CALL unpack_data(filename)
+     
+       CALL iom__parse_xml_file(filename)
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__parse_xml_file
+  
+  
+  SUBROUTINE event__set_grid_dimension
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni_glo
+    INTEGER :: nj_glo
+   
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+       CALL unpack_data(ni_glo)
+       CALL unpack_data(nj_glo)
+     
+       CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+     END SUBROUTINE sub_internal
+   
+   END SUBROUTINE event__set_grid_dimension
+
+
+  SUBROUTINE event__set_grid_domain 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: jbegin
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+    
+       CALL unpack_data(ni)
+       CALL unpack_data(nj)
+       CALL unpack_data(ibegin)
+       CALL unpack_data(jbegin)
+    
+       ALLOCATE(lon(ni,nj))
+       ALLOCATE(lat(ni,nj))
+       CALL unpack_data(lon)
+       CALL unpack_data(lat)
+    
+       CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_domain   
+
+
+  SUBROUTINE event__set_grid_type_nemo 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+       CALL iom__set_grid_type_nemo(name)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_nemo   
+
+  SUBROUTINE event__set_grid_type_lmdz 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+      INTEGER                  :: nbp
+      INTEGER                  :: offset
+      
+       CALL unpack_data(name)
+       CALL unpack_data(nbp)
+       CALL unpack_data(offset)
+       CALL iom__set_grid_type_lmdz(name,nbp,offset)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_lmdz   
+
+  SUBROUTINE event__set_vert_axis
+  IMPLICIT NONE
+    INTEGER :: name_size
+    INTEGER :: vert_size 
+    REAL,ALLOCATABLE :: vert_value(:)
+    
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name
+    
+      CALL unpack_data(name)
+      CALL unpack_data(vert_size)
+      ALLOCATE(vert_value(vert_size))
+      CALL unpack_data(vert_value) 
+      
+      CALL iom__set_vert_axis(name,vert_value)
+      
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_vert_axis
+
+  SUBROUTINE event__set_time_parameters
+  IMPLICIT NONE
+    INTEGER   :: itau0
+    REAL      :: zjulian
+    REAL      :: zdt
+      
+    CALL unpack_data(itau0)
+    CALL unpack_data(zjulian)
+    CALL unpack_data(zdt)
+    
+    CALL iom__set_time_parameters(itau0,zjulian,zdt)
+     
+  END SUBROUTINE event__set_time_parameters
+  
+
+  SUBROUTINE event__enable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack_data(varname)
+      
+      CALL iom__enable_field(varname)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__enable_field
+  
+
+  SUBROUTINE event__disable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack_data(varname)
+      
+      CALL iom__disable_field(varname)
+
+    END SUBROUTINE sub_internal
+    
+  END SUBROUTINE event__disable_field
+  
+      
+  SUBROUTINE event__write_field1D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+      
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL sub_internal(lenc,dim1)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1)
+      
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field1d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+      
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL unpack_data(dim2)
+    CALL sub_internal(lenc,dim1,dim2)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1,dim2)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2)
+      
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field2d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field2d
+    
+    
+  SUBROUTINE event__write_field3d
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+    INTEGER :: dim3
+    
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL unpack_data(dim2)
+    CALL unpack_data(dim3)
+    CALL sub_internal(lenc,dim1,dim2,dim3)
+ 
+  CONTAINS
+ 
+    SUBROUTINE sub_internal(lenc,dim1,dim2,dim3)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      INTEGER :: dim3
+ 
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2,dim3)
+        
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+       
+      CALL iom__write_field3d(varname,var)
+         
+    END SUBROUTINE sub_internal
+
+  END SUBROUTINE event__write_field3d
+    
+    
+  SUBROUTINE event__set_timestep
+  IMPLICIT NONE
+    INTEGER :: timestep
+     
+    CALL unpack_data(timestep)
+    CALL iom__set_timestep(timestep)
+    
+  END SUBROUTINE event__set_timestep
+    
+
+  SUBROUTINE event__set_calendar
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: str_calendar
+      
+      CALL unpack_data(str_calendar)
+      
+      CALL iom__set_calendar(str_calendar)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_calendar
+  
+    
+  SUBROUTINE event__close_io_definition
+  IMPLICIT NONE
+    
+    CALL iom__close_io_definition
+    
+  END SUBROUTINE event__close_io_definition
+  
+  SUBROUTINE event__set_attribut
+   USE mod_attribut
+   IMPLICIT NONE
+     TYPE(attribut) :: attrib
+     INTEGER        :: len_id
+     
+     CALL unpack_data(len_id)
+     CALL sub_internal
+   CONTAINS
+      
+     SUBROUTINE sub_internal
+       CHARACTER(LEN=len_id) :: id
+       
+       CALL unpack_data(id)
+       CALL unpack_data(attrib)
+       CALL iom__set_attribut(id,attrib)
+       CALL attr_deallocate(attrib)
+     END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_attribut    
+
+END MODULE mod_event_server   
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_field_bufferize.f90	(revision 3437)
@@ -0,0 +1,94 @@
+MODULE field_bufferize
+  
+  INTEGER,SAVE      :: nx=0
+  INTEGER,SAVE      :: ny=0
+  INTEGER,SAVE      :: nz=0
+    
+  REAL,POINTER,SAVE :: field_buffer(:,:,:)
+  
+
+  
+CONTAINS
+
+  SUBROUTINE bufferize_field(ni,ibegin,nj,jbegin,nk,kbegin,nbp,field,i_index,j_index,mask)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: jbegin
+    INTEGER,INTENT(IN) :: nk
+    INTEGER,INTENT(IN) :: kbegin
+    INTEGER,INTENT(IN) :: nbp
+    REAL,INTENT(IN)    :: field(nbp,nk)
+    INTEGER,INTENT(IN) :: i_index(nbp)
+    INTEGER,INTENT(IN) :: j_index(nbp)
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(nbp)  
+    
+    INTEGER :: iend
+    INTEGER :: jend
+    INTEGER :: kend 
+
+    LOGICAL      :: need_reallocate
+    REAL,POINTER :: tmp_buffer(:,:,:)
+    INTEGER      :: i,j,k,n
+    
+    iend=ibegin+ni-1
+    jend=jbegin+nj-1
+    kend=kbegin+nk-1
+    
+    IF (PRESENT(mask)) THEN
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          IF (mask(n)) field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ELSE
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+  END SUBROUTINE bufferize_field
+
+  SUBROUTINE Init_field_Bufferize(ni,nj,nk)
+  IMPLICIT NONE
+  INTEGER,INTENT(IN) :: ni
+  INTEGER,INTENT(IN) :: nj
+  INTEGER,INTENT(IN) :: nk
+     
+    LOGICAL :: need_reallocate
+    
+    
+    need_reallocate=.FALSE.
+    
+    IF ( ni > nx) THEN
+      nx=ni
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF ( nj > ny) THEN
+      ny=nj
+      need_reallocate=.TRUE.
+    ENDIF
+
+    IF ( nk > nz) THEN
+      nz=nk
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF (need_reallocate) THEN
+      IF (ASSOCIATED(field_buffer)) DEALLOCATE(field_buffer)
+      ALLOCATE(field_buffer(nx,ny,nz))
+    ENDIF
+
+    field_buffer(1:nx,1:ny,1:nz)=0.
+
+  END SUBROUTINE  init_field_bufferize         
+
+END MODULE field_bufferize
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_global_memory.f90	(revision 3437)
@@ -0,0 +1,123 @@
+MODULE mod_global_memory
+
+  INTERFACE allocate_global_memory
+    MODULE PROCEDURE Allocate_global_memory_r8,    &
+                     Allocate_global_memory_i8,    &
+!                     Allocate_global_memory_r4,    &
+                     Allocate_global_memory_i4
+  END INTERFACE Allocate_global_memory
+  
+CONTAINS
+
+  SUBROUTINE Allocate_global_memory_r8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    REAL(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    REAL(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      REAL(kind=8),DIMENSION(:),target :: MPI_Buffer
+      REAL(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_r8
+
+
+
+  SUBROUTINE Allocate_global_memory_i8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=8),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i8
+  
+  
+!  SUBROUTINE Allocate_global_memory_r4(size,Pt)
+!  USE mpi_mod
+!  IMPLICIT NONE
+!    REAL(kind=4),POINTER :: Pt(:)
+!    INTEGER              :: size
+!
+!    POINTER (Pbuffer,MPI_Buffer(size))
+!    REAL(kind=4) :: MPI_Buffer
+!    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+!    INTEGER :: ierr
+!    
+!    BS=4*size
+!    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+!    CALL associate_buffer(MPI_Buffer,Pt)
+!  
+!  CONTAINS
+!  
+!    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+!    IMPLICIT NONE
+!      REAL(kind=4),DIMENSION(:),target :: MPI_Buffer
+!      REAL(kind=4),POINTER             :: Pt(:)
+!      Pt=>MPI_buffer
+!    END SUBROUTINE associate_buffer
+!  
+!  END SUBROUTINE Allocate_global_memory_r4
+
+
+
+
+  SUBROUTINE Allocate_global_memory_i4(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=4),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=4) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=4*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=4),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=4),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i4
+  
+  
+END MODULE mod_global_memory
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_interface_ioipsl.f90	(revision 3437)
@@ -0,0 +1,273 @@
+MODULE mod_interface_ioipsl
+
+ 
+  INTEGER,PARAMETER     :: id_file=1
+
+
+CONTAINS
+
+  SUBROUTINE init_interface_ioipsl
+  USE xmlio
+  IMPLICIT NONE
+  
+    
+  END SUBROUTINE init_interface_ioipsl
+
+  SUBROUTINE set_calendar(str_calendar)
+  USE ioipsl
+    CHARACTER(LEN=*) :: str_calendar
+    
+    CALL ioconf_calendar(str_calendar)
+    
+  END SUBROUTINE set_calendar
+  
+  
+  SUBROUTINE set_time_parameters(ini_timestep0,zjulian0,timestep0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER :: ini_timestep0
+    REAL :: zjulian0, timestep0
+
+    timestep_value=timestep0
+    initial_timestep=ini_timestep0
+    initial_date=zjulian0
+
+  END SUBROUTINE set_time_parameters
+
+  SUBROUTINE Create_file_definition(nb_server,server_rank)
+  USE ioipsl
+  USE xmlio
+  USE mod_ioserver_namelist
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    
+    TYPE(file_dep),POINTER :: pt_file_dep
+    TYPE(file),POINTER     :: pt_file
+    TYPE(field),POINTER    :: pt_field
+    TYPE(grid),POINTER     :: pt_grid
+    TYPE(zoom),POINTER     :: pt_zoom
+    TYPE(axis),POINTER     :: pt_axis
+    TYPE(domain),POINTER   :: pt_domain
+
+    TYPE(sorted_list),POINTER :: axis_id
+    LOGICAL :: found                  
+    INTEGER :: ioipsl_axis_id
+    INTEGER :: ioipsl_file_id
+    INTEGER :: ioipsl_hori_id
+    INTEGER :: ioipsl_domain_id
+    INTEGER :: i,j
+    CHARACTER(LEN=20) :: direction
+    CHARACTER(LEN=255) :: full_name
+    CALL xmlio__close_definition 
+    
+    ALLOCATE(axis_id)
+    
+    DO i=1,file_enabled%size
+      
+      pt_file_dep=>file_enabled%at(i)%pt
+
+      IF (pt_file_dep%fields%size>0) THEN
+        CALL sorted_list__new(axis_id)
+
+        pt_file=>pt_file_dep%file
+      
+        pt_grid=>pt_file_dep%grids%at(1)%pt
+        pt_domain=>pt_grid%domain
+        pt_zoom=>pt_file_dep%zooms%at(1)%pt
+!        print *,TRIM(pt_file%name),' ',TRIM(pt_zoom%id)
+!        print*,'Global --->',pt_zoom%ni_glo,pt_zoom%nj_glo,pt_zoom%ibegin_glo,pt_zoom%jbegin_glo
+!        print*,'Local  --->',pt_zoom%ni_loc,pt_zoom%nj_loc,pt_zoom%ibegin_loc,pt_zoom%jbegin_loc
+      
+        IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN
+        
+          full_name=TRIM(pt_file%name)
+          IF (pt_file%has_name_suffix) full_name=TRIM(full_name)//TRIM(pt_file%name_suffix) 
+          IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN 
+
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, & 
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         &
+                       initial_timestep, initial_date, timestep_value,                               &
+                       ioipsl_hori_id, ioipsl_file_id, snc4chunks=snc4ioset)
+           ELSE                                              
+
+            CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id)
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  &
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          &
+                       initial_timestep, initial_date, timestep_value,                                &
+                       ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id, snc4chunks=snc4ioset)                                              
+          
+           ENDIF
+        
+      
+          DO j=1,pt_file_dep%axis%size
+            pt_axis=>pt_file_dep%axis%at(j)%pt
+            CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found)
+            IF (.NOT. found) THEN
+              IF (TRIM(pt_axis%name) /= "none") THEN
+              
+                IF (pt_axis%has_positive) THEN 
+                  IF (pt_axis%positive) THEN
+                    direction="up"
+                  ELSE
+                    direction="down"
+                  ENDIF
+                ELSE
+                  direction='unknown'
+                ENDIF
+
+                CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    &
+                             TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id,  &
+                           pdirect=direction)
+                CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id)
+              ENDIF
+            ENDIF
+         ENDDO
+        
+          DO j=1,pt_file_dep%fields%size
+            pt_field=>pt_file_dep%fields%at(j)%pt
+            IF (pt_field%axis%name=="none") THEN
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            &
+                        &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      &
+                        &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 &
+                        &  real(pt_field%freq_op), real(pt_file%output_freq) )
+            ELSE
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found)
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          &
+                         & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    &
+                         & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          &
+                         & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     &
+                         & real(pt_file%output_freq) )
+            ENDIF
+          ENDDO
+          CALL histend(ioipsl_file_id, snc4chunks=snc4ioset)
+        ENDIF
+        CALL sorted_list__delete(axis_id)
+      ENDIF
+    ENDDO
+    
+    DEALLOCATE(axis_id)
+     
+  END SUBROUTINE Create_file_definition  
+
+
+
+   SUBROUTINE write_ioipsl_2d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+      
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+     
+   END SUBROUTINE write_ioipsl_2d
+       
+     
+   SUBROUTINE write_ioipsl_3d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+        
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+   END SUBROUTINE write_ioipsl_3d
+           
+
+  SUBROUTINE set_timestep(timestep_nb0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep_nb0
+     
+    timestep_number=timestep_nb0
+
+  END SUBROUTINE set_timestep
+
+
+  SUBROUTINE set_ioipsl_domain_id(pt_grid, nb_server,server_rank,domain_id)
+  USE xmlio
+  USE mod_ioserver_para
+  USE ioipsl
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    INTEGER,INTENT(OUT) :: domain_id
+    TYPE(domain), POINTER :: pt_domain
+               
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+    
+    pt_domain=>pt_grid%domain
+
+    ddid = (/ 1,2 /)
+    dsg  = (/ pt_grid%ni, pt_grid%nj /)
+    dsl  = (/ pt_domain%ni, pt_domain%nj /)
+    dpf  = (/ pt_domain%ibegin,pt_domain%jbegin /)
+    dpl  = (/ pt_domain%iend, pt_domain%jend /)
+    dhs  = (/ 0,0 /)
+    dhe  = (/ 0,0 /)
+    
+    call flio_dom_set(nb_server,server_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'BOX',domain_id)
+  
+  END SUBROUTINE set_ioipsl_domain_id
+
+
+  SUBROUTINE ioipsl_finalize
+  USE ioipsl
+  IMPLICIT NONE
+
+    CALL histclo
+    
+  END SUBROUTINE ioipsl_finalize
+  
+END MODULE mod_interface_ioipsl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient.f90	(revision 3437)
@@ -0,0 +1,61 @@
+MODULE mod_ioclient
+
+
+CONTAINS
+
+  SUBROUTINE init_ioclient(NEW_COMM)
+  USE mod_ioclient_para
+  USE mod_mpi_buffer_client
+  USE mod_wait
+  USE mod_ioserver_namelist
+  USE mod_event_client
+  USE iomanager
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER, INTENT(INOUT),OPTIONAL :: NEW_COMM
+
+    INTEGER :: Comm
+    INTEGER :: nb_server
+    INTEGER :: rank
+    INTEGER :: ierr
+    LOGICAL :: init
+ 
+    CALL read_namelist
+
+    IF (using_mpi) THEN
+      IF (using_server) THEN
+        CALL Init_parallel
+        CALL Init_mpi_buffer
+        CALL Init_wait
+        IF (PRESENT(NEW_COMM)) THEN
+          NEW_COMM=intracomm
+        ENDIF
+      ELSE
+        CALL MPI_INITIALIZED(init,ierr)
+        IF (init) THEN
+          IF (.NOT. PRESENT(NEW_COMM)) THEN
+             Comm=MPI_COMM_WORLD
+          ELSE
+            Comm=New_Comm
+          ENDIF
+        ELSE
+          CALL MPI_INIT(ierr)
+          Comm=MPI_COMM_WORLD
+          
+          IF (PRESENT(NEW_COMM)) THEN
+            New_Comm=MPI_COMM_WORLD
+          ENDIF
+        ENDIF  
+        CALL MPI_COMM_SIZE(Comm,nb_server,ierr)     
+        CALL MPI_COMM_RANK(Comm,rank,ierr)
+        CALL iom__init(1,nb_server,rank)
+        CALL iom__set_current_rank(1)
+      ENDIF
+    ELSE
+      CALL iom__init(1,1,0)
+      CALL iom__set_current_rank(1)
+    ENDIF
+    
+  END SUBROUTINE init_ioclient
+
+END MODULE mod_ioclient
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioclient_para.F90	(revision 3437)
@@ -0,0 +1,89 @@
+  MODULE mod_ioclient_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    INTEGER,SAVE      :: server_rank
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_get_comm  
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: NEW_COMM
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER :: mpi_rank
+    INTEGER :: mpi_size
+    INTEGER :: nb_server_io  
+    INTEGER,ALLOCATABLE :: proc_color(:) 
+    INTEGER :: i
+    INTEGER :: div,remain
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    CHARACTER(LEN=6) :: oasis_server_id
+    
+    IF (using_oasis) THEN
+      oasis_server_id=server_id
+      PRINT *,'prism_get_intracomm'
+#if defined key_oasis3 || defined key_oasis4
+      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+
+    nb_server_io=global_size-mpi_size
+    div=mpi_size/nb_server_io
+    remain=MOD(mpi_size,nb_server_io)
+    
+    IF (mpi_rank<remain*(div+1)) THEN
+      group_color=mpi_rank/(div+1)
+    ELSE
+      group_color=(nb_server_io-1)-(mpi_size-1-mpi_rank)/div
+    ENDIF
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_server) THEN
+        server_rank=i
+        EXIT
+      ENDIF
+    ENDDO
+    
+    PRINT *,"Proces No",mpi_rank,"--> server",server_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    CALL MPI_FINALIZE(ierr)
+
+  END SUBROUTINE Finalize_parallel
+  
+  END MODULE mod_ioclient_para
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_iomanager.f90	(revision 3437)
@@ -0,0 +1,435 @@
+MODULE iomanager
+  INTEGER,PRIVATE,SAVE :: nb_client
+  INTEGER,PRIVATE,SAVE :: nb_server
+  INTEGER,PRIVATE,SAVE :: server_rank
+  INTEGER,PRIVATE,SAVE :: current_rank
+  
+CONTAINS
+
+  SUBROUTINE iom__init(nb_client_,nb_server_,server_rank_)
+  IMPLICIT NONE
+   INTEGER,INTENT(IN) :: nb_client_
+   INTEGER,INTENT(IN) :: nb_server_
+   INTEGER,INTENT(IN) :: server_rank_
+   
+     nb_client=nb_client_ 
+     nb_server=nb_server_
+     server_rank=server_rank_
+     
+  END SUBROUTINE iom__init
+ 
+  SUBROUTINE iom__parse_xml_file(filename)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    
+    IF (current_rank==nb_client) CALL xmlio__init(filename)
+     
+  END SUBROUTINE iom__parse_xml_file
+   
+  SUBROUTINE iom__swap_context(id)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    
+    IF (current_rank==nb_client) CALL context__swap(id)
+     
+  END SUBROUTINE iom__swap_context
+
+  SUBROUTINE iom__set_current_rank(rank)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: rank
+    
+    current_rank=rank
+  
+  END SUBROUTINE iom__set_current_rank
+  
+  SUBROUTINE iom__set_vert_axis(name,vert_value)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN)             :: vert_value(:)
+    TYPE(axis), POINTER :: pt_axis
+    
+    IF (current_rank==nb_client) THEN
+      CALL axis__get(name, pt_axis)
+      CALL axis__set(pt_axis, a_size=size(vert_value), values=vert_value)
+    ENDIF
+ 
+  END SUBROUTINE iom__set_vert_axis
+
+ 
+  SUBROUTINE iom__set_grid_dimension(name,ni_glo,nj_glo)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    TYPE(grid), POINTER :: pt_grid
+  
+    IF (current_rank==nb_client) THEN
+      CALL grid__get(name,pt_grid)
+      CALL grid__set_dimension(pt_grid,ni_glo,nj_glo)
+    ENDIF
+
+  END SUBROUTINE iom__set_grid_dimension
+  
+  SUBROUTINE iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_new_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set(pt_domain,current_rank,ni,nj,ibegin,jbegin,lon,lat)
+
+  END SUBROUTINE iom__set_grid_domain
+
+  SUBROUTINE iom__set_grid_type_nemo(name)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set_type_box(pt_domain)
+
+  END SUBROUTINE iom__set_grid_type_nemo
+
+  SUBROUTINE iom__set_grid_type_lmdz(name,nbp,offset)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+    LOGICAL,ALLOCATABLE   :: mask(:,:)
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      ALLOCATE(mask(pt_domain%ni,pt_domain%nj))
+      mask(:,:)=.TRUE.
+      mask(1:offset,1)=.FALSE.
+      mask(MOD(offset+nbp-1,pt_domain%ni)+2:pt_domain%ni,pt_domain%nj)=.FALSE.
+      CALL domain__set_type_box(pt_domain,mask)
+
+  END SUBROUTINE iom__set_grid_type_lmdz
+      
+  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: itau0
+    REAL,INTENT(IN)     :: zjulian
+    REAL,INTENT(IN)     :: zdt
+      
+    IF (current_rank==nb_client) THEN
+      CALL set_time_parameters(itau0, zjulian, zdt)
+    ENDIF
+  END SUBROUTINE iom__set_time_parameters
+  
+  SUBROUTINE iom__close_io_definition
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL Create_file_definition(nb_server,server_rank)
+  
+  END SUBROUTINE iom__close_io_definition
+      
+
+  SUBROUTINE iom__set_timestep(timestep)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: timestep
+    
+    IF (current_rank==nb_client) CALL set_timestep(timestep)
+    
+  END SUBROUTINE iom__set_timestep
+
+  SUBROUTINE iom__set_calendar(str_calendar)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: str_calendar
+    
+    IF (current_rank==nb_client) CALL set_calendar(str_calendar)
+    
+  END SUBROUTINE iom__set_calendar
+
+  SUBROUTINE iom__enable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.TRUE.)
+    
+  END SUBROUTINE iom__enable_field
+  
+  SUBROUTINE iom__disable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.FALSE.)
+    
+  END SUBROUTINE iom__disable_field
+   
+
+  SUBROUTINE iom__write_field1d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+
+    IF (subdomain%type==box) THEN
+
+      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
+      CALL error("iom__write_field2d")
+
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (pt_field%axis%name /= 'none') THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+    ENDIF
+    
+  END SUBROUTINE iom__write_field1d
+
+   
+  SUBROUTINE iom__write_field2d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field2d")
+      ENDIF
+      
+      IF (pt_field%axis%name/="none") THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (nk /= size(var,2)) THEN
+         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
+                          'field dim :',size(var,2),'   axis dim :', nk
+         CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      IF (pt_field%axis%name=="none") THEN
+        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+      ELSE 
+        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+      ENDIF
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field2d
+
+  SUBROUTINE iom__write_field3d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field3d")
+      ENDIF
+      
+      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
+        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
+                         'field dim : ',size(var,3),'  axis dim : ',nk
+        CALL error("iom__write_field3d")
+      ENDIF
+
+    ELSE IF (subdomain%type==orange) THEN
+
+      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
+      CALL error("iom__write_field3d")
+      
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field3d
+ 
+  SUBROUTINE iom__Finalize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL ioipsl_finalize
+    
+  END SUBROUTINE iom__Finalize
+
+
+  SUBROUTINE iom__set_attribut(id,attrib)
+  USE mod_attribut
+  USE mod_object
+  USE mod_field
+  USE mod_field_group
+  USE mod_file
+  USE mod_file_group
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_zoom
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    TYPE(attribut)   :: attrib  
+    LOGICAL          :: success
+    IF (current_rank==nb_client) THEN
+    
+      SELECT CASE(attrib%object)
+        CASE(field_object)
+          CALL field_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL field__set_attribut(id,attrib,success)         
+        CASE(file_object)
+          CALL file_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL file__set_attribut(id,attrib,success)         
+        CASE(axis_object)
+          CALL axis_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL axis__set_attribut(id,attrib,success)         
+        CASE(grid_object)
+          CALL grid_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL grid__set_attribut(id,attrib,success)         
+        CASE(zoom_object)
+          CALL zoom__set_attribut(id,attrib,success)
+      END SELECT
+    ENDIF
+    
+  END SUBROUTINE iom__set_attribut
+   
+END MODULE iomanager 
+ 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_namelist.f90	(revision 3437)
@@ -0,0 +1,74 @@
+MODULE mod_ioserver_namelist
+
+  USE nc4interface
+  LOGICAL,SAVE :: using_server
+  LOGICAL,SAVE :: using_oasis
+  CHARACTER(LEN=100),SAVE :: client_id
+  CHARACTER(LEN=100),SAVE :: server_id
+  NAMELIST /coupling_param/ using_server,using_oasis,client_id,server_id  
+
+  INTEGER,SAVE :: global_mpi_buffer_size            
+  NAMELIST /mpi_param/ global_mpi_buffer_size  
+
+  INTEGER,PARAMETER,PRIVATE :: starting_unit=356
+  TYPE(snc4_ctl), SAVE :: snc4ioset
+  INTEGER :: nn_nchunks_i, nn_nchunks_j, nn_nchunks_k
+  LOGICAL :: ln_nc4zip=.false.
+  NAMELIST /namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+  
+CONTAINS
+
+  SUBROUTINE set_default_namelist
+  IMPLICIT NONE
+  
+    using_server=.FALSE.
+    using_oasis=.FALSE.
+    client_id='unknown'
+    server_id='unknown'
+    global_mpi_buffer_size=512
+    snc4ioset%luse = .false.
+    
+  END SUBROUTINE set_default_namelist
+  
+    
+  SUBROUTINE read_namelist
+  IMPLICIT NONE
+    LOGICAL :: opened
+    INTEGER :: unit
+    INTEGER :: ierr
+
+    CALL set_default_namelist   
+    unit=starting_unit
+    opened=.TRUE.
+    DO WHILE (opened) 
+      unit=unit+1
+      INQUIRE(unit,OPENED=opened)
+    ENDDO
+      
+    OPEN(UNIT=unit,FILE='xmlio_server.def',STATUS='old',IOSTAT=ierr)
+    
+    
+    IF (ierr==0) THEN
+      READ(unit,nml=coupling_param)
+      READ(unit,nml=mpi_param)
+      READ(unit,nml=namnc4,ERR=666,END=666)
+ 666  global_mpi_buffer_size=global_mpi_buffer_size*1024*128  
+      CLOSE(unit)
+      IF (ln_nc4zip) THEN
+        snc4ioset%ni  = nn_nchunks_i
+        snc4ioset%nj  = nn_nchunks_j
+        snc4ioset%nk  = nn_nchunks_k
+        snc4ioset%luse = ln_nc4zip
+      ENDIF
+    ELSE
+      PRINT *,'WARNING : mod_ioserver::read_namelist : file xmlio_server.def is absent', &
+              ' ---> using default parameter'
+    ENDIF 
+    
+    
+    PRINT *,'namelist read --> ',using_server,using_oasis,client_id,server_id
+    
+  END SUBROUTINE read_namelist
+
+
+END MODULE mod_ioserver_namelist 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_ioserver_para.F90	(revision 3437)
@@ -0,0 +1,102 @@
+  MODULE mod_ioserver_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    
+    INTEGER,SAVE      :: mpi_rank
+    INTEGER,SAVE      :: mpi_size
+    INTEGER,SAVE      :: mpi_master
+    LOGICAL,SAVE      :: is_mpi_master
+  
+    INTEGER,SAVE      :: nb_client
+    INTEGER,ALLOCATABLE,SAVE      :: client_rank(:)
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_get_comm 
+#endif 
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER,ALLOCATABLE :: proc_color(:)
+    INTEGER :: i
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    INTEGER :: comp_id
+    CHARACTER(LEN=6) :: oasis_server_id, oasis_client_id
+
+    IF (using_oasis) THEN
+       oasis_server_id=server_id
+       oasis_client_id=client_id
+#if defined key_oasis3 || defined key_oasis4
+       CALL prism_init_comp_proto (comp_id, oasis_server_id, ierr)
+       CALL prism_get_intracomm(Comm_client_server,oasis_client_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+        
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+       
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_server,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+    
+    group_color=mpi_rank
+    PRINT *,'group_color',group_color
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)    
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    PRINT *,"io_size-> ",iosize,"iorank-> ",iorank
+    
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_server,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    print *,"proc_color -> ",proc_color
+    
+    ALLOCATE(client_rank(iosize-1))
+    nb_client=0
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_client) THEN
+        nb_client=nb_client+1
+        client_rank(nb_client)=i
+      ENDIF
+    ENDDO
+
+    PRINT *,"Proces No",mpi_rank,"--> client ",client_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mod_ioserver_namelist
+#if defined key_oasis3 || defined key_oasis4
+  USE mod_prism_proto
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    IF (using_oasis) THEN
+#if defined key_oasis3 || defined key_oasis4
+      CALL prism_terminate_proto(ierr)
+#endif
+    ELSE
+      CALL MPI_FINALIZE(ierr)
+    ENDIF
+    
+  END SUBROUTINE Finalize_parallel
+
+END MODULE mod_ioserver_para
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_client.F90	(revision 3437)
@@ -0,0 +1,207 @@
+MODULE mod_mpi_buffer_client
+  USE mod_mpi_buffer_parameters
+#if defined key_mpp_mpi
+  USE mpi, ONLY : status_size=>MPI_STATUS_SIZE
+#else
+  INTEGER, PARAMETER :: status_size = 1
+#endif
+
+  
+  INTEGER(KIND=8),POINTER :: MPI_Buffer(:)
+  
+  TYPE mpi_requests
+    INTEGER :: request
+    INTEGER :: status(status_size)
+    INTEGER :: Pos
+  END TYPE mpi_requests
+  
+  TYPE(mpi_requests),DIMENSION(max_request) :: pending_request
+  
+  INTEGER :: Buffer_pos
+  INTEGER :: request_pos
+  INTEGER :: buffer_begin
+  INTEGER :: request_begin
+  INTEGER :: nb_request_pending
+  INTEGER,SAVE :: start_pos
+  LOGICAL,SAVE :: ok_new_request
+  LOGICAL,SAVE :: is_last_request
+
+  INTEGER,SAVE      :: mpi_buffer_size
+  INTEGER,SAVE      :: aggregated_request
+
+CONTAINS
+
+  SUBROUTINE Init_mpi_buffer
+  USE mod_global_memory
+  USE mod_pack
+  USE mod_ioclient_para
+  IMPLICIT NONE
+
+  INTEGER  :: nb_client
+  
+    nb_client=iosize-1  
+    mpi_buffer_size=global_mpi_buffer_size/nb_client
+    
+    CALL allocate_global_memory(mpi_buffer_size,MPI_Buffer)
+    buffer_begin=1
+    request_begin=1
+    Buffer_pos=1
+    nb_request_pending=0
+    Request_pos=1
+    ok_new_request=.TRUE.
+    is_last_request=.FALSE.
+    aggregated_request=0
+    
+    CALL set_pack_buffer(MPI_Buffer,buffer_begin)
+    
+  END SUBROUTINE Init_mpi_buffer
+  
+
+  SUBROUTINE create_request(request_id)
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: request_id
+    
+    CALL VTb(VTprocess_event)
+    IF (ok_new_request) THEN  
+      Pending_request(Request_pos)%Pos = pack_pos
+      ok_new_request=.FALSE.
+    ENDIF
+    start_pos=pack_pos
+    pack_pos=pack_pos+1
+!    PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+    CALL pack_data(request_id)
+  END SUBROUTINE create_request
+  
+  
+  SUBROUTINE Finalize_request
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  use mod_wait
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER(KIND=8) :: request_size
+    INTEGER :: buffer_free
+    LOGICAL :: ok_out
+    LOGICAL :: is_Buffer_full
+    request_size=pack_pos-start_pos    
+    pack_buffer(start_pos)=request_size
+    message_size=pack_pos-Pending_request(Request_pos)%Pos
+    aggregated_request=aggregated_request+1
+
+
+!! ICI verifier que le buffer ne se recouvre pas ainsi que les requetes
+    
+    ok_out=.FALSE.
+    is_buffer_full=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      CALL check_request
+    
+      IF ( buffer_begin <= pack_pos) THEN
+        Buffer_free=mpi_buffer_size-pack_pos+1
+      ELSE
+        Buffer_free=buffer_begin-pack_pos
+      ENDIF
+      
+!      Print *,"message_size",message_size,"buffer_free",buffer_free
+!      PRINT *,"Request_pos",request_pos
+!      PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+      IF ( nb_request_pending==1 .AND. ( (buffer_free < MPI_buffer_size * 0.4) .OR. is_last_request .OR.  &
+                                         (aggregated_request>=max_request/2) )) THEN
+        ok_out=.FALSE.
+        CALL Wait_us(10)
+        IF (.NOT. is_buffer_full) THEN
+          CALL VTb(VTbuffer_full)
+        ENDIF      
+        is_Buffer_full=.TRUE.
+        
+      ELSE
+        ok_out=.TRUE.
+        IF (is_buffer_full) THEN
+          CALL VTe(VTbuffer_full)
+        ENDIF
+        is_buffer_full=.FALSE.
+      
+      ENDIF
+      
+   ENDDO
+   
+   IF (nb_request_pending==0 .OR. (buffer_free < MPI_buffer_size* 0.4 ) .OR. (aggregated_request> max_request/2) ) THEN
+      
+     CALL MPI_ISSEND(MPI_Buffer(Pending_request(Request_pos)%Pos),message_size,MPI_INTEGER8,     &
+                    server_rank,tag_iocomm,iocomm,Pending_request(Request_pos)%request,ierr )
+    
+!    PRINT *,"Requete envoy�e !!!!" 
+!    PRINT *,"Message : ",MPI_Buffer(Pending_request(Request_pos)%Pos:Pending_request(Request_pos)%Pos+message_size-1)              
+      IF ( Pack_Pos > MPI_buffer_size*0.6 ) THEN
+        Pack_Pos=1
+      ENDIF
+    
+      IF (Request_Pos==max_request) THEN
+        Request_Pos=1
+      ELSE 
+        Request_Pos=Request_Pos+1
+      ENDIF
+      nb_request_pending=nb_request_pending+1
+    
+      ok_new_request=.TRUE.
+      aggregated_request=0
+    ENDIF
+    CALL VTe(VTprocess_event)    
+  END SUBROUTINE Finalize_request
+
+
+  SUBROUTINE Check_request
+  USE mpi_mod
+  IMPLICIT NONE
+  LOGICAL :: ok_out
+  LOGICAL :: OK_complete
+  INTEGER :: ierr
+  
+!    PRINT *, 'on entre dans Check_request'
+!    PRINT *, 'nb_request_pending',nb_request_pending
+    
+    IF (nb_request_pending>0) THEN
+      ok_out=.FALSE.
+    ELSE
+      ok_out=.TRUE.
+    ENDIF
+    
+    DO WHILE (.NOT. ok_out)
+    
+!      PRINT *,'Testing_request...'
+!      PRINT *,'request_begin',request_begin
+      CALL MPI_TEST(Pending_request(request_begin)%request,ok_complete,Pending_request(request_begin)%status,ierr)
+!      PRINT *,'Request has been tested...'
+      IF (ok_complete) THEN
+!        PRINT *,"Request_completed"
+        IF (Request_begin==max_request) THEN
+          Request_begin=1
+        ELSE
+          request_begin=request_begin+1
+        ENDIF
+        
+        buffer_begin=Pending_request(request_begin)%Pos
+        
+        nb_request_pending=nb_request_pending-1
+        
+        IF (nb_request_pending==0) THEN 
+          ok_out=.TRUE.
+        ELSE
+          ok_out=.FALSE.
+        ENDIF
+      ELSE
+        ok_out=.TRUE.
+      ENDIF
+    
+    ENDDO
+!    PRINT *, 'on sort de Check_request'  
+  END SUBROUTINE Check_Request
+
+END MODULE mod_mpi_buffer_client
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 3437)
@@ -0,0 +1,7 @@
+MODULE mod_mpi_buffer_parameters
+  USE mod_ioserver_namelist, ONLY : global_mpi_buffer_size
+  INTEGER,PARAMETER :: max_request = 10000
+  REAL, PARAMETER   :: frac_alert  = 0.9
+  INTEGER           :: tag_iocomm  = 4000
+  INTEGER           :: tag_terminate = 4001
+END MODULE mod_mpi_buffer_parameters
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 3437)
@@ -0,0 +1,262 @@
+MODULE mod_mpi_buffer_server
+  USE mod_mpi_buffer_parameters
+
+  TYPE mpi_requests
+    INTEGER :: Pos
+    INTEGER :: size
+  END TYPE mpi_requests
+  
+  TYPE buffer
+    INTEGER(KIND=8),POINTER  :: mpi_buffer(:)
+    INTEGER :: pos
+    INTEGER :: begin
+    TYPE(mpi_requests),POINTER :: request(:)
+    INTEGER :: request_pos
+    INTEGER :: nb_request
+    INTEGER :: request_begin
+    INTEGER :: request_free
+    LOGICAL :: is_posted
+    LOGICAL :: is_terminated
+    INTEGER :: last_request
+  END TYPE buffer
+
+  TYPE(buffer),ALLOCATABLE,SAVE :: buffers(:)
+  
+  INTEGER,SAVE :: current_rank
+  INTEGER,SAVE :: mpi_buffer_size
+  
+CONTAINS
+  
+  SUBROUTINE Init_mpi_buffer
+  USE mod_ioserver_para
+  USE mod_global_memory
+  IMPLICIT NONE
+    INTEGER :: n
+    
+    ALLOCATE(buffers(nb_client))
+    mpi_buffer_size=global_mpi_buffer_size/nb_client 
+    DO n=1,nb_client
+      CALL allocate_global_memory(mpi_buffer_size,buffers(n)%MPI_Buffer)
+      buffers(n)%pos=1
+      buffers(n)%begin=1
+      ALLOCATE(buffers(n)%request(max_request))
+      buffers(n)%nb_request=0
+      buffers(n)%request_free=max_request
+      buffers(n)%request_pos=1
+      buffers(n)%request_begin=1
+      buffers(n)%is_posted=.FALSE.
+      buffers(n)%is_terminated=.FALSE.
+    ENDDO
+
+  END SUBROUTINE Init_mpi_buffer
+
+  SUBROUTINE Check_buffer
+  USE mod_ioserver_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: status(MPI_STATUS_SIZE)
+    LOGICAL :: ok_complete
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER :: Buffer_space 
+    INTEGER :: request
+    
+    CALL VTb(VTcheck_buffer)
+    DO n=1,nb_client
+      ok_out=.FALSE.
+      
+      DO WHILE (.NOT. ok_out)
+        
+        IF (buffers(n)%is_posted) THEN
+!          PRINT*,"MPI_TEST"
+!          PRINT *,"MPI_TEST LAST_REQUEST (avant)",buffers(n)%last_request,"ok_complete ?",ok_complete
+          CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!          PRINT *,"MPI_TEST LAST_REQUEST (apres)",buffers(n)%last_request,"ok_complete ?",ok_complete
+
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+            CALL Fill_request(n,Buffers(n)%pos,message_size)
+            buffers(n)%is_posted=.FALSE.
+            buffers(n)%pos=buffers(n)%pos+message_size
+         
+!            PRINT *,"buffer_pos",buffers(n)%pos
+!            PRINT *,"Message recu de taille", message_size
+!              PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!              PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+              ok_out=.FALSE.
+          ELSE
+              ok_out=.TRUE.
+          ENDIF
+       
+        ELSE  ! (.NOT. is_posted)        
+!          PRINT *,"MPI_IPROBE"
+     
+          CALL MPI_IPROBE(client_rank(n),tag_iocomm,iocomm,ok_complete,status,ierr)
+!          PRINT *,"Ok_complete.. ?",ok_complete
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+!            PRINT *,"message_size",message_size
+            IF (buffers(n)%pos >= buffers(n)%begin) THEN
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) THEN
+                buffer_space=buffers(n)%begin-1
+              ELSE
+                buffer_space=mpi_buffer_size-buffers(n)%begin+1
+              ENDIF
+            ELSE
+              buffer_space=buffers(n)%begin-buffers(n)%pos
+            ENDIF
+            
+            IF (buffer_space < message_size .OR. buffers(n)%request_free<=max_request/2) THEN
+              ok_out=.TRUE.
+!              PRINT *,"BUFFER FULL !!!!"
+!              PRINT *,"buffer_space",buffer_space,"request_free",buffers(n)%request_free
+!              PRINT *,"buffer_pos",buffers(n)%pos,"buffer_begin",buffers(n)%begin
+            ELSE
+              
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) buffers(n)%pos=1
+          
+!              PRINT *,'reception du message'
+              CALL MPI_IRECV(buffers(n)%mpi_buffer(buffers(n)%pos),message_size,MPI_INTEGER8,          &
+                          client_rank(n),tag_iocomm,iocomm,buffers(n)%last_request,ierr)
+                          
+              buffers(n)%is_posted=.TRUE.
+!              PRINT *,"MPI_IRECV LAST_REQUEST",buffers(n)%last_request
+              CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!              PRINT *,"MPI_TEST LAST_REQUEST",buffers(n)%last_request,"ok_complete ?",ok_complete
+              
+              IF (ok_complete) THEN
+                buffers(n)%is_posted=.FALSE.
+                CALL Fill_request(n,Buffers(n)%pos,message_size)
+
+                buffers(n)%pos=buffers(n)%pos+message_size
+                 
+!                PRINT *,"buffer_pos",buffers(n)%pos
+!                PRINT *,"Message recu de taille", message_size
+!                PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!                PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+                ok_out=.FALSE.
+              ELSE
+                ok_out=.TRUE.
+              ENDIF
+         
+            ENDIF
+          ELSE
+            ok_out=.TRUE.
+          ENDIF
+        ENDIF  ! (is_posted)
+        ok_out=.TRUE.
+      ENDDO
+    ENDDO
+
+    CALL VTe(VTcheck_buffer)
+
+  END SUBROUTINE Check_buffer
+  
+  SUBROUTINE Fill_request(n,pos,message_size)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: pos
+    INTEGER :: message_size
+    INTEGER :: current_size
+    INTEGER :: current_pos
+    INTEGER :: total_size
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+!    PRINT *,'Fill_request!!!'
+!    PRINT *,'Buffer_pos',pos
+!    PRINT *,"First integer",Buffers(n)%mpi_buffer(pos)
+    total_size=0
+    current_pos=pos
+    
+    ok_out=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      
+      IF (Buffers(n)%request_free==0) THEN
+        PRINT *,'Plus de requete disponible !!!!'
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_size=buffers(n)%mpi_buffer(current_pos)
+      Buffers(n)%request(Buffers(n)%request_pos)%pos=current_pos+1
+      Buffers(n)%request(Buffers(n)%request_pos)%size=current_size
+      total_size=total_size+current_size
+      
+      IF (Buffers(n)%request_pos==max_request) THEN 
+        Buffers(n)%request_pos=1
+      ELSE
+        Buffers(n)%request_pos=Buffers(n)%request_pos+1
+      ENDIF
+      Buffers(n)%request_free=Buffers(n)%request_free-1
+      Buffers(n)%nb_request=Buffers(n)%nb_request+1
+      
+      IF (total_size==message_size) ok_out=.TRUE.
+      IF (total_size>message_size) THEN
+        PRINT *,"Probleme : la taille du message ne coincide pas avec la taille de l'enveloppe"
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_pos=current_pos+current_size
+    ENDDO
+  
+  END SUBROUTINE Fill_request 
+    
+  
+  SUBROUTINE Process_request(is_terminated)
+  USE mod_event_server
+  USE mod_ioserver_para
+  USE mod_pack
+  USE mpitrace
+  USE mod_wait
+  IMPLICIT NONE
+    LOGICAL  :: is_terminated
+    INTEGER  :: n
+    
+    is_terminated=.FALSE.
+    
+    IF (ALL(buffers(:)%nb_request>0)) THEN
+      DO n=1,nb_client
+!        PRINT *,"nb_request ?",buffers(n)%nb_request
+        IF ( (buffers(n)%nb_request > 0) .AND. (.NOT. buffers(n)%is_terminated)) THEN
+!          PRINT *,"request_pos",buffers(n)%request_begin
+!          PRINT *,"buffer_pos",buffers(n)%request(buffers(n)%request_begin)%pos
+          CALL set_pack_buffer(buffers(n)%mpi_buffer,buffers(n)%request(buffers(n)%request_begin)%pos)
+          CALL VTb(VTprocess_event)
+          current_rank=n
+          CALL process_event(n,buffers(n)%is_terminated)
+          CALL VTe(VTprocess_event)
+          buffers(n)%nb_request=buffers(n)%nb_request-1
+          buffers(n)%request_free=buffers(n)%request_free+1
+        
+       
+          IF (Buffers(n)%request_begin==max_request) THEN
+            Buffers(n)%request_begin=1
+          ELSE
+            buffers(n)%request_begin=Buffers(n)%request_begin+1
+          ENDIF
+          
+          IF (buffers(n)%nb_request > 0) THEN 
+            buffers(n)%begin=buffers(n)%request(buffers(n)%request_begin)%pos
+          ELSE
+            buffers(n)%begin=buffers(n)%pos
+          ENDIF
+        ENDIF
+      ENDDO 
+    
+!      PRINT *,"buffers_is_terminated",buffers(1:nb_client)%is_terminated
+!      PRINT *,"buffers_nb_request",buffers(1:nb_client)%nb_request
+      IF (ALL(buffers(1:nb_client)%is_terminated)) THEN
+        IF (ALL(buffers(1:nb_client)%nb_request==0)) THEN
+          is_terminated=.TRUE.
+        ENDIF
+      ENDIF
+    ELSE
+      CALL Wait_us(5)
+    ENDIF     
+  END SUBROUTINE process_request  
+  
+    
+END MODULE mod_mpi_buffer_server
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_pack.f90	(revision 3437)
@@ -0,0 +1,603 @@
+  MODULE mod_pack
+    INTEGER,PARAMETER :: integer_size=4
+    INTEGER,PARAMETER :: pack_buffer_max_size=integer_size*1024*1024
+    INTEGER(kind=8),POINTER,SAVE      :: pack_buffer(:)
+    INTEGER,SAVE      :: pack_pos
+    
+    INTERFACE pack_data
+      MODULE PROCEDURE pack_r,pack_r1,pack_r2,pack_r3,pack_r4,                 &
+                       pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 &
+                       pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 &
+                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4,                 &
+                       pack_attr
+    END INTERFACE pack_data
+
+    INTERFACE unpack_data
+      MODULE PROCEDURE unpack_r,unpack_r1,unpack_r2,unpack_r3,unpack_r4,       &
+                       unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       &
+                       unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       &
+                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4,       &
+                       unpack_attr
+    END INTERFACE unpack_data
+
+    INTERFACE pack_field
+      MODULE PROCEDURE pack_field1,pack_field2,pack_field3,pack_field4        
+    END INTERFACE pack_field
+
+    INTERFACE unpack_field
+      MODULE PROCEDURE unpack_field1,unpack_field2,unpack_field3,unpack_field4 
+    END INTERFACE unpack_field
+           
+  CONTAINS
+  
+    SUBROUTINE set_pack_buffer(pack_buffer0,pack_pos0)
+    IMPLICIT NONE
+    INTEGER(kind=8),POINTER  :: pack_buffer0(:)
+    INTEGER                  :: pack_pos0
+    
+      pack_buffer=>pack_buffer0
+      pack_pos=pack_pos0
+
+    END SUBROUTINE set_pack_buffer
+    
+    
+    SUBROUTINE pack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_r
+     
+     SUBROUTINE pack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r1
+
+    
+     SUBROUTINE pack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r2
+     
+     
+     SUBROUTINE pack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r3
+
+     
+     SUBROUTINE pack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r4
+
+
+    SUBROUTINE unpack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_r
+     
+     SUBROUTINE unpack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r1
+
+    
+     SUBROUTINE unpack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r2
+     
+     
+     SUBROUTINE unpack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r3
+
+     
+     SUBROUTINE unpack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r4
+
+
+
+
+    SUBROUTINE pack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_i
+     
+     SUBROUTINE pack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i1
+
+    
+     SUBROUTINE pack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i2
+     
+     
+     SUBROUTINE pack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i3
+
+     
+     SUBROUTINE pack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i4
+     
+
+    SUBROUTINE unpack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_i
+     
+     SUBROUTINE unpack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i1
+
+    
+     SUBROUTINE unpack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i2
+     
+     
+     SUBROUTINE unpack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i3
+
+     
+     SUBROUTINE unpack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i4     
+
+
+
+
+
+
+
+    SUBROUTINE pack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_l
+     
+     SUBROUTINE pack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l1
+
+    
+     SUBROUTINE pack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l2
+     
+     
+     SUBROUTINE pack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l3
+
+     
+     SUBROUTINE pack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l4
+     
+
+    SUBROUTINE unpack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_l
+     
+     SUBROUTINE unpack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l1
+
+    
+     SUBROUTINE unpack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l2
+     
+     
+     SUBROUTINE unpack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l3
+
+     
+     SUBROUTINE unpack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l4     
+
+
+
+
+   
+     
+   SUBROUTINE pack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE pack_c
+     
+     SUBROUTINE pack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE pack_c1
+
+    
+     SUBROUTINE pack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE pack_c2
+     
+     
+     SUBROUTINE pack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE pack_c3
+
+     
+     SUBROUTINE pack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE pack_c4
+     
+
+    SUBROUTINE unpack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE unpack_c
+     
+     SUBROUTINE unpack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE unpack_c1
+
+    
+     SUBROUTINE unpack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE unpack_c2
+     
+     
+     SUBROUTINE unpack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE unpack_c3
+
+     
+     SUBROUTINE unpack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE unpack_c4     
+     
+
+
+
+
+     SUBROUTINE pack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field1
+
+
+     SUBROUTINE pack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+       
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field2
+     
+     SUBROUTINE pack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field3
+
+     SUBROUTINE pack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field4
+
+
+
+     SUBROUTINE unpack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field1
+
+
+     SUBROUTINE unpack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field2
+     
+     SUBROUTINE unpack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field3
+
+     SUBROUTINE unpack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field4
+      
+     SUBROUTINE pack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL pack_data(attrib%object)
+       CALL pack_data(attrib%name)
+       CALL pack_data(attrib%type)
+       CALL pack_data(attrib%dim)
+       CALL pack_data(attrib%ndim)
+       CALL pack_data(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           CALL pack_data(attrib%integer0_ptr)
+         CASE (integer1)
+           CALL pack_data(attrib%integer1_ptr)
+         CASE (integer2)
+           CALL pack_data(attrib%integer2_ptr)
+         CASE (real0)
+           CALL pack_data(attrib%real0_ptr)
+         CASE (real1)
+           CALL pack_data(attrib%real1_ptr)
+         CASE (real2)
+           CALL pack_data(attrib%real2_ptr)
+         CASE (logical0)
+           CALL pack_data(attrib%logical0_ptr)
+         CASE (logical1)
+           CALL pack_data(attrib%logical1_ptr)
+         CASE (logical2)
+           CALL pack_data(attrib%logical2_ptr)
+         CASE (string0)
+           CALL pack_string0(attrib%string0_ptr)
+         CASE (string1)
+           CALL pack_string1(attrib%string1_ptr)
+         CASE (string2)
+           CALL pack_data(attrib%string2_ptr)
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE pack_string0(str)
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL pack_data(str)
+       END SUBROUTINE
+
+       SUBROUTINE pack_string1(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:)
+           CALL pack_data(str)
+       END SUBROUTINE
+       
+       SUBROUTINE pack_string2(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:,:)
+           CALL pack_data(str)
+       END SUBROUTINE
+
+     END SUBROUTINE pack_attr  
+
+     SUBROUTINE unpack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL unpack_data(attrib%object)
+       CALL unpack_data(attrib%name)
+       CALL unpack_data(attrib%type)
+       CALL unpack_data(attrib%dim)
+       CALL unpack_data(attrib%ndim)
+       CALL unpack_data(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+!!$           ALLOCATE(attrib%integer0_ptr)
+           CALL unpack_data(attrib%integer0_ptr)
+         CASE (integer1)
+           ALLOCATE(attrib%integer1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%integer1_ptr)
+         CASE (integer2)
+           ALLOCATE(attrib%integer2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_data(attrib%integer2_ptr)
+         CASE (real0)
+!!$           ALLOCATE(attrib%real0_ptr)
+           CALL unpack_data(attrib%real0_ptr)
+         CASE (real1)
+           ALLOCATE(attrib%real1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%real1_ptr)
+         CASE (real2)
+           ALLOCATE(attrib%real2_ptr(attrib%dim(1),attrib%dim(2)))
+         CASE (logical0)
+!!$           ALLOCATE(attrib%logical0_ptr)
+           CALL unpack_data(attrib%logical0_ptr)
+         CASE (logical1)
+           ALLOCATE(attrib%logical1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%logical1_ptr)
+         CASE (logical2)
+           ALLOCATE(attrib%logical2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_data(attrib%logical2_ptr)
+         CASE (string0)
+!!$           ALLOCATE(attrib%string0_ptr)
+           CALL unpack_string0
+         CASE (string1)
+           ALLOCATE(attrib%string1_ptr(attrib%dim(1)))
+           CALL unpack_string1
+         CASE (string2)
+           ALLOCATE(attrib%string2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_string2
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE unpack_string0
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL unpack_data(str)
+           attrib%string0_ptr=str
+       END SUBROUTINE
+
+       SUBROUTINE unpack_string1
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1))
+           CALL unpack_data(str)
+           attrib%string1_ptr=str
+       END SUBROUTINE
+       
+       SUBROUTINE unpack_string2
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1),attrib%dim(2))
+           CALL unpack_data(str)
+           attrib%string2_ptr=str
+       END SUBROUTINE
+
+     END SUBROUTINE unpack_attr              
+
+     
+  END MODULE mod_pack
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_prec.f90	(revision 3437)
@@ -0,0 +1,7 @@
+MODULE mod_prec
+  INTEGER,PARAMETER :: INTEGER_SIZE   = 4 
+  INTEGER,PARAMETER :: REAL_SIZE      = 8 
+  INTEGER,PARAMETER :: LOGICAL_SIZE   = 4 
+  INTEGER,PARAMETER :: CHARACTER_SIZE = 1
+  INTEGER,PARAMETER :: BLOCK_SIZE     = 8
+END MODULE mod_prec
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mod_wait.f90	(revision 3437)
@@ -0,0 +1,68 @@
+MODULE mod_wait
+  INTEGER, SAVE :: wait_param=10
+  REAL, SAVE    :: opt_param
+
+
+  INTEGER, SAVE :: last_count
+
+CONTAINS
+
+  
+  FUNCTION Top()
+  IMPLICIT NONE
+    DOUBLE PRECISION :: Top
+    INTEGER :: count,count_rate,count_max
+    LOGICAL, SAVE :: first=.TRUE.
+    
+      
+    CALL system_clock(count,count_rate,count_max)
+    IF (first) THEN
+      Top=0.
+    ELSE
+      IF (Count>=Last_Count) THEN
+        Top=(1.*(Count-last_Count))/count_rate
+      ELSE
+        Top=(1.*(Count-last_Count+Count_max))/count_rate
+      ENDIF
+    ENDIF
+    Last_Count=Count
+    first=.FALSE. 
+  END FUNCTION Top
+  
+  SUBROUTINE Init_wait
+  IMPLICIT NONE
+    INTEGER :: i,j
+    LOGICAL :: out_ok
+    DOUBLE PRECISION :: time 
+    INTEGER :: last_param
+  
+    out_ok=.FALSE.
+    
+    DO WHILE (.NOT. out_ok)
+      opt_param=0.
+    
+      time=top()
+!CDIR NOVECTOR
+      DO i=1,1000000*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+      ENDDO
+      time=top()
+      last_param=wait_param
+      wait_param=wait_param*(1./time)
+      IF (ABS(wait_param-last_param)/(0.5*(wait_param+last_param)) <0.01) out_ok=.TRUE.
+    END DO
+  END SUBROUTINE Init_wait
+
+  SUBROUTINE Wait_us(n)
+  IMPLICIT NONE
+  INTEGER :: n
+  INTEGER :: i
+
+!CDIR NOVECTOR  
+    DO i=1,n*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+    ENDDO
+      
+  END SUBROUTINE Wait_us   
+
+END MODULE mod_wait  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_mod.F90	(revision 3437)
@@ -0,0 +1,11 @@
+MODULE mpi_mod
+
+#if ! defined key_mpp_mpi
+    LOGICAL, PARAMETER :: using_mpi=.FALSE.
+    INCLUDE 'ios_mpif.h'
+#else
+    LOGICAL, PARAMETER :: using_mpi=.TRUE.
+    INCLUDE 'mpif.h'
+#endif
+
+END MODULE mpi_mod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpi_wrapper.F90	(revision 3437)
@@ -0,0 +1,80 @@
+SUBROUTINE void
+
+END SUBROUTINE void
+
+#if ! defined key_mpp_mpi
+
+SUBROUTINE MPI_ALLOC_MEM
+
+END SUBROUTINE MPI_ALLOC_MEM
+
+
+SUBROUTINE MPI_INITIALIZED
+
+END SUBROUTINE MPI_INITIALIZED
+
+
+SUBROUTINE MPI_INIT
+
+END SUBROUTINE MPI_INIT
+
+
+SUBROUTINE MPI_COMM_SIZE
+
+END SUBROUTINE MPI_COMM_SIZE
+
+
+SUBROUTINE MPI_COMM_RANK
+
+END SUBROUTINE MPI_COMM_RANK 
+
+
+SUBROUTINE MPI_COMM_SPLIT
+
+END SUBROUTINE MPI_COMM_SPLIT
+
+
+SUBROUTINE MPI_ALLGATHER
+
+END SUBROUTINE MPI_ALLGATHER
+
+
+SUBROUTINE MPI_FINALIZE
+
+END SUBROUTINE MPI_FINALIZE
+
+
+SUBROUTINE MPI_ISSEND
+
+END SUBROUTINE MPI_ISSEND
+
+
+SUBROUTINE MPI_TEST
+
+END SUBROUTINE MPI_TEST
+
+
+SUBROUTINE MPI_GET_COUNT
+
+END SUBROUTINE MPI_GET_COUNT
+
+
+SUBROUTINE MPI_IPROBE 
+
+END SUBROUTINE MPI_IPROBE 
+
+
+SUBROUTINE MPI_IRECV
+
+END SUBROUTINE MPI_IRECV
+
+
+SUBROUTINE MPI_ABORT
+
+END SUBROUTINE MPI_ABORT
+
+SUBROUTINE MPI_BARRIER
+
+END SUBROUTINE MPI_BARRIER
+
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/mpitrace.F90	(revision 3437)
@@ -0,0 +1,78 @@
+module mpitrace
+  INTEGER,parameter :: VTcheck_buffer=91
+  INTEGER,parameter :: VTprocess_event=92
+  INTEGER,parameter :: VTbuffer_full=93
+  
+  INTEGER,parameter :: nb_inst=7
+  INTEGER :: MPE_begin(nb_inst)
+  INTEGER :: MPE_end(nb_inst)
+  
+contains
+
+  subroutine InitVampir
+    implicit none
+
+#ifdef USE_VT
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTSYMDEF(VTcheck_buffer,"check_buffer","check_buffer",ierr)
+    call VTSYMDEF(VTprocess_event,"process_event","process_event",ierr)
+    call VTSYMDEF(VTbuffer_full,"buffer_full","buffer_full",ierr)
+    PRINT *,'definition des symbole VT'
+#endif
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    
+    DO i=1,nb_inst
+      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
+    ENDDO
+    
+    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
+    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
+    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
+    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
+    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
+    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
+    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
+#endif     
+  end subroutine InitVampir
+
+  subroutine VTb(number)
+    implicit none
+    INTEGER :: number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTBEGIN(number,ierr)
+#endif 
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
+#endif
+
+  end subroutine VTb
+
+  subroutine VTe(number)
+    implicit none
+    INTEGER :: Number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+   
+    call VTEND(number,ierr)
+#endif    
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_end(number), 0, '' )
+#endif
+
+  end subroutine VTe
+  
+end module mpitrace
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_c.c.old	(revision 3437)
@@ -0,0 +1,101 @@
+
+
+
+typedef int     INTEGER ;
+typedef double  REAL    ;
+typedef int     LOGICAL ; 
+typedef char    CHARACTER ;
+
+int INTEGER_SIZE   = 4 ;
+int REAL_SIZE      = 8 ;
+int LOGICAL_SIZE   = 4 ;
+int CHARACTER_SIZE = 1 ;
+
+
+
+
+
+
+
+void packc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+    
+void packc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+
+}
+
+void packc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+void packc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size, int strsize)
+{
+  int i ;
+   printf("longueur de la chaine %i \n",strsize) ;
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+
+void unpackc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+    
+void unpackc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+
+}
+
+void unpackc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void unpackc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size,int strsize)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void packc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER * size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) buffer[i]=var[i] ;
+  position+=s ;
+}
+
+void unpackc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER* size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) var[i]=buffer[i] ;
+  position+=s ;
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/pack_f.f90	(revision 3437)
@@ -0,0 +1,220 @@
+SUBROUTINE packf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+
+    tot_size=var_size*REAL_SIZE
+
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+
+END SUBROUTINE packf_r
+
+
+SUBROUTINE packf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_field
+
+SUBROUTINE packf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_i
+
+SUBROUTINE packf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_l
+
+SUBROUTINE packf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+   
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    buffer(1:var_size)=var(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_c
+
+
+
+
+
+
+SUBROUTINE unpackf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_r
+
+
+SUBROUTINE unpackf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_field
+
+SUBROUTINE unpackf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_i
+
+SUBROUTINE unpackf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_l
+
+SUBROUTINE unpackf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+    
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    var(1:var_size)=buffer(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_c
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/IOSERVER/server.F90	(revision 3437)
@@ -0,0 +1,48 @@
+PROGRAM server
+  USE mod_ioserver_para
+  USE mod_mpi_buffer_server
+  USE mod_wait
+  USE mod_global_memory
+  USE ioipsl
+  USE iomanager
+  USE mod_interface_ioipsl
+  USE mod_ioserver_namelist
+  
+  IMPLICIT NONE
+#if defined key_mpp_mpi
+  INCLUDE 'mpif.h'
+  
+  INTEGER :: i,j,ierr
+  LOGICAL :: is_terminated
+  
+!  CALL SLEEP(60)
+  PRINT *,'je suis un serveur'
+  CALL read_namelist
+  CALL init_parallel
+  CALL init_mpi_buffer
+  CALL init_wait
+  CALL init_interface_ioipsl
+  
+  CALL iom__init(nb_client,mpi_size,mpi_rank)
+  PRINT *,'je suis un serveur'
+  
+
+!  CALL MPI_BARRIER(iocomm,ierr)
+  
+  is_terminated=.FALSE.
+  
+  DO WHILE (.NOT. is_terminated)
+    CALL Check_buffer
+    CALL process_request(is_terminated)
+!    CALL wait_us(10)
+  ENDDO
+
+!  CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
+  CALL histclo
+  
+  CALL Finalize_parallel
+
+  PRINT *,"THAT'S ALL FOLK"
+#endif
+  
+END PROGRAM server
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/create_template	(revision 3437)
@@ -0,0 +1,25 @@
+#! /bin/bash
+
+function template() 
+{
+  echo ${1}
+  sed "s/#TYPE#/${1}/g" vector_def.template > vector_${1}_def.inc
+  sed "s/#TYPE#/${1}/g" vector_contains.template > vector_${1}_contains.inc
+}
+
+
+template field
+template field_group
+template axis
+template axis_group
+template node
+template domain
+template grid
+template grid_group
+template file
+template file_group
+template field_dep
+template file_dep
+template field_out
+template context
+template zoom
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut.f90	(revision 3437)
@@ -0,0 +1,283 @@
+MODULE mod_attribut
+  USE mod_xmlio_parameters
+  USE mod_attribut_list
+  USE mod_stdtype
+  USE string_function  
+  
+  TYPE, PUBLIC :: attribut
+    INTEGER :: object
+    INTEGER :: name
+    INTEGER :: type
+    INTEGER :: dim(7)
+    INTEGER :: ndim
+    INTEGER :: integer0_ptr
+    INTEGER,POINTER :: integer1_ptr(:)
+    INTEGER,POINTER :: integer2_ptr(:,:)
+    REAL    :: real0_ptr
+    REAL,POINTER    :: real1_ptr(:)
+    REAL,POINTER    :: real2_ptr(:,:)
+    LOGICAL :: logical0_ptr
+    LOGICAL,POINTER :: logical1_ptr(:)
+    LOGICAL,POINTER :: logical2_ptr(:,:)
+    
+    CHARACTER(LEN=str_len) :: string0_ptr
+    CHARACTER(LEN=str_len),POINTER :: string1_ptr(:)
+    CHARACTER(LEN=str_len),POINTER :: string2_ptr(:,:)
+    INTEGER                        :: string_len
+    
+  END TYPE attribut
+  
+  INTERFACE attr
+    MODULE PROCEDURE attr_int0,attr_int1,attr_int2,              &
+                     attr_real0,attr_real1,attr_real2,           &
+                     attr_logical0,attr_logical1,attr_logical2,  &
+                     attr_string0,attr_string1,attr_string2
+  END INTERFACE
+                     
+CONTAINS
+  
+  FUNCTION attr_get_object(attr_name)
+  USE mod_attribut_list
+  USE mod_object
+  USE error_msg
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: attr_name
+    INTEGER             :: attr_get_object
+    
+    IF (attr_name > field__begin .AND. attr_name < field__end) THEN
+      attr_get_object=field_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > file__begin .AND. attr_name < file__end) THEN
+      attr_get_object=file_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > grid__begin .AND. attr_name < grid__end) THEN
+      attr_get_object=grid_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > axis__begin .AND. attr_name < axis__end) THEN
+      attr_get_object=axis_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > zoom__begin .AND. attr_name < zoom__end) THEN
+      attr_get_object=zoom_object
+      RETURN
+    ENDIF
+
+    WRITE (message,*) 'Attribut name value :',attr_name,'is undefined'
+    CALL error("mod_attributd::attr_get_object") 
+   
+  END FUNCTION attr_get_object 
+
+  SUBROUTINE attr_deallocate(attrib)
+  IMPLICIT NONE
+  TYPE(attribut) :: attrib
+
+    SELECT CASE(attrib%type)
+       CASE (integer0)
+!!$         DEALLOCATE(attrib%integer0_ptr)
+       CASE (integer1)
+         DEALLOCATE(attrib%integer1_ptr)
+       CASE (integer2)
+         DEALLOCATE(attrib%integer2_ptr)
+       CASE (real0)
+!!$         DEALLOCATE(attrib%real0_ptr)
+       CASE (real1)
+         DEALLOCATE(attrib%real1_ptr)
+       CASE (real2)
+         DEALLOCATE(attrib%real2_ptr)
+       CASE (logical0)
+!!$         DEALLOCATE(attrib%logical0_ptr)
+       CASE (logical1)
+         DEALLOCATE(attrib%logical1_ptr)
+       CASE (logical2)
+         DEALLOCATE(attrib%logical2_ptr)
+       CASE (string0)
+!!$         DEALLOCATE(attrib%string0_ptr)
+       CASE (string1)
+         DEALLOCATE(attrib%string1_ptr)
+       CASE (string2)
+         DEALLOCATE(attrib%string2_ptr)
+    END SELECT         
+  
+  END SUBROUTINE attr_deallocate
+
+  FUNCTION attr_int0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER :: value
+    
+    TYPE(attribut) :: attr_int0
+    attr_int0%object=attr_get_object(attr_name) 
+    attr_int0%name=attr_name
+    attr_int0%type=integer0
+    attr_int0%integer0_ptr=value
+    
+  END FUNCTION attr_int0
+
+  FUNCTION attr_int1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET, INTENT(INOUT) :: value(:)
+    
+    TYPE(attribut) :: attr_int1
+    attr_int1%object=attr_get_object(attr_name) 
+    attr_int1%name=attr_name
+    attr_int1%type=integer1
+    attr_int1%integer1_ptr=>value
+    
+  END FUNCTION attr_int1    
+
+  FUNCTION attr_int2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET, INTENT(INOUT) :: value(:,:)
+    
+    TYPE(attribut) :: attr_int2
+    attr_int2%object=attr_get_object(attr_name) 
+    attr_int2%name=attr_name
+    attr_int2%type=integer2
+    attr_int2%integer2_ptr=>value
+    
+  END FUNCTION attr_int2
+          
+
+  FUNCTION attr_real0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL :: value
+    
+    TYPE(attribut) :: attr_real0
+    attr_real0%object=attr_get_object(attr_name) 
+    attr_real0%name=attr_name
+    attr_real0%type=real0
+    attr_real0%real0_ptr=value
+    
+  END FUNCTION attr_real0
+
+  FUNCTION attr_real1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET, INTENT(INOUT) :: value(:)
+    
+    TYPE(attribut) :: attr_real1
+    attr_real1%object=attr_get_object(attr_name) 
+    attr_real1%name=attr_name
+    attr_real1%type=real1
+    attr_real1%real1_ptr=>value
+    
+  END FUNCTION attr_real1    
+
+  FUNCTION attr_real2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET, INTENT(INOUT) :: value(:,:)
+    
+    TYPE(attribut) :: attr_real2
+    attr_real2%object=attr_get_object(attr_name) 
+    attr_real2%name=attr_name
+    attr_real2%type=REAL2
+    attr_real2%real2_ptr=>value
+    
+  END FUNCTION attr_real2
+  
+    FUNCTION attr_logical0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL :: value
+    
+    TYPE(attribut) :: attr_logical0
+    attr_logical0%object=attr_get_object(attr_name) 
+    attr_logical0%name=attr_name
+    attr_logical0%type=logical0
+    attr_logical0%logical0_ptr=value
+    
+  END FUNCTION attr_logical0
+
+  FUNCTION attr_logical1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET, INTENT(INOUT) :: value(:)
+    
+    TYPE(attribut) :: attr_logical1
+    attr_logical1%object=attr_get_object(attr_name) 
+    attr_logical1%name=attr_name
+    attr_logical1%type=logical1
+    attr_logical1%logical1_ptr=>value
+    
+  END FUNCTION attr_logical1    
+
+  FUNCTION attr_logical2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET, INTENT(INOUT) :: value(:,:)
+    
+    TYPE(attribut) :: attr_logical2
+    attr_logical2%object=attr_get_object(attr_name) 
+    attr_logical2%name=attr_name
+    attr_logical2%type=logical2
+    attr_logical2%logical2_ptr=>value
+    
+  END FUNCTION attr_logical2
+  
+
+  FUNCTION attr_string0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*) :: value
+    TYPE(attribut) :: attr_string0
+
+      attr_string0%object=attr_get_object(attr_name) 
+      attr_string0%name=attr_name
+      attr_string0%type=string0
+      attr_string0%string_len=LEN_TRIM(value)
+      attr_string0%string0_ptr=value
+    
+  END FUNCTION attr_string0
+
+  FUNCTION attr_string1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET, INTENT(INOUT) :: value(:)
+    
+    TYPE(attribut) :: attr_string1
+    attr_string1%object=attr_get_object(attr_name) 
+    attr_string1%name=attr_name
+    attr_string1%type=string1
+    attr_string1%string_len=LEN(value)
+    attr_string1%string1_ptr=>value
+    
+  END FUNCTION attr_string1    
+
+  FUNCTION attr_string2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET, INTENT(INOUT) :: value(:,:)
+    
+    TYPE(attribut) :: attr_string2
+    attr_string2%object=attr_get_object(attr_name) 
+    attr_string2%name=attr_name
+    attr_string2%type=string2
+    attr_string2%string_len=LEN(value)
+    attr_string2%string2_ptr=>value
+    
+  END FUNCTION attr_string2
+ 
+END MODULE mod_attribut
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_attribut_list.f90	(revision 3437)
@@ -0,0 +1,7 @@
+MODULE mod_attribut_list
+  USE mod_field_attribut
+  USE mod_file_attribut
+  USE mod_axis_attribut
+  USE mod_grid_attribut
+  USE mod_zoom_attribut
+END MODULE mod_attribut_list
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis.f90	(revision 3437)
@@ -0,0 +1,332 @@
+MODULE mod_axis
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: axis
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    INTEGER                     :: size
+    LOGICAL                     :: has_size
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    CHARACTER(len=str_len)      :: unit
+    LOGICAL                     :: has_unit
+    LOGICAL                     :: positive
+    LOGICAL                     :: has_positive
+    REAL, DIMENSION(:), POINTER :: values
+    LOGICAL                     :: has_values
+
+  END TYPE axis
+
+  INCLUDE 'vector_axis_def.inc'
+  
+  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE axis__set_attribut
+    MODULE PROCEDURE axis__set_attribut_id,axis__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_axis_contains.inc'
+
+  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_axis),POINTER          :: saved_axis_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    axis_ids=>saved_axis_ids
+    ids=>saved_ids
+    
+  END SUBROUTINE axis__swap_context
+
+  SUBROUTINE axis__init
+  IMPLICIT NONE
+    
+    CALL vector_axis__new(axis_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis__init
+  
+  SUBROUTINE axis__get(Id,Pt_axis)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis),POINTER              :: Pt_axis
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+    ELSE
+      Pt_axis=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis__get
+  
+  SUBROUTINE axis__new(pt_axis,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(axis), POINTER           :: pt_axis
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   pt_axis%has_id          = .FALSE.
+   pt_axis%has_name        = .FALSE.
+   pt_axis%has_size        = .FALSE.
+   pt_axis%has_description = .FALSE.
+   pt_axis%has_unit        = .FALSE.
+   pt_axis%has_values      = .FALSE.
+   pt_axis%has_positive    = .FALSE. 
+     
+   IF (PRESENT(Id)) THEN
+     Pt_axis%id=TRIM(ADJUSTL(Id))
+     Pt_axis%has_id=.TRUE.
+     CALL vector_axis__set_new(axis_Ids,Pt_axis,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+ END SUBROUTINE axis__new
+
+  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values, positive)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    CHARACTER(len=*)  ,OPTIONAL :: unit
+    INTEGER           ,OPTIONAL :: a_size
+    REAL, DIMENSION(:),OPTIONAL :: values
+    LOGICAL           ,OPTIONAL :: positive
+
+    IF (PRESENT(name)) THEN
+        pt_axis%name=TRIM(ADJUSTL(name))
+        pt_axis%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_axis%description=TRIM(ADJUSTL(description))
+        pt_axis%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        pt_axis%unit=TRIM(ADJUSTL(unit))
+        pt_axis%has_unit = .TRUE.
+    ENDIF
+
+    IF (PRESENT(a_size)) then
+        pt_axis%size=a_size
+        pt_axis%has_size = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(values)) then
+        IF (pt_axis%has_values) DEALLOCATE(pt_axis%values)  
+        ALLOCATE(pt_axis%values(size(values)))
+        pt_axis%values(:)=values(:)
+        pt_axis%has_values = .TRUE.
+    ENDIF
+
+    IF (PRESENT(positive)) then
+        pt_axis%positive=positive
+        pt_axis%has_positive = .TRUE.
+    ENDIF
+
+  END SUBROUTINE axis__set
+
+  SUBROUTINE axis__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(axis),POINTER              :: Pt_axis
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+      CALL axis__set_attribut_pt(Pt_axis,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis id :',id,'is undefined'
+        CALL error('mod_axis::axis__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE axis__set_attribut_id
+      
+  SUBROUTINE axis__set_attribut_pt(Pt_axis,attrib)
+  USE mod_attribut
+  USE mod_axis_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis),POINTER        :: Pt_axis
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (axis__name)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,name=attrib%string0_ptr) ; RETURN
+      CASE (axis__description)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,description=attrib%string0_ptr) ; RETURN
+      CASE (axis__unit)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,unit=attrib%string0_ptr) ; RETURN
+      CASE (axis__size)
+        IF (attrib%type==integer0) CALL  axis__set(pt_axis,a_size=attrib%integer0_ptr) ; RETURN
+      CASE (axis__values)
+        IF (attrib%type==real1) CALL  axis__set(pt_axis,values=attrib%real1_ptr) ; RETURN
+      CASE (axis__positive)
+        IF (attrib%type==logical0) CALL  axis__set(pt_axis,positive=attrib%logical0_ptr) ; RETURN
+       END SELECT
+
+     WRITE(message,*) 'axis attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_axis::axis__set_attribut')
+    
+  END SUBROUTINE axis__set_attribut_pt
+  
+  SUBROUTINE axis__print(pt_axis)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+
+    PRINT *,"---- AXIS ----"
+    IF (pt_axis%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_axis%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_axis%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_axis%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_axis%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_axis%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_axis%has_unit) THEN
+      PRINT *,"unit = ",TRIM(pt_axis%unit)
+    ELSE
+      PRINT *,"unit undefined"
+    ENDIF
+
+    IF (pt_axis%has_size) THEN
+      PRINT *,"size = ",pt_axis%size
+    ELSE
+      PRINT *,"size undefined"
+    ENDIF
+
+    IF (pt_axis%has_values) THEN
+      PRINT *,"values = ",pt_axis%values
+    ELSE
+      PRINT *,"values undefined"
+    ENDIF
+
+    IF (pt_axis%has_positive) THEN
+      PRINT *,"positive = ",pt_axis%positive
+    ELSE
+      PRINT *,"positive undefined"
+    ENDIF
+
+  END SUBROUTINE axis__print
+
+
+  SUBROUTINE axis__apply_default(pt_axis_default, pt_axis_in, pt_axis_out)
+
+    TYPE(axis), POINTER :: pt_axis_default, pt_axis_in, pt_axis_out
+
+    IF (pt_axis_in%has_name) THEN
+        pt_axis_out%name=pt_axis_in%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE IF ( pt_axis_default%has_name) THEN
+        pt_axis_out%name=pt_axis_default%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE
+        pt_axis_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_axis_in%has_description) THEN
+        pt_axis_out%description=pt_axis_in%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE IF ( pt_axis_default%has_description ) THEN
+        pt_axis_out%description=pt_axis_default%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE
+        pt_axis_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_unit) THEN
+        pt_axis_out%unit=pt_axis_in%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE IF ( pt_axis_default%has_unit ) THEN
+        pt_axis_out%unit=pt_axis_default%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE
+        pt_axis_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_size) THEN
+        pt_axis_out%size=pt_axis_in%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE IF ( pt_axis_default%has_size ) THEN
+        pt_axis_out%size=pt_axis_default%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE
+        pt_axis_out%has_size=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_values) THEN
+        pt_axis_out%values(:)=pt_axis_in%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE IF ( pt_axis_default%has_values ) THEN
+        pt_axis_out%values(:)=pt_axis_default%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE
+        pt_axis_out%has_values=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_positive) THEN
+        pt_axis_out%positive=pt_axis_in%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE IF ( pt_axis_default%has_positive ) THEN
+        pt_axis_out%positive=pt_axis_default%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE
+        pt_axis_out%has_positive=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE axis__apply_default
+
+  SUBROUTINE axis__check(pt_axis)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis), POINTER :: pt_axis
+      
+    IF (.NOT. pt_axis%has_name) THEN
+      IF (pt_axis%has_id) THEN
+        pt_axis%name=TRIM(pt_axis%id)
+      ELSE
+        WRITE(message,*) "Axis has no name and no id" 
+        CALL error("mod_axis::axis__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE axis__Check
+
+END MODULE mod_axis
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_attribut.f90	(revision 3437)
@@ -0,0 +1,15 @@
+MODULE mod_axis_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: axis__begin = axis_object + 10
+  
+  INTEGER,PARAMETER :: axis__name = axis_object + 11
+  INTEGER,PARAMETER :: axis__description = axis_object + 12
+  INTEGER,PARAMETER :: axis__unit = axis_object + 13
+  INTEGER,PARAMETER :: axis__size = axis_object + 14
+  INTEGER,PARAMETER :: axis__positive = axis_object + 15
+  INTEGER,PARAMETER :: axis__values = axis_object + 16
+
+  INTEGER,PARAMETER :: axis__end = axis_object + 17
+  
+END MODULE mod_axis_attribut
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_definition.f90	(revision 3437)
@@ -0,0 +1,24 @@
+MODULE mod_axis_definition
+  USE mod_axis_group
+  
+  TYPE(axis_group),SAVE,POINTER :: axis_definition
+  
+CONTAINS
+
+  SUBROUTINE axis_definition__swap_context(saved_axis_definition)      
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: saved_axis_definition
+    
+    axis_definition=>saved_axis_definition
+    
+  END SUBROUTINE axis_definition__swap_context 
+
+  SUBROUTINE axis_definition__Init
+  USE mod_axis_group
+  IMPLICIT NONE
+  
+    CALL axis_group__new(axis_definition,"axis_definition")
+    
+  END SUBROUTINE axis_definition__Init
+        
+END MODULE mod_axis_definition
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_axis_group.f90	(revision 3437)
@@ -0,0 +1,242 @@
+MODULE mod_axis_group
+  USE mod_axis
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE axis_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_axis_group), POINTER          :: groups
+    TYPE(vector_axis),POINTER                 :: axis     
+    TYPE(axis), POINTER                       :: default_attribut
+  END TYPE axis_group
+
+  INCLUDE "vector_axis_group_def.inc"  
+
+  TYPE(vector_axis_group),POINTER       :: axis_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE     :: Ids 
+
+  INTERFACE axis_group__set_attribut
+    MODULE PROCEDURE axis_group__set_attribut_id,axis_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_axis_group_contains.inc"
+
+  SUBROUTINE axis_group__swap_context(saved_axis_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_axis_group),POINTER       :: saved_axis_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   axis_group_ids=>saved_axis_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE axis_group__swap_context
+
+  SUBROUTINE axis_group__init
+  IMPLICIT NONE
+    
+    CALL vector_axis_group__new(axis_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis_group__init
+
+  SUBROUTINE axis_group__get(Id,Pt_ag)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis_group),POINTER        :: Pt_ag
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_ag=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis_group__get
+
+
+  SUBROUTINE axis_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(axis_group),POINTER             :: Pt_ag
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+      CALL axis_group__set_attribut(Pt_ag,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis group id :',id,'is undefined'
+        CALL error('mod_axis_group::axis_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE axis_group__set_attribut_id
+  
+  SUBROUTINE axis_group__set_attribut_pt(pt_ag,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: Pt_ag
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==axis_object) THEN
+      CALL axis__set_attribut(pt_ag%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE axis_group__set_attribut_pt
+      
+  RECURSIVE SUBROUTINE axis_group__new(Pt_ag,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER                :: Pt_ag
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_ag%groups)
+    ALLOCATE(Pt_ag%axis)
+    ALLOCATE(Pt_ag%default_attribut)
+    
+    CALL vector_axis_group__new(Pt_ag%groups)
+    CALL vector_axis__new(Pt_ag%axis)
+    CALL axis__new(Pt_ag%default_attribut)
+    Pt_ag%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_ag%id=TRIM(Id)
+      Pt_ag%has_id=.TRUE.
+      CALL vector_axis_group__set_new(axis_group_Ids,Pt_ag,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE axis_group__new
+
+      
+  SUBROUTINE axis_group__get_new_group(Pt_ag,Pt_ag_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER             :: Pt_ag
+    TYPE(axis_group),POINTER             :: Pt_ag_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis_group__get_new(Pt_ag%groups,Pt_ag_out)
+    CALL axis_group__new(Pt_ag_out)
+
+    IF (PRESENT(id)) THEN
+      CALL axis_group__new(Pt_ag_out,Id)
+    ELSE
+      CALL axis_group__new(Pt_ag_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_group
+
+  
+  SUBROUTINE axis_group__get_new_axis(Pt_ag,Pt_a_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER            :: Pt_ag
+    TYPE(axis),POINTER                  :: Pt_a_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis__get_new(Pt_ag%axis,Pt_a_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL axis__new(Pt_a_out,Id)
+    ELSE
+      CALL axis__new(Pt_a_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_axis
+  
+  
+  SUBROUTINE axis_group__get_default_attrib(Pt_ag,Pt_a)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+    TYPE(axis),POINTER        :: Pt_a
+    
+    Pt_a=>Pt_ag%default_attribut
+  END SUBROUTINE axis_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE axis_group__apply_default(Pt_ag,default)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER           :: Pt_ag
+    TYPE(axis),POINTER,OPTIONAL        :: default
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL axis__apply_default(default,Pt_ag%default_attribut,Pt_ag%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__apply_default(Pt_ag%groups%at(i)%pt,Pt_ag%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_ag%axis%size
+      CALL axis__apply_default(Pt_ag%default_attribut,Pt_ag%axis%at(i)%pt,Pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__apply_default
+
+  RECURSIVE SUBROUTINE axis_group__print(Pt_ag)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+   
+    INTEGER :: i
+    
+    PRINT *,"--- AXIS GROUP ---"
+    IF (pt_ag%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_ag%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"axis default attribut :"
+    CALL axis__print(Pt_ag%default_attribut)    
+
+    PRINT *,"owned axis groups :",Pt_ag%groups%size      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__print(Pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned axis :",Pt_ag%axis%size      
+    DO i=1,Pt_ag%axis%size
+      CALL axis__print(Pt_ag%axis%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+    
+  END SUBROUTINE axis_group__print
+
+  RECURSIVE SUBROUTINE axis_group__Check(Pt_ag)
+  IMPLICIT NONE
+  
+    TYPE(axis_group),POINTER  :: Pt_ag
+    INTEGER :: i
+   
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__check(pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_ag%axis%size
+      CALL axis__check(pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__check     
+   
+END MODULE mod_axis_group
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_context.f90	(revision 3437)
@@ -0,0 +1,233 @@
+MODULE mod_context
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_grid
+  USE mod_zoom
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_dependency
+  USE mod_time_parameters
+
+
+  INTERFACE context__swap
+    MODULE PROCEDURE context__swap_id,context__swap_pt
+  END INTERFACE  
+  
+  TYPE, PUBLIC :: context
+    CHARACTER(len=str_len)         :: id
+    INTEGER                        :: number
+  
+    TYPE(vector_field),POINTER        :: field__field_Ids
+    TYPE(sorted_list),POINTER         :: field__Ids
+    TYPE(vector_field_group),POINTER  :: field_group__field_group_ids
+    TYPE(sorted_list),POINTER         :: field_group__Ids
+    TYPE(field_group),POINTER         :: field_definition__field_def
+    TYPE(vector_file),POINTER         :: file__file_Ids
+    TYPE(sorted_list),POINTER         :: file__Ids
+    TYPE(vector_file_group),POINTER   :: file_group__file_group_Ids
+    TYPE(sorted_list),POINTER         :: file_group__Ids 
+    TYPE(file_group),POINTER          :: file_definition__file_def 
+    TYPE(vector_grid),POINTER         :: grid__grid_Ids
+    TYPE(sorted_list),POINTER         :: grid__Ids 
+    TYPE(vector_zoom),POINTER         :: zoom__zoom_Ids
+    TYPE(sorted_list),POINTER         :: zoom__Ids 
+    TYPE(vector_grid_group),POINTER   :: grid_group__grid_group_Ids
+    TYPE(sorted_list),POINTER         :: grid_group__Ids 
+    TYPE(grid_group),POINTER          :: grid_definition__grid_def
+    TYPE(vector_axis),POINTER         :: axis__axis_Ids
+    TYPE(sorted_list),POINTER         :: axis__Ids 
+    TYPE(vector_axis_group),POINTER   :: axis_group__axis_group_Ids
+    TYPE(sorted_list),POINTER         :: axis_group__Ids 
+    TYPE(axis_group),POINTER          :: axis_definition__axis_def
+    TYPE(vector_file_dep),POINTER     :: dependency__file_enabled
+    TYPE(vector_field_out),POINTER    :: dependency__field_enabled 
+    TYPE(vector_field_dep),POINTER    :: dependency__field_id
+    TYPE(sorted_list),POINTER         :: dependency__sorted_id 
+    INTEGER,POINTER                   :: time_param__initial_timestep
+    REAL,POINTER                      :: time_param__initial_date
+    REAL,POINTER                      :: time_param__timestep_value 
+    INTEGER,POINTER                   :: time_param__timestep_number
+
+  END TYPE context
+  
+  INCLUDE 'vector_context_def.inc'
+  TYPE(vector_context),SAVE,POINTER  :: context_ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
+
+ 
+  CONTAINS
+    INCLUDE 'vector_context_contains.inc'
+    
+    SUBROUTINE context__init
+    IMPLICIT NONE
+
+      ALLOCATE(context_Ids)
+      ALLOCATE(Ids)
+
+      CALL vector_context__new(context_Ids)
+      CALL sorted_list__new(ids)
+
+    END SUBROUTINE context__init
+
+    SUBROUTINE context__get(Id,Pt_context)
+      USE string_function
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+    
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        Pt_context=>NULL()
+      ENDIF
+    
+    END SUBROUTINE context__get
+
+    SUBROUTINE context__get_new(Id,pt_context)
+    USE string_function
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+      
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        CALL vector_context__get_new(context_ids,pt_context,Pos)
+        pt_context%number=Pos
+        Pt_context%id=Id
+        CALL sorted_list__Add(Ids,hash(Id),Pos)
+        
+        ALLOCATE(pt_context%field__field_Ids )
+        ALLOCATE(pt_context%field__Ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__Ids )
+        ALLOCATE(pt_context%field_definition__field_def )
+        ALLOCATE(pt_context%file__file_Ids)
+        ALLOCATE(pt_context%file__Ids)
+        ALLOCATE(pt_context%file_group__file_group_Ids)
+        ALLOCATE(pt_context%file_group__Ids) 
+        ALLOCATE(pt_context%file_definition__file_def) 
+        ALLOCATE(pt_context%grid__grid_Ids)
+        ALLOCATE(pt_context%grid__Ids) 
+        ALLOCATE(pt_context%zoom__zoom_Ids)
+        ALLOCATE(pt_context%zoom__Ids) 
+        ALLOCATE(pt_context%grid_group__grid_group_Ids)
+        ALLOCATE(pt_context%grid_group__Ids) 
+        ALLOCATE(pt_context%grid_definition__grid_def)
+        ALLOCATE(pt_context%axis__axis_Ids)
+        ALLOCATE(pt_context%axis__Ids) 
+        ALLOCATE(pt_context%axis_group__axis_group_Ids)
+        ALLOCATE(pt_context%axis_group__Ids) 
+        ALLOCATE(pt_context%axis_definition__axis_def)
+        ALLOCATE(pt_context%dependency__file_enabled)
+        ALLOCATE(pt_context%dependency__field_enabled) 
+        ALLOCATE(pt_context%dependency__field_id)
+        ALLOCATE(pt_context%dependency__sorted_id)  
+        ALLOCATE(pt_context%time_param__initial_timestep)
+        ALLOCATE(pt_context%time_param__initial_date)
+        ALLOCATE(pt_context%time_param__timestep_value) 
+        ALLOCATE(pt_context%time_param__timestep_number)
+
+        CALL context__swap(pt_context)
+        
+        CALL field__init
+        CALL field_group__Init
+        CALL field_definition__Init
+
+        CALL axis__init
+        CALL axis_group__Init
+        CALL axis_definition__Init
+
+        CALL grid__init
+        CALL grid_group__Init
+        CALL grid_definition__Init
+
+        CALL zoom__init
+
+        CALL file__init
+        CALL file_group__Init
+        CALL file_definition__Init
+
+      ENDIF
+
+    END SUBROUTINE context__get_new
+
+
+    SUBROUTINE context__create(Id)
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      
+      TYPE(context),POINTER              :: Pt_context
+
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) CALL context__get_new(Id,Pt_context)
+      
+!      CALL field__init
+!      CALL field_group__init
+!      CALL field_definition__init
+      
+     END SUBROUTINE context__create
+
+     
+    SUBROUTINE context__swap_id(Id)
+    USE mod_field
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER       :: Pt_context
+
+      INTEGER :: number
+      
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) THEN
+!!      error message
+      ENDIF
+      
+      CALL context__swap(pt_context)  
+
+    END SUBROUTINE context__swap_id
+
+    SUBROUTINE context__swap_pt(Pt_context)
+    USE mod_field
+      IMPLICIT NONE
+      TYPE(context),POINTER       :: Pt_context
+
+      CALL field__swap_context(Pt_context%field__field_Ids ,Pt_context%field__Ids)
+      CALL field_group__swap_context(Pt_context%field_group__field_group_ids ,Pt_context%field_group__Ids)
+      CALL field_definition__swap_context(Pt_context%field_definition__field_def)
+      CALL file__swap_context(Pt_context%file__file_Ids,Pt_context%file__Ids)
+      CALL file_group__swap_context(Pt_context%file_group__file_group_Ids,Pt_context%file_group__Ids)
+      CALL file_definition__swap_context(Pt_context%file_definition__file_def) 
+      CALL grid__swap_context(pt_context%grid__grid_Ids,pt_context%grid__Ids) 
+      CALL zoom__swap_context(pt_context%zoom__zoom_Ids,pt_context%zoom__Ids) 
+      CALL grid_group__swap_context(pt_context%grid_group__grid_group_Ids,pt_context%grid_group__Ids) 
+      CALL grid_definition__swap_context(pt_context%grid_definition__grid_def)
+      CALL axis__swap_context(pt_context%axis__axis_Ids,pt_context%axis__Ids) 
+      CALL axis_group__swap_context(pt_context%axis_group__axis_group_Ids,pt_context%axis_group__Ids) 
+      CALL axis_definition__swap_context(pt_context%axis_definition__axis_def)
+      CALL dependency__swap_context(pt_context%dependency__file_enabled,pt_context%dependency__field_enabled,  &
+                                    pt_context%dependency__field_id,pt_context%dependency__sorted_id)
+      CALL time_parameters__swap_context(pt_context%time_param__initial_timestep,pt_context%time_param__initial_date,  &
+                                         pt_context%time_param__timestep_value,pt_context%time_param__timestep_number)
+                                    
+    END SUBROUTINE context__swap_pt
+
+
+END MODULE mod_context
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_dependency.f90	(revision 3437)
@@ -0,0 +1,247 @@
+MODULE mod_dependency
+USE mod_field
+USE mod_file
+USE mod_grid
+USE mod_axis
+USE mod_sorted_list
+USE mod_zoom
+
+TYPE file_dep
+  TYPE(file),POINTER           :: file
+  INTEGER                      :: hash
+  TYPE(vector_field),POINTER   :: fields
+  TYPE(vector_grid),POINTER    :: grids
+  TYPE(vector_zoom),POINTER    :: zooms
+  TYPE(vector_axis),POINTER    :: axis
+END TYPE file_dep
+
+TYPE field_dep
+  TYPE(field),POINTER :: field
+  INTEGER             :: hash
+  
+  TYPE(vector_field_out),POINTER   :: field_out
+END TYPE field_dep
+
+TYPE field_out
+  TYPE(Field), POINTER  :: field
+  TYPE(file),  POINTER  :: file
+  TYPE(axis),  POINTER  :: axis
+  TYPE(grid),  POINTER  :: grid
+  TYPE(zoom),  POINTER  :: zoom
+END TYPE field_out
+
+INCLUDE 'vector_field_dep_def.inc'
+INCLUDE 'vector_file_dep_def.inc'
+INCLUDE 'vector_field_out_def.inc'
+
+TYPE(vector_file_dep),POINTER,SAVE      :: file_enabled
+TYPE(vector_field_out),POINTER,SAVE     :: field_enabled 
+TYPE(vector_field_dep),POINTER,SAVE     :: field_id
+
+ 
+TYPE(sorted_list),POINTER,SAVE :: sorted_id
+
+CONTAINS
+
+INCLUDE 'vector_field_dep_contains.inc'
+INCLUDE 'vector_file_dep_contains.inc'
+INCLUDE 'vector_field_out_contains.inc'
+
+  
+  SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id)  
+  IMPLICIT NONE
+    TYPE(vector_file_dep),POINTER      :: saved_file_enabled
+    TYPE(vector_field_out),POINTER     :: saved_field_enabled 
+    TYPE(vector_field_dep),POINTER     :: save_field_id
+    TYPE(sorted_list),POINTER          :: saved_sorted_id  
+    
+    file_enabled=>saved_file_enabled   
+    field_enabled=>saved_field_enabled
+    field_id=>save_field_id
+    sorted_id=>saved_sorted_id
+      
+  END SUBROUTINE dependency__swap_context
+  
+  SUBROUTINE set_dependency
+  IMPLICIT NONE
+  
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+
+  END SUBROUTINE set_dependency
+  
+  
+  RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group)
+  USE mod_file_definition
+  USE mod_file_group
+  USE string_function
+  USE mod_sorted_list
+  IMPLICIT NONE
+    TYPE (file_group),POINTER,OPTIONAL :: pt_file_group 
+    TYPE (file_group),POINTER          :: Pt_fg
+    TYPE (file)     ,POINTER           :: Pt_file
+    TYPE (file_dep),POINTER            :: Pt_file_dep
+    TYPE (sorted_list),POINTER         :: sorted_axis
+    TYPE (sorted_list),POINTER         :: sorted_grid
+    TYPE (sorted_list),POINTER         :: sorted_zoom
+    INTEGER                            :: i
+    INTEGER                            :: j
+    
+    ALLOCATE(sorted_axis)
+    ALLOCATE(sorted_grid)
+    ALLOCATE(sorted_zoom)
+    
+    IF (PRESENT(Pt_file_group)) THEN
+      Pt_fg=>Pt_file_group
+    ELSE
+      CALL vector_file_dep__new(file_enabled)
+      Pt_fg=>file_definition
+    ENDIF
+    
+    DO i=1,Pt_fg%groups%size
+      CALL set_file_dependency(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      Pt_file=>pt_fg%files%at(i)%pt
+      IF (Pt_file%enabled) THEN
+        CALL vector_file_dep__get_new(file_enabled,Pt_file_dep)
+        
+        ALLOCATE(Pt_file_dep%fields)
+        ALLOCATE(Pt_file_dep%grids)
+        ALLOCATE(Pt_file_dep%zooms)
+        ALLOCATE(Pt_file_dep%axis)
+        pt_file_dep%file=>pt_file
+        pt_file_dep%hash=hash(pt_file%id)
+        CALL vector_field__new(Pt_file_dep%fields)
+        CALL vector_grid__new(Pt_file_dep%grids)
+        CALL vector_zoom__new(Pt_file_dep%zooms)
+        CALL vector_axis__new(Pt_file_dep%axis)
+        CALL sorted_list__new(sorted_axis)
+        CALL sorted_list__new(sorted_grid)
+        CALL sorted_list__new(sorted_zoom)
+        
+        CALL Treat_field_group(pt_file%field_list)
+        
+        CALL sorted_list__delete(sorted_axis)
+        CALL sorted_list__delete(sorted_grid)
+        CALL sorted_list__delete(sorted_zoom)
+      ENDIF
+    ENDDO
+    
+    CONTAINS 
+      RECURSIVE SUBROUTINE treat_field_group(pt_fg)
+      IMPLICIT NONE  
+        TYPE(field_group),POINTER :: Pt_fg
+        INTEGER                   :: i
+        
+        DO i=1,Pt_fg%groups%size
+          CALL treat_field_group(Pt_fg%groups%at(i)%pt)
+        ENDDO
+        
+        DO i=1,Pt_fg%fields%size
+          CALL treat_field(Pt_fg%fields%at(i)%pt)
+        ENDDO
+      END SUBROUTINE treat_field_group
+      
+      
+      SUBROUTINE treat_field(pt_field)
+      IMPLICIT NONE  
+        TYPE(field),POINTER :: Pt_field
+        LOGICAL             :: found
+        INTEGER             :: Pos
+
+        IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN
+          CALL vector_field__set_new(Pt_file_dep%fields,Pt_field)
+  
+          IF (Pt_field%has_grid) THEN
+            CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos)
+              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos)
+            ENDIF
+          ENDIF
+
+          IF (Pt_field%has_zoom) THEN
+            CALL sorted_list__find(sorted_zoom,hash(Pt_field%zoom%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_zoom__set_new(pt_file_dep%zooms,Pt_field%zoom,pos)
+              CALL sorted_list__add(sorted_zoom,hash(Pt_field%zoom%id),pos)
+            ENDIF
+          ENDIF
+  
+          IF (Pt_field%has_axis) THEN
+            CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos)
+              CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos)
+            ENDIF
+          ENDIF
+        ENDIF
+      
+      END SUBROUTINE treat_field
+      
+  END SUBROUTINE set_file_dependency
+  
+  SUBROUTINE set_field_enabled
+  IMPLICIT NONE
+  TYPE(file_dep),POINTER   :: pt_file_dep
+  TYPE(field_out),POINTER  :: pt_field_out
+  INTEGER                  :: i
+  INTEGER                  :: j
+  
+    CALL vector_field_out__new(field_enabled)
+    
+    DO i=1,file_enabled%size
+      pt_file_dep=>file_enabled%at(i)%pt
+      DO j=1,pt_file_dep%fields%size
+        CALL vector_field_out__get_new(field_enabled,pt_field_out)
+        pt_field_out%field=>pt_file_dep%fields%at(j)%pt
+        pt_field_out%file=>pt_file_dep%file
+        pt_field_out%axis=>pt_field_out%field%axis
+        pt_field_out%grid=>pt_field_out%field%grid
+        pt_field_out%zoom=>pt_field_out%field%zoom
+      ENDDO
+    ENDDO
+   
+      
+  END SUBROUTINE set_field_enabled
+      
+  SUBROUTINE set_field_dependency
+  USE string_function
+  IMPLICIT NONE
+  TYPE(field_out),POINTER :: pt_field_out
+  TYPE(field_dep),POINTER :: pt_field_dep
+  TYPE(field),POINTER     :: pt_field
+  TYPE(field),POINTER     :: pt_field_base
+  INTEGER :: pos
+  LOGICAL :: found
+  INTEGER :: i
+  
+    CALL vector_field_dep__new(field_id)
+    CALL sorted_list__new(sorted_id)
+    
+    DO i=1,field_enabled%size
+      pt_field_out=>field_enabled%at(i)%pt
+      pt_field=>pt_field_out%field
+      pt_field_base=>pt_field%field_base
+      CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found)
+      IF (.NOT. found) THEN
+        CALL vector_field_dep__get_new(field_id,pt_field_dep,pos)
+        ALLOCATE(pt_field_dep%field_out)
+        CALL vector_field_out__new(pt_field_dep%field_out)
+        pt_field_dep%field=>pt_field_base       
+        CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos)
+      ELSE
+        pt_field_dep=>field_id%at(pos)%pt
+      ENDIF
+      
+      CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) 
+    ENDDO  
+      
+  END SUBROUTINE set_field_dependency     
+      
+    
+    
+END MODULE mod_dependency
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_domain.f90	(revision 3437)
@@ -0,0 +1,172 @@
+MODULE mod_domain
+   USE mod_xmlio_parameters
+   INTEGER, PARAMETER :: box=1
+   INTEGER, PARAMETER :: orange=2
+   
+  TYPE domain
+    INTEGER :: rank
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+    
+    INTEGER         :: type
+    LOGICAL,POINTER :: mask(:)
+    INTEGER,POINTER :: i_index(:)
+    INTEGER,POINTER :: j_index(:)
+    INTEGER         :: nbp
+    LOGICAL         :: is_defined
+  END TYPE domain
+ 
+  INCLUDE 'vector_domain_def.inc'
+
+CONTAINS
+
+  INCLUDE 'vector_domain_contains.inc'
+
+  SUBROUTINE domain__new(Pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    
+    Pt_domain%is_defined=.FALSE.
+    
+  END SUBROUTINE domain__new
+  
+  SUBROUTINE domain__set(Pt_domain,rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    INTEGER,INTENT(IN) :: rank
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    Pt_domain%rank=rank
+    Pt_domain%ni=ni
+    Pt_domain%nj=nj
+    Pt_domain%ibegin=ibegin
+    Pt_domain%jbegin=jbegin   
+    Pt_domain%iend=ibegin+ni-1
+    Pt_domain%jend=jbegin+nj-1
+    ALLOCATE(Pt_domain%lon(ni,nj))
+    ALLOCATE(Pt_domain%lat(ni,nj))
+    Pt_domain%lon(:,:)=lon(:,:)
+    Pt_domain%lat(:,:)=lat(:,:)
+    Pt_domain%is_defined=.TRUE.
+  END SUBROUTINE domain__set
+
+
+  SUBROUTINE domain__set_type_box(Pt_domain,mask)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(:,:)
+    INTEGER                     :: i,j
+  
+    Pt_domain%type=box
+    pt_domain%nbp=pt_domain%ni*pt_domain%nj
+    ALLOCATE(Pt_domain%i_index(pt_domain%nbp))
+    ALLOCATE(Pt_domain%j_index(pt_domain%nbp))
+    ALLOCATE(pt_domain%mask(pt_domain%nbp))
+
+    IF (PRESENT(mask)) THEN
+      IF ( size(mask,1)==pt_domain%ni .AND. size(mask,2)==pt_domain%nj) THEN
+        DO i=1,pt_domain%ni
+          DO j=1,pt_domain%nj
+            pt_domain%mask((j-1)*pt_domain%ni+i)=mask(i,j)
+          ENDDO
+        ENDDO
+      ELSE
+        WRITE (message,*) "mask dimensions are not compliant with domain dimensions :",   &
+                           size(mask,1),",",size(mask,2),"/=",Pt_domain%ni,",",Pt_domain%nj
+        CALL error("domain__set_type_box")
+      ENDIF
+    ELSE
+      pt_domain%mask(:)=.TRUE.
+    ENDIF
+    
+    DO i=1,pt_domain%ni
+      DO j=1,pt_domain%nj
+        pt_domain%i_index((j-1)*pt_domain%ni+i) = i
+        pt_domain%j_index((j-1)*pt_domain%ni+i) = j
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE domain__set_type_box
+
+
+  SUBROUTINE domain__set_type_orange(Pt_domain,nbp,offset,opt_index)
+  IMPLICIT NONE
+    TYPE(domain),POINTER        :: Pt_domain
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+    INTEGER,INTENT(IN),OPTIONAL :: opt_index(:)
+    
+    INTEGER  :: index(nbp)
+    INTEGER  :: i
+    
+    Pt_domain%type=orange
+    
+    IF (PRESENT(opt_index)) THEN
+      index(:)=opt_index(:)       
+    ELSE
+      DO i=1,nbp
+        index(i)=i
+      ENDDO
+    ENDIF
+
+    pt_domain%nbp=nbp
+    ALLOCATE(pt_domain%i_index(nbp))
+    ALLOCATE(pt_domain%j_index(nbp))
+    ALLOCATE(pt_domain%mask(nbp))
+        
+    DO i=1,nbp
+!      Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%ni+1+pt_domain%ibegin-1
+!      Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%ni)+1+pt_domain%jbegin-1
+      Pt_domain%i_index(i)=MOD(index(i)+offset-1,pt_domain%ni)+1
+      Pt_domain%j_index(i)=(index(i)+offset-1)/pt_domain%ni+1
+      
+    ENDDO
+
+    Pt_domain%mask(:)=.TRUE.
+
+  END SUBROUTINE domain__set_type_orange
+
+
+    
+  SUBROUTINE domain__print(pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_domain
+
+    PRINT *,"---- DOMAIN ----"
+    
+    IF (pt_domain%is_defined) THEN
+      PRINT *,"rank :",pt_domain%rank
+      PRINT *,"ni :",pt_domain%ni
+      PRINT *,"nj :",pt_domain%nj
+      PRINT *,"ibegin",pt_domain%ibegin
+      PRINT *,"iend",pt_domain%iend
+    ELSE
+      PRINT *,"  ---> domain undefined"
+    ENDIF
+    
+    PRINT *,"-----------------"
+  END SUBROUTINE domain__print
+  
+  SUBROUTINE domain__copy(Pt_in,pt_out)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_in
+    TYPE(domain),POINTER   :: Pt_out
+  
+    IF (pt_in%is_defined) THEN
+      CALL domain__set(pt_out,pt_in%rank,pt_in%ni,pt_in%nj,pt_in%ibegin,pt_in%jbegin,pt_in%lon,pt_in%lat)
+    ENDIF
+  END SUBROUTINE domain__copy
+  
+END MODULE mod_domain
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_error_msg.f90	(revision 3437)
@@ -0,0 +1,40 @@
+MODULE error_msg
+  USE mod_xmlio_parameters,ONLY : str_msg_len
+
+  CHARACTER(LEN=str_msg_len),SAVE :: message
+
+CONTAINS
+
+  SUBROUTINE Warning(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+    
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+  END SUBROUTINE warning
+  
+  SUBROUTINE error(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+    STOP 
+  
+  END SUBROUTINE error    
+
+END MODULE error_msg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field.f90	(revision 3437)
@@ -0,0 +1,658 @@
+MODULE mod_field
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_axis
+  USE mod_grid
+  USE mod_zoom
+   
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: field
+    CHARACTER(len=str_len)         :: id
+    LOGICAL                        :: has_id
+    CHARACTER(len=str_len)         :: name
+    LOGICAL                        :: has_name
+    CHARACTER(len=str_len)         :: description
+    LOGICAL                        :: has_description
+    CHARACTER(len=str_len)         :: unit
+    LOGICAL                        :: has_unit
+    CHARACTER(len=str_len)         :: operation
+    LOGICAL                        :: has_operation
+    INTEGER                        :: freq_op
+    LOGICAL                        :: has_freq_op
+    CHARACTER(len=str_len)         :: axis_ref
+    LOGICAL                        :: has_axis_ref
+    CHARACTER(len=str_len)         :: grid_ref
+    LOGICAL                        :: has_grid_ref
+    CHARACTER(len=str_len)         :: zoom_ref
+    LOGICAL                        :: has_zoom_ref
+    INTEGER                        :: level
+    LOGICAL                        :: has_level
+    INTEGER                        :: prec
+    LOGICAL                        :: has_prec
+    CHARACTER(len=str_len)         :: field_ref
+    LOGICAL                        :: has_field_ref
+    TYPE(field),POINTER            :: field_base
+    LOGICAL                        :: has_field_base
+    LOGICAL                        :: enabled
+    LOGICAL                        :: has_enabled
+    LOGICAL                        :: solved_field_ref
+    TYPE(axis), POINTER            :: axis
+    LOGICAL                        :: has_axis
+    TYPE(grid),POINTER             :: grid
+    LOGICAL                        :: has_grid
+    TYPE(zoom),POINTER             :: zoom
+    LOGICAL                        :: has_zoom
+    INTEGER                        :: internal(internal_field)
+    
+    
+  END TYPE field
+  
+  INTERFACE field__set_attribut
+    MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt
+  END INTERFACE
+  
+  INCLUDE 'vector_field_def.inc'
+  
+  TYPE(vector_field),POINTER,SAVE            :: field_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids
+  
+
+CONTAINS
+  INCLUDE 'vector_field_contains.inc'
+
+  SUBROUTINE field__swap_context(saved_field_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field),POINTER :: saved_field_ids
+    TYPE(sorted_list),POINTER  :: saved_ids
+    
+    field_Ids=>saved_field_ids
+    Ids=>saved_Ids
+
+  END SUBROUTINE field__swap_context
+
+  SUBROUTINE field__init
+  IMPLICIT NONE
+    
+    CALL vector_field__new(field_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field__init
+  
+  SUBROUTINE field__get(Id,Pt_field)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field),POINTER             :: Pt_field
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+    ELSE
+      Pt_field=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field__get
+    
+  
+  SUBROUTINE field__new(pt_field,Id)
+   USE string_function
+   IMPLICIT NONE
+   TYPE(field), POINTER          :: pt_field
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   
+   INTEGER              :: Pos
+
+   Pt_field%has_id=.FALSE.
+   pt_field%has_name = .FALSE.
+   pt_field%has_description = .FALSE.
+   pt_field%has_unit = .FALSE.
+   pt_field%has_operation = .FALSE.
+   pt_field%has_freq_op = .FALSE.
+   pt_field%has_axis_ref = .FALSE.
+   pt_field%has_grid_ref = .FALSE.
+   pt_field%has_zoom_ref = .FALSE.
+   pt_field%has_prec = .FALSE.
+   pt_field%has_level = .FALSE. 
+   pt_field%has_field_ref = .FALSE.
+   pt_field%has_field_base = .FALSE.
+   pt_field%has_enabled = .FALSE.
+   Pt_field%solved_field_ref=.FALSE.
+   Pt_field%has_axis=.FALSE.
+   Pt_field%has_grid=.FALSE.
+   Pt_field%has_zoom=.FALSE.
+      
+   IF (PRESENT(Id)) THEN
+     Pt_field%id=TRIM(ADJUSTL(Id))
+     Pt_field%has_id=.TRUE.
+     CALL vector_field__set_new(field_Ids,Pt_field,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+ END SUBROUTINE field__new
+
+
+ SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, &
+                       enabled)
+
+    TYPE(field), pointer :: p_field
+    CHARACTER(len=*), OPTIONAL :: name
+    CHARACTER(len=*), OPTIONAL :: ref
+    CHARACTER(len=*), OPTIONAL  :: description
+    CHARACTER(len=*), OPTIONAL  :: unit
+    CHARACTER(len=*), OPTIONAL :: operation
+    INTEGER, OPTIONAL  :: freq_op
+    CHARACTER(len=*),OPTIONAL :: axis_ref
+    CHARACTER(len=*),OPTIONAL :: grid_ref
+    CHARACTER(len=*),OPTIONAL :: zoom_ref
+    INTEGER, OPTIONAL :: prec
+    INTEGER, OPTIONAL :: level
+    LOGICAL, OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        p_field%name=TRIM(ADJUSTL(name))
+        p_field%has_name = .TRUE.
+    ENDIF
+    IF (PRESENT(ref)) THEN
+        p_field%field_ref=TRIM(ADJUSTL(ref))
+        p_field%has_field_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(description)) THEN
+        p_field%description=TRIM(ADJUSTL(description))
+        p_field%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        p_field%unit=TRIM(ADJUSTL(unit))
+        p_field%has_unit = .TRUE.
+    ENDIF
+    IF (PRESENT(operation)) THEN
+        p_field%operation=TRIM(ADJUSTL(operation))
+        p_field%has_operation = .TRUE.
+    ENDIF
+    IF (PRESENT(freq_op)) THEN
+        p_field%freq_op=freq_op
+        p_field%has_freq_op = .TRUE.
+    ENDIF
+    IF (PRESENT(axis_ref)) THEN
+        p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
+        p_field%has_axis_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(grid_ref)) THEN
+        p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
+        p_field%has_grid_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(zoom_ref)) THEN
+        p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
+        p_field%has_zoom_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(prec)) then
+        p_field%prec=prec
+        p_field%has_prec = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(level)) then
+        p_field%level=level
+        p_field%has_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        p_field%enabled=enabled
+        p_field%has_enabled = .TRUE.
+    ENDIF
+
+  END SUBROUTINE field__set
+
+  SUBROUTINE field__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field),POINTER             :: Pt_field
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+      CALL field__set_attribut(Pt_field,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field id :',id,'is undefined'
+        CALL error('mod_field::field__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  END SUBROUTINE field__set_attribut_id
+
+    
+  SUBROUTINE field__set_attribut_pt(pt_field,attrib)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field),POINTER             :: Pt_field
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    SELECT CASE(attrib%name)
+      CASE (field__name)
+        IF (attrib%type==string0) CALL  field__set(pt_field,name=attrib%string0_ptr) ; RETURN
+      CASE (field__field_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,ref=attrib%string0_ptr) ; RETURN
+      CASE (field__description)
+        IF (attrib%type==string0) CALL  field__set(pt_field,description=attrib%string0_ptr) ; RETURN
+      CASE (field__unit)
+        IF (attrib%type==string0) CALL  field__set(pt_field,unit=attrib%string0_ptr) ; RETURN
+      CASE (field__operation)
+        IF (attrib%type==string0) CALL  field__set(pt_field,operation=attrib%string0_ptr) ; RETURN
+      CASE (field__freq_op)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN
+      CASE (field__axis_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__grid_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__zoom_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__prec)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN
+      CASE (field__level)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,level=attrib%integer0_ptr) ; RETURN
+      CASE (field__enabled)
+        IF (attrib%type==logical0) CALL  field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_field::field__set_attribut')
+    
+  END SUBROUTINE field__set_attribut_pt    
+
+  SUBROUTINE field__print(pt_field)
+
+    TYPE(field), POINTER :: pt_field
+    
+    PRINT *,"--- FIELD ---"
+
+    IF (pt_field%has_id) THEN
+        PRINT *, 'id : ',TRIM(pt_field%id)
+    ELSE
+        PRINT *, 'id undefined '
+    ENDIF
+
+    IF (pt_field%has_name) THEN
+        PRINT *, 'name : ',TRIM(pt_field%name)
+    ELSE
+        PRINT *, 'name undefined '
+    ENDIF
+    IF (pt_field%has_description) THEN
+        PRINT *, 'description : ',TRIM(pt_field%description)
+    ELSE
+        PRINT *, 'description undefined '
+    ENDIF
+    IF (pt_field%has_unit) THEN
+        PRINT *, 'unit : ',TRIM(pt_field%unit)
+    ELSE
+        PRINT *, 'unit undefined '
+    ENDIF
+    IF (pt_field%has_operation) THEN
+        PRINT *, 'operation ',TRIM(pt_field%operation)
+    ELSE
+        PRINT *, 'operation undefined '
+    ENDIF
+    IF (pt_field%has_freq_op) THEN
+        PRINT *, 'freq_op ',pt_field%freq_op
+    ELSE
+        PRINT *, 'freq_op undefined '
+    ENDIF
+
+    IF (pt_field%has_axis_ref) THEN
+        PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
+    ELSE
+        PRINT *, 'axis_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_grid_ref) THEN
+        PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
+    ELSE
+        PRINT *, 'grid_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_zoom_ref) THEN
+        PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
+    ELSE
+        PRINT *, 'zoom_ref undefined '
+    ENDIF
+    
+    IF (pt_field%has_field_ref) THEN
+        PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
+    ELSE
+        PRINT *, 'field_ref undefined '
+    ENDIF
+
+!    call vert_axis__print(pt_field%p_vert_axis)
+!
+!    IF (pt_field%is_vert_axis_ref_def) THEN
+!        PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
+!    ELSE
+!        PRINT *, 'pt_field%vert_axis_ref undefined '
+!    ENDIF
+    IF (pt_field%has_prec) THEN
+        PRINT *, 'prec ',pt_field%prec
+    ELSE
+        PRINT *, 'prec undefined '
+    ENDIF
+    IF (pt_field%has_level) then
+        PRINT *, 'level ',pt_field%level
+    ELSE
+        PRINT *, 'level undefined '
+    ENDIF
+    IF (pt_field%has_field_base) THEN
+        PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
+    ELSE
+        PRINT *, 'field_base indefini'
+    ENDIF
+
+    IF (pt_field%has_enabled) THEN
+        PRINT *, 'enabled : ',pt_field%enabled
+    ELSE
+        PRINT *, 'enabled indefini'
+    ENDIF
+ 
+    PRINT *,"------------"
+    
+  END SUBROUTINE field__print
+
+!  SUBROUTINE field__resolve_ref_vert_axis(p_field)
+!
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=str_len) :: name
+!
+!    IF (p_field%is_vert_axis_ref_def) THEN
+!        name=p_field%vert_axis_ref
+!        IF (vert_axis_def__is_exist(name)) THEN
+!            CALL vert_axis_def__get(name,p_field%p_vert_axis)
+!            p_field%is_vert_axis_def = .TRUE.
+!        ENDIF
+!    ENDIF
+!
+!  END SUBROUTINE field__resolve_ref_vert_axis
+
+  SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
+
+    TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
+
+    IF (pt_field_in%has_name) THEN
+        pt_field_out%name=pt_field_in%name
+        pt_field_out%has_name=.TRUE.
+    ELSE IF ( pt_field_default%has_name) THEN
+        pt_field_out%name=pt_field_default%name
+        pt_field_out%has_name=.TRUE.
+    ELSE
+        pt_field_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_field_in%has_description) THEN
+        pt_field_out%description=pt_field_in%description
+        pt_field_out%has_description=.TRUE.
+    ELSE IF ( pt_field_default%has_description ) THEN
+        pt_field_out%description=pt_field_default%description
+        pt_field_out%has_description=.TRUE.
+    ELSE
+        pt_field_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_unit) THEN
+        pt_field_out%unit=pt_field_in%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE IF ( pt_field_default%has_unit ) THEN
+        pt_field_out%unit=pt_field_default%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE
+        pt_field_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_operation) THEN
+        pt_field_out%operation=pt_field_in%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE IF ( pt_field_default%has_operation ) THEN
+        pt_field_out%operation=pt_field_default%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE
+        pt_field_out%has_operation=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_freq_op) THEN
+        pt_field_out%freq_op=pt_field_in%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE IF ( pt_field_default%has_freq_op ) THEN
+        pt_field_out%freq_op=pt_field_default%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE
+        pt_field_out%has_freq_op=.FALSE.
+    ENDIF
+
+!    IF (pt_field_in%has_axis) THEN
+!        pt_field_out%p_axis => pt_field_in%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE IF ( pt_field_default%has_axis ) THEN
+!        pt_field_out%p_axis => pt_field_default%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE
+!        pt_field_out%has_axis=.FALSE.
+!    ENDIF
+    
+    IF (pt_field_in%has_axis_ref) THEN
+        pt_field_out%axis_ref=pt_field_in%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_axis_ref ) THEN
+        pt_field_out%axis_ref=pt_field_default%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE
+        pt_field_out%has_axis_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_grid_ref) THEN
+        pt_field_out%grid_ref=pt_field_in%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_grid_ref ) THEN
+        pt_field_out%grid_ref=pt_field_default%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE
+        pt_field_out%has_grid_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_zoom_ref) THEN
+        pt_field_out%zoom_ref=pt_field_in%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_zoom_ref ) THEN
+        pt_field_out%zoom_ref=pt_field_default%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE
+        pt_field_out%has_zoom_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_prec) THEN
+        pt_field_out%prec=pt_field_in%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE IF ( pt_field_default%has_prec ) THEN
+        pt_field_out%prec=pt_field_default%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE
+        pt_field_out%has_prec=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_level) THEN
+        pt_field_out%level=pt_field_in%level
+        pt_field_out%has_level=.TRUE.
+    ELSE IF ( pt_field_default%has_level ) THEN
+        pt_field_out%level=pt_field_default%level
+        pt_field_out%has_level=.TRUE.
+    ELSE
+        pt_field_out%has_level=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_enabled) THEN
+        pt_field_out%enabled=pt_field_in%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE IF ( pt_field_default%has_enabled ) THEN
+        pt_field_out%enabled=pt_field_default%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE
+        pt_field_out%has_enabled=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE field__apply_default
+
+!  FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
+!
+!    LOGICAL :: field__is_vert_axis_attached
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=*), INTENT(IN) :: vert_axis_name
+!
+!    field__is_vert_axis_attached = .false.
+!    IF (p_field%is_vert_axis_def) THEN
+!        IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
+!    ENDIF
+!
+!  END FUNCTION field__is_vert_axis_attached
+
+  RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    
+    TYPE(field), POINTER :: field_ref
+    
+    IF (.NOT. pt_field%solved_field_ref) THEN
+      
+      IF (pt_field%has_field_ref) THEN
+      
+        CALL field__get(pt_field%field_ref,field_ref)
+      
+        IF (.NOT. ASSOCIATED(field_ref)) THEN
+          WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to field : id =",pt_field%field_ref
+          CALL error("field__solve_field_ref")
+        ENDIF
+      
+        CALL field__get_field_base(field_ref,pt_field%field_base) 
+        Pt_field%has_field_base=.TRUE.
+        
+        CALL field__apply_default(field_ref,pt_field,pt_field)
+        
+          
+      ELSE 
+
+        IF (pt_field%has_id) THEN
+          pt_field%field_base=>pt_field
+        ENDIF
+      
+      ENDIF
+      
+      IF (.NOT. pt_field%has_name) THEN
+        IF (pt_field%has_id) THEN
+          pt_field%name=pt_field%id
+          pt_field%has_name=.TRUE.
+        ENDIF
+      ENDIF
+    
+      Pt_field%solved_field_ref=.TRUE.
+    
+    ENDIF
+    
+  END SUBROUTINE field__solve_field_ref
+  
+
+  RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    TYPE(field), POINTER :: pt_field_base
+    
+     
+    IF (.NOT. Pt_field%solved_field_ref) THEN
+      CALL field__solve_field_ref(Pt_field)
+    ENDIF
+     
+    IF (pt_field%has_field_base) THEN
+      pt_field_base=>pt_field%field_base
+    ELSE
+      pt_field_base=>pt_field
+    ENDIF
+   
+ END SUBROUTINE field__get_field_base
+
+ SUBROUTINE field__solve_axis_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_axis_ref) THEN
+     CALL axis__get(pt_field%axis_ref,pt_field%axis)
+     IF (ASSOCIATED(pt_field%axis)) THEN
+       pt_field%has_axis=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to axis : id =",pt_field%axis_ref
+       CALL error("mod_field::field__solve_axis_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_axis_ref
+   
+ SUBROUTINE field__solve_grid_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_grid_ref) THEN
+     CALL grid__get(pt_field%grid_ref,pt_field%grid)
+     IF (ASSOCIATED(pt_field%grid)) THEN
+       pt_field%has_grid=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to grid : id =",pt_field%grid_ref
+       CALL error("mod_field::field__solve_grid_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_grid_ref
+   
+ SUBROUTINE field__solve_zoom_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (.NOT. pt_field%has_zoom_ref) THEN
+     IF (pt_field%has_grid_ref) THEN
+       pt_field%has_zoom_ref=.TRUE.
+       pt_field%zoom_ref=pt_field%grid_ref
+     ENDIF
+   ENDIF
+    
+   IF (pt_field%has_zoom_ref) THEN
+     CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
+     IF (ASSOCIATED(pt_field%zoom)) THEN
+       pt_field%has_zoom=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to zoom : id =",pt_field%zoom_ref
+       CALL error("mod_field::field__solve_zoom_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_zoom_ref
+
+   
+END MODULE mod_field
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_attribute.f90	(revision 3437)
@@ -0,0 +1,21 @@
+MODULE mod_field_attribut
+  USE mod_object
+
+  INTEGER,PARAMETER :: field__begin = field_object + 10
+  
+  INTEGER,PARAMETER :: field__name = field_object + 11
+  INTEGER,PARAMETER :: field__description = field_object + 12
+  INTEGER,PARAMETER :: field__unit = field_object + 13
+  INTEGER,PARAMETER :: field__operation = field_object + 14
+  INTEGER,PARAMETER :: field__freq_op = field_object + 15
+  INTEGER,PARAMETER :: field__axis_ref = field_object + 16
+  INTEGER,PARAMETER :: field__grid_ref = field_object + 17
+  INTEGER,PARAMETER :: field__zoom_ref = field_object + 18
+  INTEGER,PARAMETER :: field__level = field_object + 19
+  INTEGER,PARAMETER :: field__prec = field_object + 20
+  INTEGER,PARAMETER :: field__field_ref = field_object + 21
+  INTEGER,PARAMETER :: field__enabled = field_object + 22
+
+  INTEGER,PARAMETER :: field__end = field_object + 23
+  
+END MODULE mod_field_attribut
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_definition.f90	(revision 3437)
@@ -0,0 +1,26 @@
+MODULE mod_field_definition
+  USE mod_field_group
+  
+  TYPE(field_group),SAVE,POINTER :: field_definition
+ 
+CONTAINS
+
+  SUBROUTINE field_definition__swap_context(saved_field_definition)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: saved_field_definition
+  
+    field_definition=>saved_field_definition
+
+  END SUBROUTINE field_definition__swap_context
+
+
+  SUBROUTINE field_definition__Init
+  IMPLICIT NONE
+  
+   CALL field_group__new(field_definition,"field_definition")
+
+  END SUBROUTINE field_definition__Init
+  
+        
+END MODULE mod_field_definition
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_field_group.f90	(revision 3437)
@@ -0,0 +1,304 @@
+MODULE mod_field_group
+
+  USE mod_field
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE field_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_field_group), POINTER         :: groups
+    TYPE(vector_field),POINTER                :: fields     
+    TYPE(field), POINTER                      :: default_attribut
+  END TYPE field_group
+
+  INCLUDE "vector_field_group_def.inc"  
+
+  TYPE(vector_field_group),SAVE,POINTER      :: field_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE field_group__set_attribut
+    MODULE PROCEDURE field_group__set_attribut_id,field_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_field_group_contains.inc"
+
+
+  SUBROUTINE field_group__swap_context(saved_field_group_ids, saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field_group),POINTER   :: saved_field_group_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids
+    
+    field_group_ids=>saved_field_group_ids 
+    ids=>saved_ids
+    
+  END SUBROUTINE field_group__swap_context
+
+  SUBROUTINE field_group__init
+  IMPLICIT NONE
+    
+    CALL vector_field_group__new(field_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field_group__init
+
+  SUBROUTINE field_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field_group),POINTER       :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field_group__get
+
+  SUBROUTINE field_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+      CALL field_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field group id :',id,'is undefined'
+        CALL error('mod_field_group::field_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE field_group__set_attribut_id
+  
+  SUBROUTINE field_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==field_object) THEN
+      CALL field__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE field_group__set_attribut_pt
+    
+      
+  RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(field_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%fields)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_field_group__new(Pt_fg%groups)
+    CALL vector_field__new(Pt_fg%fields)
+    CALL field__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_field_group__set_new(field_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE field_group__new
+
+      
+  SUBROUTINE field_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field_group),POINTER            :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field_group__get_new(Pt_fg%groups,Pt_fg_out)
+ 
+    IF (PRESENT(id)) THEN
+      CALL field_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL field_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_group
+
+  
+  SUBROUTINE field_group__get_new_field(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field__get_new(Pt_fg%fields,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL field__new(Pt_f_out,Id)
+    ELSE
+      CALL field__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_field
+  
+  
+  SUBROUTINE field_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    TYPE(field),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE field_group__get_default_attrib
+
+  
+  RECURSIVE SUBROUTINE field_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER           :: Pt_fg
+    TYPE(field),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL field__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__apply_default(Pt_fg%default_attribut,Pt_fg%fields%at(i)%pt,Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__apply_default
+  
+  SUBROUTINE field_group__solve_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+
+    CALL field_group__solve_field_ref(Pt_fg)
+    CALL field_group__solve_axis_ref(Pt_fg)
+    CALL field_group__solve_grid_ref(Pt_fg)
+    CALL field_group__solve_zoom_ref(Pt_fg)
+
+  END SUBROUTINE  field_group__solve_ref
+     
+  RECURSIVE SUBROUTINE field_group__solve_field_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_field_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_field_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_axis_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_axis_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_axis_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_axis_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_grid_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_grid_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_grid_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_grid_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_zoom_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_zoom_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_zoom_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_zoom_ref
+  
+  RECURSIVE SUBROUTINE field_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FIELD GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"field default attribut :"
+    CALL field__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned field groups :",Pt_fg%groups%size      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned field :",Pt_fg%fields%size      
+    DO i=1,Pt_fg%fields%size
+      CALL field__print(Pt_fg%fields%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"------------"
+    
+  END SUBROUTINE field_group__print     
+
+END MODULE mod_field_group
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file.f90	(revision 3437)
@@ -0,0 +1,362 @@
+MODULE mod_file
+
+  USE mod_xmlio_parameters
+  USE mod_field_group
+  USE mod_sorted_list
+
+  TYPE, PUBLIC :: file
+    CHARACTER(len=str_len)           :: id
+    LOGICAL                          :: has_id
+    CHARACTER(len=str_len)           :: name
+    LOGICAL                          :: has_name
+    CHARACTER(len=str_len)           :: name_suffix
+    LOGICAL                          :: has_name_suffix
+    CHARACTER(len=str_len)           :: description
+    LOGICAL                          :: has_description
+    INTEGER                          :: output_freq
+    LOGICAL                          :: has_output_freq
+    INTEGER                          :: output_level
+    LOGICAL                          :: has_output_level
+    LOGICAL                          :: enabled
+    LOGICAL                          :: has_enabled
+    INTEGER                          :: internal(internal_file)
+    TYPE(field_group),POINTER        :: field_list 
+  END TYPE file
+
+  INCLUDE 'vector_file_def.inc'
+  
+  TYPE(vector_file),POINTER,SAVE             :: file_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE file__set_attribut
+    MODULE PROCEDURE file__set_attribut_id,file__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_file_contains.inc'
+
+  SUBROUTINE file__swap_context(saved_file_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file),POINTER      :: saved_file_Ids
+    TYPE(sorted_list),POINTER      :: saved_Ids
+    
+    file_ids=>saved_file_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file__swap_context
+
+
+  SUBROUTINE file__init
+  IMPLICIT NONE
+    
+    CALL vector_file__new(file_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file__init
+  
+  SUBROUTINE file__get(Id,Pt_file)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file),POINTER              :: Pt_file
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+    ELSE
+      Pt_file=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file__get
+  
+  SUBROUTINE file__new(pt_file,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(file), POINTER           :: pt_file
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+
+   ALLOCATE(pt_file%field_list)
+   CALL field_group__new(pt_file%field_list)
+      
+   pt_file%has_id           = .FALSE.
+   pt_file%has_name         = .FALSE.
+   pt_file%has_name_suffix  = .FALSE.
+   pt_file%has_description  = .FALSE.
+   pt_file%has_output_freq  = .FALSE.
+   pt_file%has_output_level = .FALSE.
+   pt_file%has_enabled = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_file%id=TRIM(ADJUSTL(Id))
+     Pt_file%has_id=.TRUE.
+     CALL vector_file__set_new(file_Ids,Pt_file,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+  END SUBROUTINE file__new
+
+  SUBROUTINE file__set(pt_file, name, name_suffix, description, output_freq, output_level,enabled)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: name_suffix
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    INTEGER           ,OPTIONAL :: output_freq
+    INTEGER           ,OPTIONAL :: output_level
+    LOGICAL           ,OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        pt_file%name=TRIM(ADJUSTL(name))
+        pt_file%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(name_suffix)) THEN
+        pt_file%name_suffix=TRIM(ADJUSTL(name_suffix))
+        pt_file%has_name_suffix = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_file%description=TRIM(ADJUSTL(description))
+        pt_file%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(output_freq)) then
+        pt_file%output_freq=output_freq
+        pt_file%has_output_freq = .TRUE.
+    ENDIF
+
+    IF (PRESENT(output_level)) then
+        pt_file%output_level = output_level
+        pt_file%has_output_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        pt_file%enabled = enabled
+        pt_file%has_enabled = .TRUE.
+    ENDIF
+    
+  END SUBROUTINE file__set
+
+  SUBROUTINE file__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(file),POINTER              :: Pt_file
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+      CALL file__set_attribut_pt(Pt_file,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'File id : ',id,' is undefined'
+        CALL error('mod_file::file__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE file__set_attribut_id
+      
+  SUBROUTINE file__set_attribut_pt(Pt_file,attrib)
+  USE mod_attribut
+  USE mod_file_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file),POINTER        :: Pt_file
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    
+    SELECT CASE(attrib%name)
+      CASE (file__name)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__name_suffix)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name_suffix=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__description)
+        IF (attrib%type==string0) CALL  file__set(pt_file,description=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__output_freq)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_freq=attrib%integer0_ptr) ; RETURN
+      CASE (file__output_level)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_level=attrib%integer0_ptr) ; RETURN
+      CASE (file__enabled)
+        IF (attrib%type==logical0) CALL  file__set(pt_file,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'file attribut ',attrib%name,' : type : ',attrib%type,       &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_file::file__set_attribut')
+    
+  END SUBROUTINE file__set_attribut_pt
+  
+     
+  SUBROUTINE file__get_field_list(pt_file,pt_field_list)
+  IMPLICIT NONE
+    TYPE(file),POINTER         :: pt_file
+    TYPE(field_group),POINTER  :: pt_field_list
+    
+      pt_field_list=>pt_file%field_list
+  
+  END SUBROUTINE file__get_field_list
+    
+  SUBROUTINE file__print(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+
+    PRINT *,"---- FILE ----"
+    IF (pt_file%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_file%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_file%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_file%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+
+    IF (pt_file%has_name_suffix) THEN
+      PRINT *,"name_suffix = ",TRIM(pt_file%name_suffix)
+    ELSE
+      PRINT *,"name_suffix undefined"
+    ENDIF
+    
+    IF (pt_file%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_file%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_file%has_output_freq) THEN
+      PRINT *,"output_freq = ",pt_file%output_freq
+    ELSE
+      PRINT *,"output_freq undefined"
+    ENDIF
+
+    IF (pt_file%has_output_level) THEN
+      PRINT *,"output_level = ",pt_file%output_level
+    ELSE
+      PRINT *,"output_level undefined"
+    ENDIF
+
+    IF (pt_file%has_enabled) THEN
+      PRINT *,"enabled = ",pt_file%enabled
+    ELSE
+      PRINT *,"enabled undefined"
+    ENDIF
+
+    PRINT *,"field_list :"
+    CALL field_group__print(pt_file%field_list)
+
+    PRINT *,"--------------"
+
+  END SUBROUTINE file__print
+
+
+  SUBROUTINE file__apply_default(pt_file_default, pt_file_in, pt_file_out)
+
+    TYPE(file), POINTER :: pt_file_default, pt_file_in, pt_file_out
+
+    IF (pt_file_in%has_name) THEN
+        pt_file_out%name=pt_file_in%name
+        pt_file_out%has_name=.TRUE.
+    ELSE IF ( pt_file_default%has_name) THEN
+        pt_file_out%name=pt_file_default%name
+        pt_file_out%has_name=.TRUE.
+    ELSE
+        pt_file_out%has_name=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_in%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE IF ( pt_file_default%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_default%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE
+        pt_file_out%has_name_suffix=.FALSE.
+    ENDIF
+        
+    IF (pt_file_in%has_description) THEN
+        pt_file_out%description=pt_file_in%description
+        pt_file_out%has_description=.TRUE.
+    ELSE IF ( pt_file_default%has_description ) THEN
+        pt_file_out%description=pt_file_default%description
+        pt_file_out%has_description=.TRUE.
+    ELSE
+        pt_file_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_freq) THEN
+        pt_file_out%output_freq=pt_file_in%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE IF ( pt_file_default%has_output_freq ) THEN
+        pt_file_out%output_freq=pt_file_default%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE
+        pt_file_out%has_output_freq=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_level) THEN
+        pt_file_out%output_level=pt_file_in%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE IF ( pt_file_default%has_output_level ) THEN
+        pt_file_out%output_level=pt_file_default%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE
+        pt_file_out%has_output_level=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_enabled) THEN
+        pt_file_out%enabled=pt_file_in%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE IF ( pt_file_default%has_enabled ) THEN
+        pt_file_out%enabled=pt_file_default%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE
+        pt_file_out%has_enabled=.FALSE.
+    ENDIF
+    
+    CALL field_group__apply_default(pt_file_out%field_list)
+
+
+  END SUBROUTINE file__apply_default
+
+   
+  SUBROUTINE file__solve_field_ref(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+    
+    CALL field_group__solve_ref(pt_file%field_list)
+  
+  END SUBROUTINE file__solve_field_ref
+  
+  
+  SUBROUTINE file__Check(pt_file)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+      
+    IF (.NOT. pt_file%has_name) THEN
+      IF (pt_file%has_id) THEN
+        pt_file%name=TRIM(pt_file%id)
+      ELSE
+        WRITE(message,*) "File has no name and no id" 
+        CALL error("mod_file::file__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE file__Check
+    
+END MODULE mod_file
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_attribut.f90	(revision 3437)
@@ -0,0 +1,16 @@
+MODULE mod_file_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: file__begin = file_object + 10
+    
+  INTEGER,PARAMETER :: file__name = file_object + 11
+  INTEGER,PARAMETER :: file__description = file_object + 12
+  INTEGER,PARAMETER :: file__output_freq = file_object + 13
+  INTEGER,PARAMETER :: file__output_level = file_object + 14
+  INTEGER,PARAMETER :: file__enabled = file_object + 15
+  INTEGER,PARAMETER :: file__name_suffix = file_object + 16
+
+  INTEGER,PARAMETER :: file__end = file_object + 17
+
+END MODULE mod_file_attribut
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_definition.f90	(revision 3437)
@@ -0,0 +1,24 @@
+MODULE mod_file_definition
+  USE mod_file_group
+  
+  TYPE(file_group),SAVE,POINTER :: file_definition
+  
+CONTAINS
+
+  SUBROUTINE file_definition__swap_context(saved_file_definition)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER      :: saved_file_definition
+     
+    file_definition=>saved_file_definition
+ 
+  END SUBROUTINE file_definition__swap_context
+
+  SUBROUTINE file_definition__Init
+  USE mod_file_group
+  IMPLICIT NONE
+  
+    CALL file_group__new(file_definition,"file_definition")
+    
+  END SUBROUTINE file_definition__Init
+        
+END MODULE mod_file_definition
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_file_group.f90	(revision 3437)
@@ -0,0 +1,259 @@
+MODULE mod_file_group
+  USE mod_file
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE file_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_file_group), POINTER          :: groups
+    TYPE(vector_file),POINTER                 :: files     
+    TYPE(file), POINTER                       :: default_attribut
+  END TYPE file_group
+
+  INCLUDE "vector_file_group_def.inc"  
+
+  TYPE(vector_file_group),POINTER,SAVE       :: file_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids 
+
+  INTERFACE file_group__set_attribut
+    MODULE PROCEDURE file_group__set_attribut_id,file_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_file_group_contains.inc"
+
+  SUBROUTINE file_group__swap_context(saved_file_group_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file_group),POINTER      :: saved_file_group_Ids
+    TYPE(sorted_list),POINTER            :: saved_Ids
+    
+    file_group_ids=>saved_file_group_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file_group__swap_context
+
+  SUBROUTINE file_group__init
+  IMPLICIT NONE
+    
+    CALL vector_file_group__new(file_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file_group__init
+
+  SUBROUTINE file_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file_group),POINTER        :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file_group__get
+
+  SUBROUTINE file_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(file_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+      CALL file_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'file group id :',id,' is undefined'
+        CALL error('mod_file_group::file_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE file_group__set_attribut_id
+  
+  SUBROUTINE file_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(file_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==file_object) THEN
+      CALL file__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE file_group__set_attribut_pt
+  
+      
+  RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(file_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%files)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_file_group__new(Pt_fg%groups)
+    CALL vector_file__new(Pt_fg%files)
+    CALL file__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_file_group__set_new(file_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE file_group__new
+
+      
+  SUBROUTINE file_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER             :: Pt_fg
+    TYPE(file_group),POINTER             :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out)
+    CALL file_group__new(Pt_fg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL file_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL file_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_group
+
+  
+  SUBROUTINE file_group__get_new_file(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER            :: Pt_fg
+    TYPE(file),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file__get_new(Pt_fg%files,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL file__new(Pt_f_out,Id)
+    ELSE
+      CALL file__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_file
+  
+  
+  SUBROUTINE file_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE file_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE file_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL file__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__apply_default(Pt_fg%default_attribut,Pt_fg%files%at(i)%pt,Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__apply_default
+
+  RECURSIVE SUBROUTINE file_group__solve_field_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__solve_field_ref(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__solve_field_ref
+  
+  
+  RECURSIVE SUBROUTINE file_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FILE GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"file default attribut :"
+    CALL file__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned file groups :"      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned file :"      
+    DO i=1,Pt_fg%files%size
+      CALL file__print(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__print     
+
+  RECURSIVE SUBROUTINE file_group__Check(Pt_fg)
+  IMPLICIT NONE
+  
+    TYPE(file_group),POINTER  :: Pt_fg
+    INTEGER :: i
+   
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__check(pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_fg%files%size
+      CALL file__check(pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__check     
+          
+END MODULE mod_file_group
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid.f90	(revision 3437)
@@ -0,0 +1,384 @@
+MODULE mod_grid
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_domain
+  USE mod_zoom
+
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: grid
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    TYPE(domain),POINTER        :: domain
+    TYPE(vector_domain),POINTER :: subdomain
+    TYPE(sorted_list),POINTER   :: rank_ids
+    INTEGER,POINTER             :: ranks(:)
+    INTEGER                     :: ni
+    INTEGER                     :: nj
+    LOGICAL                     :: has_dimension
+    TYPE(vector_zoom),POINTER   :: associated_zoom
+    TYPE(zoom),POINTER          :: global_zoom
+  END TYPE grid
+
+  INCLUDE 'vector_grid_def.inc'
+  
+  TYPE(vector_grid),POINTER,SAVE             :: grid_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid__set_attribut
+    MODULE PROCEDURE grid__set_attribut_id,grid__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_grid_contains.inc'
+
+  SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_grid),POINTER          :: saved_grid_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    grid_ids=>saved_grid_ids
+    ids=>saved_ids
+  END SUBROUTINE grid__swap_context
+  
+  
+  SUBROUTINE grid__init
+  IMPLICIT NONE
+    
+    CALL vector_grid__new(grid_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid__init
+  
+  SUBROUTINE grid__get(Id,Pt_grid)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid),POINTER              :: Pt_grid
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+    ELSE
+      Pt_grid=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid__get
+  
+  SUBROUTINE grid__new(pt_grid,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(grid), POINTER           :: pt_grid
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   ALLOCATE(pt_grid%domain)
+   ALLOCATE(pt_grid%subdomain)
+   ALLOCATE(pt_grid%rank_ids)
+   ALLOCATE(pt_grid%associated_zoom)
+   
+   CALL domain__new(pt_grid%domain)
+   CALL vector_domain__new(pt_grid%subdomain)
+   CALL sorted_list__new(pt_grid%rank_ids)
+   CALL vector_zoom__new(pt_grid%associated_zoom)
+   
+   pt_grid%has_id          = .FALSE.
+   pt_grid%has_name        = .FALSE.
+   pt_grid%has_description = .FALSE.
+   pt_grid%has_dimension   = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_grid%id=TRIM(ADJUSTL(Id))
+     Pt_grid%has_id=.TRUE.
+     CALL vector_grid__set_new(grid_Ids,Pt_grid,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+   CALL grid__get_new_zoom(pt_grid,pt_grid%global_zoom,id)
+
+ END SUBROUTINE grid__new
+
+  SUBROUTINE grid__set(pt_grid, name, description)
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+
+    IF (PRESENT(name)) THEN
+        pt_grid%name=TRIM(ADJUSTL(name))
+        pt_grid%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_grid%description=TRIM(ADJUSTL(description))
+        pt_grid%has_description = .TRUE.
+    ENDIF
+
+  END SUBROUTINE grid__set
+
+
+  SUBROUTINE grid__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(grid),POINTER              :: Pt_grid
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+      CALL grid__set_attribut_pt(Pt_grid,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid id :',id,'is undefined'
+        CALL error('mod_grid::grid__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE grid__set_attribut_id
+      
+  SUBROUTINE grid__set_attribut_pt(Pt_grid,attrib)
+  USE mod_attribut
+  USE mod_grid_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(grid),POINTER        :: Pt_grid
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (grid__name)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,name=attrib%string0_ptr) ; RETURN
+      CASE (grid__description)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,description=attrib%string0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'grid attribut ',attrib%name,' : type :',attrib%type,      &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_grid::grid__set_attribut')
+    
+  END SUBROUTINE grid__set_attribut_pt
+  
+  SUBROUTINE grid__set_dimension(pt_grid, ni, nj)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: ni
+    INTEGER,INTENT(IN)    :: nj
+    
+    pt_grid%ni=ni
+    pt_grid%nj=nj
+    pt_grid%has_dimension=.TRUE.
+    
+  END SUBROUTINE grid__set_dimension
+    
+
+  SUBROUTINE grid__get_new_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: rank
+    TYPE(domain), POINTER :: Pt_domain
+    
+    INTEGER :: Pos
+    
+    CALL vector_domain__get_new(pt_grid%subdomain,pt_domain,Pos)
+    CALL sorted_list__add(pt_grid%rank_ids,rank,Pos)
+    CALL domain__new(pt_domain)
+    
+  END SUBROUTINE grid__get_new_subdomain    
+
+  SUBROUTINE grid__get_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER     :: pt_grid
+    INTEGER,INTENT(IN)      :: rank
+    TYPE(domain), POINTER   :: Pt_domain
+
+    INTEGER    :: rank_id
+    LOGICAL    :: success
+
+    CALL sorted_list__find(pt_grid%rank_ids,rank,rank_id,success)
+    IF (success) THEN
+      pt_domain=>pt_grid%subdomain%at(rank_id)%pt
+    ELSE
+      !! message d'erreur 
+   ENDIF
+
+  END SUBROUTINE grid__get_subdomain
+   
+  SUBROUTINE grid__process_domain(Pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    TYPE(domain),POINTER :: subdomain
+    TYPE(zoom),POINTER :: pt_zoom
+    
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+    INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin,iend,jend
+    INTEGER :: i
+    
+      ALLOCATE(pt_grid%ranks(1:pt_grid%subdomain%size))
+
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        IF (i==1) THEN
+          ib=subdomain%ibegin
+          ie=subdomain%iend   
+          jb=subdomain%jbegin
+          je=subdomain%jend
+        ELSE
+          IF (subdomain%ibegin<ib) ib=subdomain%ibegin
+          IF (subdomain%iend>ie) ie=subdomain%iend
+          IF (subdomain%jbegin<jb) jb=subdomain%jbegin
+          IF (subdomain%jend>je) je=subdomain%jend
+        ENDIF
+        pt_grid%ranks(subdomain%rank)=i
+      ENDDO
+      
+      ni=ie-ib+1
+      nj=je-jb+1
+      ibegin=ib
+      jbegin=jb
+      
+      ALLOCATE(lon(ni,nj))
+      ALLOCATE(lat(ni,nj))
+      
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        ib=subdomain%ibegin-ibegin+1
+        ie=subdomain%iend-ibegin+1   
+        jb=subdomain%jbegin-jbegin+1
+        je=subdomain%jend-jbegin+1
+        lon(ib:ie,jb:je)=subdomain%lon(:,:)
+        lat(ib:ie,jb:je)=subdomain%lat(:,:)
+      ENDDO
+      
+      CALL domain__set(pt_grid%domain,0,ni,nj,ibegin,jbegin,lon,lat)
+      iend=ibegin+ni-1
+      jend=jbegin+nj-1
+      
+      
+      pt_grid%global_zoom%ni_glo=pt_grid%ni
+      pt_grid%global_zoom%nj_glo=pt_grid%nj
+      pt_grid%global_zoom%ibegin_glo=1      
+      pt_grid%global_zoom%jbegin_glo=1
+      
+      DO i=1,pt_grid%associated_zoom%size
+        pt_zoom=>pt_grid%associated_zoom%at(i)%pt
+        
+        ib=MAX(pt_zoom%ibegin_glo-ibegin+1,1)
+        ie=MIN(pt_zoom%ibegin_glo+pt_zoom%ni_glo-ibegin,ni)
+        pt_zoom%ni_loc=MAX(ie-ib+1,0)
+        pt_zoom%ibegin_loc=ib
+
+        jb=MAX(pt_zoom%jbegin_glo-jbegin+1,1)
+        je=MIN(pt_zoom%jbegin_glo+pt_zoom%nj_glo-jbegin,nj)
+        pt_zoom%nj_loc=MAX(je-jb+1,0)
+        pt_zoom%jbegin_loc=jb
+      ENDDO
+                 
+            
+      DEALLOCATE(lon)
+      DEALLOCATE(lat)
+      
+    END SUBROUTINE grid__process_domain
+      
+            
+  SUBROUTINE grid__get_new_zoom(pt_grid,pt_zoom,zoom_id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid), POINTER                      :: pt_grid
+    TYPE(zoom),POINTER                       :: pt_zoom
+    CHARACTER(LEN=*),INTENT(IN),OPTIONAL     :: zoom_id
+    LOGICAL                                  :: success
+    
+     CALL vector_zoom__get_new(pt_grid%associated_zoom,Pt_zoom)
+     CALL zoom__new(Pt_zoom,zoom_id)
+    
+   END SUBROUTINE grid__get_new_zoom
+     
+  SUBROUTINE grid__print(pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    INTEGER              :: i
+    
+    PRINT *,"---- GRID ----"
+    
+    IF (pt_grid%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_grid%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_grid%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_grid%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_grid%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_grid%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+    
+    IF (pt_grid%has_dimension) THEN
+      PRINT *,"Global grid dimension :"
+      PRINT *,"   ni =",pt_grid%ni
+      PRINT *,"   nj =",pt_grid%nj
+    ELSE
+      PRINT *,"Global dimension ni, nj undefined"
+    ENDIF
+    
+    PRINT *,"grid domain :"
+    CALL domain__print(pt_grid%domain)
+    
+    PRINT *,"grid subdomain :",pt_grid%subdomain%size
+    
+    DO i=1,pt_grid%subdomain%size
+      CALL domain__print(pt_grid%subdomain%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"--------------"
+    
+  END SUBROUTINE grid__print
+
+  SUBROUTINE grid__apply_default(pt_grid_default, pt_grid_in, pt_grid_out)
+
+    TYPE(grid), POINTER :: pt_grid_default, pt_grid_in, pt_grid_out
+
+    IF (pt_grid_in%has_name) THEN
+        pt_grid_out%name=pt_grid_in%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE IF ( pt_grid_default%has_name) THEN
+        pt_grid_out%name=pt_grid_default%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE
+        pt_grid_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_grid_in%has_description) THEN
+        pt_grid_out%description=pt_grid_in%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE IF ( pt_grid_default%has_description ) THEN
+        pt_grid_out%description=pt_grid_default%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE
+        pt_grid_out%has_description=.FALSE.
+    ENDIF
+  
+  END SUBROUTINE grid__apply_default
+
+END MODULE mod_grid
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_attribut.f90	(revision 3437)
@@ -0,0 +1,13 @@
+MODULE mod_grid_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: grid__begin = grid_object + 10
+
+  INTEGER,PARAMETER :: grid__name = grid_object + 11
+  INTEGER,PARAMETER :: grid__description = grid_object + 12
+
+  INTEGER,PARAMETER :: grid__end = grid_object + 13
+
+  
+END MODULE mod_grid_attribut
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_definition.f90	(revision 3437)
@@ -0,0 +1,24 @@
+MODULE mod_grid_definition
+  USE mod_grid_group
+  
+  TYPE(grid_group),SAVE,POINTER :: grid_definition
+  
+CONTAINS
+
+  SUBROUTINE grid_definition__swap_context(saved_grid_definition)      
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: saved_grid_definition
+    
+    grid_definition=>saved_grid_definition
+    
+  END SUBROUTINE grid_definition__swap_context 
+
+  SUBROUTINE grid_definition__Init
+  USE mod_grid_group
+  IMPLICIT NONE
+  
+    CALL grid_group__new(grid_definition,"grid_definition")
+    
+  END SUBROUTINE grid_definition__Init
+ 
+END MODULE mod_grid_definition
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_grid_group.f90	(revision 3437)
@@ -0,0 +1,244 @@
+MODULE mod_grid_group
+  USE mod_grid
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE grid_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_grid_group), POINTER          :: groups
+    TYPE(vector_grid),POINTER                 :: grids     
+    TYPE(grid), POINTER                       :: default_attribut
+  END TYPE grid_group
+
+  INCLUDE "vector_grid_group_def.inc"  
+
+  TYPE(vector_grid_group),POINTER,SAVE       :: grid_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid_group__set_attribut
+    MODULE PROCEDURE grid_group__set_attribut_id,grid_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_grid_group_contains.inc"
+
+  SUBROUTINE grid_group__swap_context(saved_grid_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_grid_group),POINTER       :: saved_grid_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   grid_group_ids=>saved_grid_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE grid_group__swap_context
+   
+  SUBROUTINE grid_group__init
+  IMPLICIT NONE
+    
+    CALL vector_grid_group__new(grid_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid_group__init
+
+  SUBROUTINE grid_group__get(Id,Pt_gg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid_group),POINTER        :: Pt_gg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_gg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid_group__get
+
+
+  SUBROUTINE grid_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(grid_group),POINTER             :: Pt_gg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+      CALL grid_group__set_attribut(Pt_gg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid group id :',id,'is undefined'
+        CALL error('mod_grid_group::grid_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE grid_group__set_attribut_id
+  
+  SUBROUTINE grid_group__set_attribut_pt(pt_gg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: Pt_gg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==grid_object) THEN
+      CALL grid__set_attribut(pt_gg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE grid_group__set_attribut_pt    
+
+
+
+  RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER                :: Pt_gg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_gg%groups)
+    ALLOCATE(Pt_gg%grids)
+    ALLOCATE(Pt_gg%default_attribut)
+    
+    CALL vector_grid_group__new(Pt_gg%groups)
+    CALL vector_grid__new(Pt_gg%grids)
+    CALL grid__new(Pt_gg%default_attribut)
+    Pt_gg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_gg%id=TRIM(Id)
+      Pt_gg%has_id=.TRUE.
+      CALL vector_grid_group__set_new(grid_group_Ids,Pt_gg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE grid_group__new
+
+      
+  SUBROUTINE grid_group__get_new_group(Pt_gg,Pt_gg_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER             :: Pt_gg
+    TYPE(grid_group),POINTER             :: Pt_gg_out
+    CHARACTER(LEN=*),OPTIONAL            :: Id
+    
+    CALL vector_grid_group__get_new(Pt_gg%groups,Pt_gg_out)
+    CALL grid_group__new(Pt_gg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL grid_group__new(Pt_gg_out,Id)
+    ELSE
+      CALL grid_group__new(Pt_gg_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_group
+
+  
+  SUBROUTINE grid_group__get_new_grid(Pt_gg,Pt_g_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER            :: Pt_gg
+    TYPE(grid),POINTER                  :: Pt_g_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_grid__get_new(Pt_gg%grids,Pt_g_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL grid__new(Pt_g_out,Id)
+    ELSE
+      CALL grid__new(Pt_g_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_grid
+  
+  
+  SUBROUTINE grid_group__get_default_attrib(Pt_gg,Pt_g)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+    TYPE(grid),POINTER        :: Pt_g
+    
+    Pt_g=>Pt_gg%default_attribut
+  END SUBROUTINE grid_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE grid_group__apply_default(Pt_gg,default)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER      :: Pt_gg
+    TYPE(grid),POINTER,OPTIONAL   :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL grid__apply_default(default,Pt_gg%default_attribut,Pt_gg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__apply_default(Pt_gg%groups%at(i)%pt,Pt_gg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_gg%grids%size
+      CALL grid__apply_default(Pt_gg%default_attribut,Pt_gg%grids%at(i)%pt,Pt_gg%grids%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE grid_group__apply_default
+
+  RECURSIVE SUBROUTINE grid_group__Process_domain(Pt_gg)
+  IMPLICIT NONE
+  TYPE(grid_group),POINTER  :: Pt_gg
+    INTEGER :: i
+    
+    DO i=1,pt_gg%groups%size
+      CALL grid_group__process_domain(pt_gg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,pt_gg%grids%size
+      CALL grid__process_domain(pt_gg%grids%at(i)%pt)
+    ENDDO
+    
+  END SUBROUTINE grid_group__Process_domain
+      
+
+  RECURSIVE SUBROUTINE grid_group__print(Pt_gg)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- GRID GROUP ---"
+    IF (pt_gg%has_id) THEN
+      PRINT *,"id  ",TRIM(pt_gg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"grid default attribut :"
+    CALL grid__print(Pt_gg%default_attribut)    
+
+    PRINT *,"owned grid groups : ",Pt_gg%groups%size      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__print(Pt_gg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned grid : ",Pt_gg%grids%size     
+    DO i=1,Pt_gg%grids%size
+      CALL grid__print(Pt_gg%grids%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+  
+  END SUBROUTINE grid_group__print
+     
+END MODULE mod_grid_group
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_object.f90	(revision 3437)
@@ -0,0 +1,14 @@
+MODULE mod_object
+
+  INTEGER,PARAMETER :: field_object=100
+  INTEGER,PARAMETER :: field_group_object=200
+  INTEGER,PARAMETER :: file_object=300
+  INTEGER,PARAMETER :: file_group_object=400
+  INTEGER,PARAMETER :: axis_object=500
+  INTEGER,PARAMETER :: axis_group_object=600
+  INTEGER,PARAMETER :: grid_object=700
+  INTEGER,PARAMETER :: grid_group_object=800
+  INTEGER,PARAMETER :: zoom_object=900
+  INTEGER,PARAMETER :: zoom_group_object=1000
+  
+END MODULE mod_object
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_parse_xml.f90	(revision 3437)
@@ -0,0 +1,810 @@
+MODULE parsing_xml
+  USE flib_dom
+  USE error_msg
+  USE string_function
+  
+CONTAINS
+
+  SUBROUTINE parsing_xml_file(name)
+  IMPLICIT NONE
+    CHARACTER(len=*), INTENT(IN) :: name
+    TYPE(fnode), POINTER :: myDoc
+
+    myDoc => parsefile(name)
+    CALL parsing_root(myDoc)
+
+    PRINT *, 'Le parsing est termine !!! '
+  
+  END SUBROUTINE parsing_xml_file
+  
+ 
+  SUBROUTINE parsing_root(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+    IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('simulation') 
+             CALL parsing_simulation(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing root'
+               CALL Warning("mod_parse_xml:parsing_root")
+             ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_root
+
+  SUBROUTINE parsing_simulation(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+     IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('context') 
+             CALL parsing_context(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation'
+               CALL Warning("mod_parse_xml:parsing_simulationt")
+             ENDIF
+         END SELECT
+       
+       ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_simulation
+
+  SUBROUTINE parsing_context(node)
+  USE mod_context
+  USE mod_axis_definition
+  USE mod_grid_definition
+  USE mod_field_definition
+  USE mod_file_definition
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL context__create(TRIM(value))  
+      CALL context__swap(TRIM(value))
+    ENDIF
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('axis_definition') 
+             CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
+               
+           CASE ('grid_definition')
+             CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
+               
+           CASE ('field_definition')
+             CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
+               
+           CASE ('file_definition')
+             CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
+               
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context'
+               CALL Warning("mod_parse_xml:parsing_context")
+             ENDIF   
+        END SELECT
+      ENDDO
+
+    ENDIF
+
+  END SUBROUTINE parsing_context
+
+
+  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
+  USE mod_axis_definition
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    TYPE(axis_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+    
+    TYPE(axis_group),POINTER :: pt_axis_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_axis_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
+      ELSE
+        CALL axis_group__get_new_group(parent,pt_axis_group)
+      ENDIF
+    ENDIF
+      
+    CALL axis_group__get_default_attrib(pt_axis_group,attribute)
+    CALL parsing_axis_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_axis_group(child_node,pt_axis_group)
+             
+          CASE ('axis')
+            CALL parsing_axis(child_node,pt_axis_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
+              CALL Warning("mod_parse_xml:parsing_group_axis")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_axis_group
+
+  SUBROUTINE parsing_axis(node,parent)
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis_group),POINTER :: parent
+    
+    TYPE(axis),POINTER :: pt_axis
+    TYPE(axis),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
+    ELSE
+      CALL axis_group__get_new_axis(parent,pt_axis)
+    ENDIF
+      
+    CALL parsing_axis_attribute(node,pt_axis)
+  
+  END SUBROUTINE parsing_axis
+
+  
+  SUBROUTINE parsing_axis_attribute(node,pt_axis)
+  USE mod_axis
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis),POINTER :: pt_axis
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL axis__set(pt_axis,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL axis__set(pt_axis,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL axis__set(pt_axis,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"size")) THEN
+      value =  getAttribute(node,"size")
+      CALL axis__set(pt_axis,a_size=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"positive")) THEN
+      value =  getAttribute(node,"positive")
+      CALL axis__set(pt_axis,positive=string_to_logical(value))
+    ENDIF
+   
+  END SUBROUTINE parsing_axis_attribute 
+
+
+
+
+
+
+
+
+  RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
+  USE mod_grid_definition
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+
+    TYPE(grid_group),POINTER :: pt_grid_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(grid),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_grid_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
+      ELSE
+        CALL grid_group__get_new_group(parent,pt_grid_group)
+      ENDIF
+    ENDIF
+      
+    CALL grid_group__get_default_attrib(pt_grid_group,attribute)
+    CALL parsing_grid_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_grid_group(child_node,pt_grid_group)
+             
+          CASE ('grid')
+            CALL parsing_grid(child_node,pt_grid_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
+              CALL Warning("mod_parse_xml:parsing_group_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_grid_group
+
+  SUBROUTINE parsing_grid(node,parent)
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    
+    TYPE(grid),POINTER       :: pt_grid
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
+    ELSE
+      CALL grid_group__get_new_grid(parent,pt_grid)
+    ENDIF
+      
+    CALL parsing_grid_attribute(node,pt_grid)
+    
+
+   IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('zoom') 
+            CALL parsing_zoom(child_node,pt_grid)
+             
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid'
+              CALL Warning("mod_parse_xml:parsing_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  
+  END SUBROUTINE parsing_grid
+
+  SUBROUTINE parsing_grid_attribute(node,pt_grid)
+  USE mod_grid
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER :: pt_grid
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL grid__set(pt_grid,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL grid__set(pt_grid,description=TRIM(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_grid_attribute 
+
+  SUBROUTINE parsing_zoom(node,parent)
+  USE mod_zoom
+  USE mod_grid 
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER       :: parent
+    
+    TYPE(zoom),POINTER       :: pt_zoom
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value))
+    ELSE
+      CALL grid__get_new_zoom(parent,pt_zoom)
+    ENDIF
+      
+    CALL parsing_zoom_attribute(node,pt_zoom)
+    
+  END SUBROUTINE parsing_zoom
+
+
+  SUBROUTINE parsing_zoom_attribute(node,pt_zoom)
+  USE mod_zoom
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(zoom),POINTER       :: pt_zoom
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL zoom__set(pt_zoom,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL zoom__set(pt_zoom,description=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ni")) THEN
+      value =  getAttribute(node,"ni")
+      CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"nj")) THEN
+      value =  getAttribute(node,"nj")
+      CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ibegin")) THEN
+      value =  getAttribute(node,"ibegin")
+      CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"jbegin")) THEN
+      value =  getAttribute(node,"jbegin")
+      CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_zoom_attribute 
+
+
+
+  RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
+  USE mod_field_definition
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(field_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+    
+    TYPE(field_group),POINTER :: pt_field_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    LOGICAL            :: is_root
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+    
+    IF (is_root) THEN
+      pt_field_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
+      ELSE
+        CALL field_group__get_new_group(parent,pt_field_group)
+      ENDIF
+    ENDIF
+      
+    CALL field_group__get_default_attrib(pt_field_group,attribute)
+    CALL parsing_field_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_field_group)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_field_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
+              CALL Warning("mod_parse_xml:parsing_group_field")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_field_group
+
+  SUBROUTINE parsing_field(node,parent)
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(field_group),POINTER :: parent
+    
+    TYPE(field),POINTER :: pt_field
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL field_group__get_new_field(parent,pt_field,TRIM(value))
+    ELSE
+      CALL field_group__get_new_field(parent,pt_field)
+    ENDIF
+      
+    CALL parsing_field_attribute(node,pt_field)
+  
+  END SUBROUTINE parsing_field
+
+  
+  SUBROUTINE parsing_field_attribute(node,pt_field)
+  USE mod_field
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(field),POINTER :: pt_field
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL field__set(pt_field,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL field__set(pt_field,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL field__set(pt_field,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"operation")) THEN
+      value =  getAttribute(node,"operation")
+      CALL field__set(pt_field,operation=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"freq_op")) THEN
+      value =  getAttribute(node,"freq_op")
+      CALL field__set(pt_field,freq_op=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"axis_ref")) THEN
+      value =  getAttribute(node,"axis_ref")
+      CALL field__set(pt_field,axis_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"grid_ref")) THEN
+      value =  getAttribute(node,"grid_ref")
+      CALL field__set(pt_field,grid_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"zoom_ref")) THEN
+      value =  getAttribute(node,"zoom_ref")
+      CALL field__set(pt_field,zoom_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"level")) THEN
+      value =  getAttribute(node,"level")
+      CALL field__set(pt_field,level=string_to_integer(value))
+    ENDIF
+    
+    IF (is_attribute_exist(node,"prec")) THEN
+      value =  getAttribute(node,"prec")
+      CALL field__set(pt_field,prec=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ref")) THEN
+      value =  getAttribute(node,"ref")
+      CALL field__set(pt_field,ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL field__set(pt_field,enabled=string_to_logical(value))
+    ENDIF
+  
+
+  END SUBROUTINE parsing_field_attribute 
+
+
+  RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
+  USE mod_file_definition
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(file_group),POINTER      :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+
+    TYPE(file_group),POINTER :: pt_file_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(file),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_file_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
+      ELSE
+        CALL file_group__get_new_group(parent,pt_file_group)
+      ENDIF
+    ENDIF
+      
+    CALL file_group__get_default_attrib(pt_file_group,attribute)
+    CALL parsing_file_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_file_group(child_node,pt_file_group)
+             
+          CASE ('file')
+            CALL parsing_file(child_node,pt_file_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_file_group
+
+  SUBROUTINE parsing_file(node,parent)
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(file_group),POINTER :: parent
+    
+    TYPE(file),POINTER :: pt_file
+    TYPE(file),POINTER       :: attribute
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL file_group__get_new_file(parent,pt_file,TRIM(value))
+    ELSE
+      CALL file_group__get_new_file(parent,pt_file)
+    ENDIF
+      
+    CALL parsing_file_attribute(node,pt_file)
+  
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_file%field_list)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_file%field_list)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  END SUBROUTINE parsing_file
+
+  
+  SUBROUTINE parsing_file_attribute(node,pt_file)
+  USE mod_file
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(file),POINTER :: pt_file
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL file__set(pt_file,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"name_suffix")) THEN
+      value =  getAttribute(node,"name_suffix")
+      CALL file__set(pt_file,name_suffix=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL file__set(pt_file,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"output_freq")) THEN
+      value =  getAttribute(node,"output_freq")
+      CALL file__set(pt_file,output_freq=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"output_level")) THEN
+      value =  getAttribute(node,"output_level")
+      CALL file__set(pt_file,output_level=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL file__set(pt_file,enabled=string_to_logical(value))
+    ENDIF
+
+  END SUBROUTINE parsing_file_attribute
+  
+
+   
+  
+  FUNCTION is_attribute_exist(node, name)
+
+    LOGICAL :: is_attribute_exist
+    TYPE(fnode), POINTER :: node
+    CHARACTER(len=*) :: name
+    CHARACTER(len=100) :: value
+
+    value=""
+    
+    is_attribute_exist= .false.
+    value=getAttribute(node, TRIM(name))
+    IF (value .NE. "") is_attribute_exist= .true.
+
+  END FUNCTION is_attribute_exist
+
+  FUNCTION is_bad_node(node_name)
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN) :: node_name
+    LOGICAL                     :: is_bad_node
+    
+    IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
+      is_bad_node=.FALSE.
+    ELSE
+      is_bad_node=.TRUE.
+    ENDIF
+      
+  END FUNCTION is_bad_node
+  
+END MODULE parsing_xml
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_sorted_list.f90	(revision 3437)
@@ -0,0 +1,167 @@
+MODULE mod_sorted_list
+
+  PRIVATE
+  
+  TYPE node
+   INTEGER :: key
+   INTEGER :: value
+   LOGICAL :: has_value
+   TYPE(node),POINTER :: child1
+   TYPE(node),POINTER :: child2
+  END TYPE node
+
+TYPE, PUBLIC :: sorted_list
+  PRIVATE
+  TYPE(vector_node),POINTER :: tree => NULL()
+  TYPE(node),POINTER        :: first => NULL()
+  INTEGER :: size = 0
+  LOGICAL :: is_init=.FALSE.
+END TYPE sorted_list 
+
+  PUBLIC :: sorted_list__new, sorted_list__add, sorted_list__find, sorted_list__delete 
+INCLUDE 'vector_node_def.inc'
+
+CONTAINS
+
+INCLUDE 'vector_node_contains.inc'
+  
+  SUBROUTINE node__new(Pt_n)
+  IMPLICIT NONE
+    TYPE(node), POINTER :: Pt_n
+    
+    Pt_n%has_value=.FALSE.
+    Pt_n%child1=>NULL()
+    pt_n%child2=>NULL()
+  END SUBROUTINE node__new
+  
+  
+  SUBROUTINE sorted_list__new(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+    
+    IF (Pt_sl%is_init) CALL sorted_list__delete(Pt_sl)
+    
+    ALLOCATE(Pt_sl%tree)
+    CALL vector_node__new(Pt_sl%tree)
+    CALL vector_node__get_new(Pt_sl%tree,Pt_n)
+    CALL node__new(Pt_n)  
+    Pt_sl%first=>Pt_n
+    Pt_sl%Size=0
+    Pt_sl%is_init=.TRUE.
+    
+  END SUBROUTINE  sorted_list__new
+  
+  SUBROUTINE sorted_list__delete(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+
+    IF (Pt_sl%is_init) THEN
+      CALL vector_node__delete(Pt_sl%tree)
+      DEALLOCATE(Pt_sl%tree)
+      Pt_sl%is_init=.FALSE.
+    ENDIF
+   
+  END SUBROUTINE  sorted_list__delete
+
+   
+  SUBROUTINE sorted_list__Add(Pt_sl,key,value)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    INTEGER,INTENT(IN)  :: key
+    INTEGER,INTENT(IN)  :: value
+
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    TYPE(node), POINTER   :: new 
+    
+    
+    CALL vector_node__get_new(Pt_sl%tree,new)
+    CALL node__new(new)
+    current=>Pt_sl%first
+    
+      
+    Out=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            current%child2=>new
+            out=.FALSE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            current%child1=>new
+            out=.FALSE.
+          ENDIF
+        ENDIF 
+      ELSE
+        current%has_value=.TRUE.
+        current%key=key
+        current%value=value
+        out=.TRUE.
+      ENDIF
+    ENDDO
+    
+    Pt_sl%Size=Pt_sl%Size+1
+       
+  END SUBROUTINE sorted_list__Add
+
+  
+  SUBROUTINE sorted_list__find(Pt_sl,key,value,success)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    INTEGER,INTENT(IN)          :: key
+    INTEGER,INTENT(OUT)         :: value
+    LOGICAL,INTENT(OUT)         :: success
+    
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    
+    current=>Pt_sl%first
+    Out=.FALSE.
+    Success=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key == current%key) THEN
+          value=current%value
+          success=.TRUE.
+          out=.TRUE.
+        ELSE IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ENDIF
+      ELSE
+        out=.TRUE. 
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE sorted_list__find
+
+  
+  SUBROUTINE sorted_list__get_first(Pt_sl,Pt_n)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    TYPE(node),POINTER          :: Pt_n
+
+    Pt_n=>Pt_sl%tree%at(1)%Pt
+  END SUBROUTINE sorted_list__get_first  
+
+
+END MODULE mod_sorted_list
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_stdtype.f90	(revision 3437)
@@ -0,0 +1,48 @@
+MODULE mod_stdtype
+
+  INTEGER,PARAMETER :: integer0 = 0
+  INTEGER,PARAMETER :: integer1 = 1
+  INTEGER,PARAMETER :: integer2 = 2
+  INTEGER,PARAMETER :: integer3 = 3
+  INTEGER,PARAMETER :: integer4 = 4
+  INTEGER,PARAMETER :: integer5 = 5
+  INTEGER,PARAMETER :: integer6 = 6
+  INTEGER,PARAMETER :: integer7 = 7
+  
+  INTEGER,PARAMETER :: real0    = 8
+  INTEGER,PARAMETER :: real1    = 9
+  INTEGER,PARAMETER :: real2    = 10
+  INTEGER,PARAMETER :: real3    = 11
+  INTEGER,PARAMETER :: real4    = 12
+  INTEGER,PARAMETER :: real5    = 13
+  INTEGER,PARAMETER :: real6    = 14
+  INTEGER,PARAMETER :: real7    = 15
+
+  INTEGER,PARAMETER :: logical0 = 16
+  INTEGER,PARAMETER :: logical1 = 17
+  INTEGER,PARAMETER :: logical2 = 18
+  INTEGER,PARAMETER :: logical3 = 19
+  INTEGER,PARAMETER :: logical4 = 20
+  INTEGER,PARAMETER :: logical5 = 21
+  INTEGER,PARAMETER :: logical6 = 22
+  INTEGER,PARAMETER :: logical7 = 23
+  
+  INTEGER,PARAMETER :: string0  = 24
+  INTEGER,PARAMETER :: string1  = 25
+  INTEGER,PARAMETER :: string2  = 26
+  INTEGER,PARAMETER :: string3  = 27
+  INTEGER,PARAMETER :: string4  = 28
+  INTEGER,PARAMETER :: string5  = 29
+  INTEGER,PARAMETER :: string6  = 30
+  INTEGER,PARAMETER :: string7  = 31
+
+  INTEGER,PARAMETER :: char0   = 32
+  INTEGER,PARAMETER :: char1   = 33
+  INTEGER,PARAMETER :: char2   = 34
+  INTEGER,PARAMETER :: char3   = 35
+  INTEGER,PARAMETER :: char4   = 36
+  INTEGER,PARAMETER :: char5   = 37
+  INTEGER,PARAMETER :: char6   = 38
+  INTEGER,PARAMETER :: char7   = 39
+ 
+END MODULE mod_stdtype
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_time_parameters.f90	(revision 3437)
@@ -0,0 +1,26 @@
+MODULE mod_time_parameters
+
+  INTEGER,POINTER  :: initial_timestep
+  REAL,POINTER     :: initial_date
+  REAL,POINTER     :: timestep_value 
+  INTEGER,POINTER  :: timestep_number
+
+CONTAINS 
+
+  SUBROUTINE time_parameters__swap_context(saved_initial_timestep,saved_initial_date, &
+                                           saved_timestep_value,saved_timestep_number)
+  IMPLICIT NONE
+    INTEGER,POINTER  :: saved_initial_timestep
+    REAL,POINTER     :: saved_initial_date
+    REAL,POINTER     :: saved_timestep_value 
+    INTEGER,POINTER  :: saved_timestep_number
+   
+    initial_timestep => saved_initial_timestep
+    initial_date     => saved_initial_date
+    timestep_value   => saved_timestep_value 
+    timestep_number  => saved_timestep_number    
+    
+  END SUBROUTINE time_parameters__swap_context  
+    
+                                           
+END MODULE mod_time_parameters
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_vector_field.F90.old	(revision 3437)
@@ -0,0 +1,43 @@
+MODULE mod_field_vector
+  USE mod_field
+  
+  PRIVATE
+  
+   TYPE,PUBLIC :: field_vector
+     PRIVATE
+     TYPE(vector), POINTER :: list
+     TYPE(field),  POINTER :: default_attribut
+   END TYPE field_vector
+
+#define DATA_TYPE field
+#include "vectors_def.inc"
+
+  PUBLIC field_vector__new, field_vector__get_new
+
+CONTAINS
+
+#include "vectors_contains.inc"
+    
+  SUBROUTINE field_vector__new(Pt_vf)
+  IMPLICIT NONE
+    TYPE(field_vector),POINTER  :: Pt_vf
+    
+      CALL vector__new(Pt_vf%list)
+      CALL field__new(Pt_vf%default_attribut)
+  
+  END SUBROUTINE field_vector__new
+  
+
+  SUBROUTINE field_vector__get_new(Pt_vf,Pt_f_out,Id)
+  IMPLICIT NONE  
+    TYPE(field_vector),POINTER           :: Pt_vf
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=str_len),OPTIONAL      :: Id
+      
+      CALL vector__get_new(Pt_vf%list,Pt_f_out)
+      CALL field__new(Pt_f_out)
+   END SUBROUTINE field_vector__get_new
+   
+   
+END MODULE mod_field_vector
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_xmlio_parameters.f90	(revision 3437)
@@ -0,0 +1,14 @@
+MODULE mod_xmlio_parameters
+
+  INTEGER, PARAMETER :: str_len=100
+  INTEGER, PARAMETER :: array_size_unit=2
+  INTEGER, PARAMETER :: default_vector_size=100
+  REAL, PARAMETER    :: default_vector_grow_factor=1.5
+  INTEGER, PARAMETER :: str_msg_len=1024
+  
+  INTEGER,PARAMETER  :: internal_file=10
+  INTEGER,PARAMETER  :: internal_field=10
+  INTEGER,PARAMETER  :: internal_axis=10
+  INTEGER,PARAMETER  :: internal_grid=10
+  
+END MODULE mod_xmlio_parameters
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom.f90	(revision 3437)
@@ -0,0 +1,201 @@
+MODULE mod_zoom
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  IMPLICIT NONE
+
+  TYPE,PUBLIC :: zoom
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    INTEGER                     :: ni_glo
+    LOGICAL                     :: has_ni_glo
+    INTEGER                     :: nj_glo
+    LOGICAL                     :: has_nj_glo
+    INTEGER                     :: ibegin_glo
+    LOGICAL                     :: has_ibegin_glo
+    INTEGER                     :: jbegin_glo
+    LOGICAL                     :: has_jbegin_glo
+    INTEGER                     :: ni_loc
+    INTEGER                     :: nj_loc
+    INTEGER                     :: ibegin_loc
+    INTEGER                     :: jbegin_loc
+  END TYPE zoom    
+
+  INCLUDE 'vector_zoom_def.inc'
+
+  TYPE(vector_zoom),POINTER,SAVE             :: zoom_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE zoom__set_attribut
+    MODULE PROCEDURE zoom__set_attribut_id,zoom__set_attribut_pt
+  END INTERFACE
+  
+CONTAINS
+  
+  INCLUDE 'vector_zoom_contains.inc'
+
+  SUBROUTINE zoom__swap_context(saved_zoom_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_zoom),POINTER          :: saved_zoom_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    zoom_ids=>saved_zoom_ids
+    ids=>saved_ids
+  END SUBROUTINE zoom__swap_context
+
+
+  SUBROUTINE zoom__init
+  IMPLICIT NONE
+
+    CALL vector_zoom__new(zoom_Ids)
+    CALL sorted_list__new(Ids)
+    
+  END SUBROUTINE zoom__init
+  
+
+  SUBROUTINE zoom__new(pt_zoom,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(zoom),POINTER :: pt_zoom
+    CHARACTER(LEN=*),OPTIONAL     :: Id
+    INTEGER   :: Pos 
+      
+    pt_zoom%has_id=.FALSE.
+    pt_zoom%has_name=.FALSE.
+    pt_zoom%has_description=.FALSE.
+    pt_zoom%has_ni_glo=.FALSE.
+    pt_zoom%has_nj_glo=.FALSE.
+    pt_zoom%has_ibegin_glo=.FALSE.
+    pt_zoom%has_jbegin_glo=.FALSE.
+     
+    IF (PRESENT(Id)) THEN
+      Pt_zoom%id=TRIM(ADJUSTL(Id))
+      Pt_zoom%has_id=.TRUE.
+     CALL vector_zoom__set_new(zoom_Ids,Pt_zoom,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+   
+  END SUBROUTINE zoom__new
+   
+  SUBROUTINE zoom__set(pt_zoom,name,description,ni_glo,nj_glo,ibegin_glo,jbegin_glo)
+  IMPLICIT NONE
+    TYPE(zoom),POINTER                   :: pt_zoom
+    CHARACTER(len=*),OPTIONAL            :: name
+    CHARACTER(len=*),OPTIONAL            :: description
+    INTEGER,OPTIONAL                     :: ni_glo
+    INTEGER,OPTIONAL                     :: nj_glo
+    INTEGER,OPTIONAL                     :: ibegin_glo
+    INTEGER,OPTIONAL                     :: jbegin_glo
+    
+    IF (PRESENT(name)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(name))
+      pt_zoom%has_name=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(description)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(description))
+      pt_zoom%has_description=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(ni_glo)) THEN
+      pt_zoom%ni_glo=ni_glo
+      pt_zoom%has_ni_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(nj_glo)) THEN
+      pt_zoom%nj_glo=nj_glo
+      pt_zoom%has_nj_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(ibegin_glo)) THEN
+      pt_zoom%ibegin_glo=ibegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(jbegin_glo)) THEN
+      pt_zoom%jbegin_glo=jbegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+               
+   END SUBROUTINE zoom__set   
+
+  SUBROUTINE zoom__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(zoom),POINTER              :: Pt_zoom
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+      CALL zoom__set_attribut_pt(Pt_zoom,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'zoom id :',id,'is undefined'
+        CALL error('mod_zoom::zoom__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE zoom__set_attribut_id
+      
+  SUBROUTINE zoom__set_attribut_pt(Pt_zoom,attrib)
+  USE mod_attribut
+  USE mod_zoom_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(zoom),POINTER        :: Pt_zoom
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (zoom__name)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,name=attrib%string0_ptr) ; RETURN
+      CASE (zoom__description)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,description=attrib%string0_ptr) ; RETURN
+      CASE (zoom__ni)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ni_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__nj)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,nj_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__ibegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ibegin_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__jbegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,jbegin_glo=attrib%integer0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'zoom attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_zoom::zoom__set_attribut')
+    
+  END SUBROUTINE zoom__set_attribut_pt
+
+  SUBROUTINE zoom__get(Id,pt_zoom)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(zoom),POINTER              :: Pt_zoom
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+    ELSE
+      Pt_zoom=>NULL()
+    ENDIF
+    
+  END SUBROUTINE zoom__get
+
+END MODULE mod_zoom
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/mod_zoom_attribut.f90	(revision 3437)
@@ -0,0 +1,17 @@
+MODULE mod_zoom_attribut
+  USE mod_object
+   
+  INTEGER,PARAMETER :: zoom__begin = zoom_object + 10
+
+  INTEGER,PARAMETER :: zoom__name = zoom_object + 11
+  INTEGER,PARAMETER :: zoom__description = zoom_object + 12
+  INTEGER,PARAMETER :: zoom__ni = zoom_object + 13
+  INTEGER,PARAMETER :: zoom__nj = zoom_object + 14
+  INTEGER,PARAMETER :: zoom__ibegin = zoom_object + 15
+  INTEGER,PARAMETER :: zoom__jbegin = zoom_object + 16
+  
+  INTEGER,PARAMETER :: zoom__end = zoom_object + 17
+
+END MODULE mod_zoom_attribut
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/string_function.f90	(revision 3437)
@@ -0,0 +1,107 @@
+MODULE string_function
+ 
+
+
+
+CONTAINS
+
+  FUNCTION stdstr(string)
+  USE mod_xmlio_parameters
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: string
+    CHARACTER(LEN=str_len) :: stdstr
+    
+    stdstr=string
+  END FUNCTION stdstr
+    
+  
+  FUNCTION Hash(Str)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    CHARACTER(LEN=LEN(str)) :: new_str
+    INTEGER :: Hash
+    INTEGER :: c
+    INTEGER :: i
+    
+    new_str=ADJUSTL(ADJUSTR(Str))
+    
+    Hash=0
+    DO i=1,LEN_TRIM(new_Str)
+      c = IACHAR(new_Str(i:i))
+      Hash=c+ISHFT(Hash,6)+ISHFT(Hash,16)-Hash
+    ENDDO
+    
+  END FUNCTION Hash
+  
+  FUNCTION String_to_integer(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    INTEGER :: String_to_integer
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_integer
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to integer'
+        CALL Error("string_function:string_to_integer")
+      ENDIF
+    ENDIF
+  END FUNCTION String_to_integer
+  
+  FUNCTION String_to_real(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    REAL    :: String_to_real
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_real
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to real'
+        CALL Error("string_function:string_to_real")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_real
+  
+  FUNCTION String_to_logical(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    LOGICAL :: String_to_logical
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_logical
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to logical'
+        CALL Error("string_function:string_to_logical")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_logical
+    
+END MODULE string_function
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/test_xmlio.f90	(revision 3437)
@@ -0,0 +1,85 @@
+PROGRAM test_xmlio
+  USE xmlio
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+  TYPE(field),POINTER :: Pt_f
+  TYPE(field_group),POINTER :: Pt_fg
+  TYPE(file),POINTER :: Pt_file
+  TYPE(grid),POINTER :: pt_grid 
+  INTEGER,PARAMETER  :: ni=360
+  INTEGER,PARAMETER  :: nj=180
+  REAL,DIMENSION(ni,nj) :: lon
+  REAL,DIMENSION(ni,nj) :: lat
+  INTEGER               :: i,j
+  TYPE(axis),POINTER :: pt_axis 
+  
+  DO i=1,ni
+    DO j=1,nj
+      lon(i,j)=i
+      lat(i,j)=j
+    ENDDO
+  ENDDO  
+  
+  
+  
+  CALL xmlio__init("iodef.xml")
+
+  CALL grid__get("grid_T",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_U",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_V",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_W",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+  
+  CALL axis__get("deptht",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthu",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthv",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthw",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+
+  CALL axis_group__apply_default(axis_definition)
+  CALL grid_group__apply_default(grid_definition)
+  CALL field_group__apply_default(field_definition)
+  CALL file_group__apply_default(file_definition)
+  
+  CALL field_group__solve_ref(field_definition)
+  CALL file_group__solve_field_ref(file_definition)
+
+  CALL file_group__check(file_definition)
+  CALL axis_group__check(axis_definition)
+
+!
+  CALL axis_group__print(axis_definition)
+  CALL grid_group__print(grid_definition)
+  CALL field_group__print(field_definition)
+  CALL file_group__print(file_definition)
+!  CALL field_group__get_new_field(field_definition,pt_f,"toto")
+!  CALL field__set(Pt_f,name="toto",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"tata")
+!  CALL field__set(Pt_f,name="tata",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"titi")
+!  CALL field__set(Pt_f,name="titi",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"xyz")
+!  CALL field__set(Pt_f,name="xyz",unit="kg")
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+   
+   CALL set_time_parameters(0,0.,3600.)
+   
+   CALL create_header
+   
+END PROGRAM test_xmlio
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis__new
+  
+  SUBROUTINE vector_axis__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis__delete
+  
+  SUBROUTINE vector_axis__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__get_new
+
+  SUBROUTINE vector_axis__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__set_new
+  
+  SUBROUTINE vector_axis__increase(vect)
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis__ 
+    TYPE (axis),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis__
+
+  TYPE vector_axis
+  
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis_group__new
+  
+  SUBROUTINE vector_axis_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis_group__delete
+  
+  SUBROUTINE vector_axis_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__get_new
+
+  SUBROUTINE vector_axis_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__set_new
+  
+  SUBROUTINE vector_axis_group__increase(vect)
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis_group__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_axis_group_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis_group__ 
+    TYPE (axis_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis_group__
+
+  TYPE vector_axis_group
+  
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis_group
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_contains.template	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_#TYPE#__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_#TYPE#__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_#TYPE#__new
+  
+  SUBROUTINE vector_#TYPE#__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL #TYPE#__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_#TYPE#__delete
+  
+  SUBROUTINE vector_#TYPE#__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__get_new
+
+  SUBROUTINE vector_#TYPE#__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__set_new
+  
+  SUBROUTINE vector_#TYPE#__increase(vect)
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_#TYPE#__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_context__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_context__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_context__new
+  
+  SUBROUTINE vector_context__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL context__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_context__delete
+  
+  SUBROUTINE vector_context__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__get_new
+
+  SUBROUTINE vector_context__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__set_new
+  
+  SUBROUTINE vector_context__increase(vect)
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_context__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_context_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_context__ 
+    TYPE (context),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_context__
+
+  TYPE vector_context
+  
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_context
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_def.template	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_#TYPE#__ 
+    TYPE (#TYPE#),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_#TYPE#__
+
+  TYPE vector_#TYPE#
+  
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_#TYPE#
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_domain__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_domain__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_domain__new
+  
+  SUBROUTINE vector_domain__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL domain__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_domain__delete
+  
+  SUBROUTINE vector_domain__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__get_new
+
+  SUBROUTINE vector_domain__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__set_new
+  
+  SUBROUTINE vector_domain__increase(vect)
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_domain__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_domain_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_domain__ 
+    TYPE (domain),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_domain__
+
+  TYPE vector_domain
+  
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_domain
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field__new
+  
+  SUBROUTINE vector_field__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field__delete
+  
+  SUBROUTINE vector_field__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__get_new
+
+  SUBROUTINE vector_field__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__set_new
+  
+  SUBROUTINE vector_field__increase(vect)
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field__ 
+    TYPE (field),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field__
+
+  TYPE vector_field
+  
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_dep__new
+  
+  SUBROUTINE vector_field_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_dep__delete
+  
+  SUBROUTINE vector_field_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__get_new
+
+  SUBROUTINE vector_field_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__set_new
+  
+  SUBROUTINE vector_field_dep__increase(vect)
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_dep__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_dep_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_dep__ 
+    TYPE (field_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_dep__
+
+  TYPE vector_field_dep
+  
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_dep
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_group__new
+  
+  SUBROUTINE vector_field_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_group__delete
+  
+  SUBROUTINE vector_field_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__get_new
+
+  SUBROUTINE vector_field_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__set_new
+  
+  SUBROUTINE vector_field_group__increase(vect)
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_group__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_group_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_group__ 
+    TYPE (field_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_group__
+
+  TYPE vector_field_group
+  
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_group
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_out__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_out__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_out__new
+  
+  SUBROUTINE vector_field_out__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_out__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_out__delete
+  
+  SUBROUTINE vector_field_out__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__get_new
+
+  SUBROUTINE vector_field_out__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__set_new
+  
+  SUBROUTINE vector_field_out__increase(vect)
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_out__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_field_out_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_out__ 
+    TYPE (field_out),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_out__
+
+  TYPE vector_field_out
+  
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_out
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file__new
+  
+  SUBROUTINE vector_file__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file__delete
+  
+  SUBROUTINE vector_file__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__get_new
+
+  SUBROUTINE vector_file__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__set_new
+  
+  SUBROUTINE vector_file__increase(vect)
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file__ 
+    TYPE (file),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file__
+
+  TYPE vector_file
+  
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_dep__new
+  
+  SUBROUTINE vector_file_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_dep__delete
+  
+  SUBROUTINE vector_file_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__get_new
+
+  SUBROUTINE vector_file_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__set_new
+  
+  SUBROUTINE vector_file_dep__increase(vect)
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_dep__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_dep_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_dep__ 
+    TYPE (file_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_dep__
+
+  TYPE vector_file_dep
+  
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_dep
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_group__new
+  
+  SUBROUTINE vector_file_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_group__delete
+  
+  SUBROUTINE vector_file_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__get_new
+
+  SUBROUTINE vector_file_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__set_new
+  
+  SUBROUTINE vector_file_group__increase(vect)
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_group__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_file_group_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_group__ 
+    TYPE (file_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_group__
+
+  TYPE vector_file_group
+  
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_group
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid__new
+  
+  SUBROUTINE vector_grid__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid__delete
+  
+  SUBROUTINE vector_grid__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__get_new
+
+  SUBROUTINE vector_grid__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__set_new
+  
+  SUBROUTINE vector_grid__increase(vect)
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid__ 
+    TYPE (grid),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid__
+
+  TYPE vector_grid
+  
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid_group__new
+  
+  SUBROUTINE vector_grid_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid_group__delete
+  
+  SUBROUTINE vector_grid_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__get_new
+
+  SUBROUTINE vector_grid_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__set_new
+  
+  SUBROUTINE vector_grid_group__increase(vect)
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid_group__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_grid_group_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid_group__ 
+    TYPE (grid_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid_group__
+
+  TYPE vector_grid_group
+  
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid_group
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_node__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_node__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_node__new
+  
+  SUBROUTINE vector_node__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL node__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_node__delete
+  
+  SUBROUTINE vector_node__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__get_new
+
+  SUBROUTINE vector_node__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__set_new
+  
+  SUBROUTINE vector_node__increase(vect)
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_node__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_node_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_node__ 
+    TYPE (node),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_node__
+
+  TYPE vector_node
+  
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_node
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_contains.inc	(revision 3437)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_zoom__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_zoom__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_zoom__new
+  
+  SUBROUTINE vector_zoom__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL zoom__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_zoom__delete
+  
+  SUBROUTINE vector_zoom__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__get_new
+
+  SUBROUTINE vector_zoom__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__set_new
+  
+  SUBROUTINE vector_zoom__increase(vect)
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_zoom__increase 
+    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/vector_zoom_def.inc	(revision 3437)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_zoom__ 
+    TYPE (zoom),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_zoom__
+
+  TYPE vector_zoom
+  
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_zoom
+  
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/XMLIO_SERVER/src/XMLIO/xmlio.f90	(revision 3437)
@@ -0,0 +1,53 @@
+MODULE xmlio
+
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_dependency
+  USE string_function
+  USE error_msg
+  USE mod_context
+  USE mod_time_parameters
+  
+CONTAINS
+
+  SUBROUTINE xmlio__Init(xml_file)
+  USE parsing_xml
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: xml_file
+    
+    CALL context__init
+    CALL parsing_xml_file(xml_file)
+    
+  END SUBROUTINE xmlio__init
+  
+  
+  SUBROUTINE xmlio__close_definition
+  IMPLICIT NONE
+  
+    CALL axis_group__apply_default(axis_definition)
+    CALL grid_group__apply_default(grid_definition)
+    CALL field_group__apply_default(field_definition)
+    CALL file_group__apply_default(file_definition)
+  
+    CALL field_group__solve_ref(field_definition)
+    CALL file_group__solve_field_ref(file_definition)
+
+    CALL file_group__check(file_definition)
+    CALL axis_group__check(axis_definition)
+    CALL grid_group__process_domain(grid_definition)
+     
+    CALL set_dependency
+
+  END SUBROUTINE xmlio__close_definition
+
+END MODULE xmlio
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/COPYRIGHT.txt	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/LICENSE.html
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/LICENSE.html	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_diff	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_graphic_merge	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_gui	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_internal	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_setup_konqueror	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/bin/fcm_update_version_dir.pl	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm.cfg.eg	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/etc/fcm_gui.desktop	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Base.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Build/Fortran.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildSrc.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/BuildTask.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Config/Default.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Exception.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Browser.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CM.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/GUI.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/Help.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Option.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/Subcommand.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-add.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-branch.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-commit.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-conflicts.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-delete.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-diff.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-merge.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-switch.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CLI/fcm-update.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgFile.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CfgLine.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Cm.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmBranch.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmCommitMessage.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/CmUrl.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ConfigSystem.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Dest.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Exception.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Extract.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractConfigComparator.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractFile.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ExtractSrc.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Config.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entries.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Entry/Location.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Exception.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader.pod	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/ReposBranch.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/SrcDirLayer.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Timer.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Util/ClassLoader.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/man/man1/fcm.1	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Build/Fortran.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config/Default.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Exception.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Browser.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CM.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/GUI.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/Help.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Exception.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/ExtractConfigComparator.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive/InputGetter/GUI.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Config.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entry/Location.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Exception.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entries.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Location.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/fcm/t/Fcm/Util/ClassLoader.t	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/svn_load_dirs.pl	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/EXTERNAL/svn_tools/update_vendor.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/License_CeCILL.txt
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/License_CeCILL.txt	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/License_CeCILL.txt	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/dom_ice_2.F90	(revision 3437)
@@ -0,0 +1,77 @@
+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(:,:)         ::   fs2cor , fcor     !: coriolis factor and coeficient
+   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
+
+
+# if defined key_lim2_vp
+   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
+# else
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmv    , tmf      !: y-velocity and F-points masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   tmi               !: ice mask: =1 if ice thick > 0
+# endif
+   !!----------------------------------------------------------------------
+   CONTAINS
+
+   INTEGER FUNCTION dom_ice_alloc_2()
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY:   ctl_warn   ! MPP library
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( fs2cor(jpi,jpj)     , fcor(jpi,jpj) ,                                   &
+         &      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90	(revision 3437)
@@ -0,0 +1,197 @@
+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  = "restart_ice_in"   !: suffix of ice restart name (input)
+   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out = "restart_ice"      !: suffix of ice restart name (output)
+   LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F)
+   LOGICAL               , PUBLIC ::   ln_limdmp     = .FALSE.            !: Ice damping
+   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag grid points output (T) or not (F)
+   REAL(wp)              , PUBLIC ::   hsndif        = 0._wp              !: snow temp. computation (0) or not (9999)
+   REAL(wp)              , PUBLIC ::   hicdif        = 0._wp              !: ice  temp. computation (0) or not (9999)
+   REAL(wp), DIMENSION(2), PUBLIC ::   acrit = (/ 1.e-6_wp , 1.e-6_wp /)  !: minimum lead fraction in the 2 hemisphere
+   
+   !                                          !!* ice-dynamic namelist (namicedyn) *
+   INTEGER , PUBLIC ::   nbiter =    1         !: number of sub-time steps for relaxation
+   INTEGER , PUBLIC ::   nbitdr =  250         !: maximum number of iterations for relaxation
+   INTEGER , PUBLIC ::   nevp   =  360         !: number of EVP subcycling iterations
+   INTEGER , PUBLIC ::   telast = 3600         !: timescale for EVP elastic waves
+   REAL(wp), PUBLIC ::   epsd   = 1.0e-20_wp   !: tolerance parameter for dynamic
+   REAL(wp), PUBLIC ::   alpha  = 0.5_wp       !: coefficient for semi-implicit coriolis
+   REAL(wp), PUBLIC ::   dm     = 0.6e+03_wp   !: diffusion constant for dynamics
+   REAL(wp), PUBLIC ::   om     = 0.5_wp       !: relaxation constant
+   REAL(wp), PUBLIC ::   resl   = 5.0e-05_wp   !: maximum value for the residual of relaxation
+   REAL(wp), PUBLIC ::   cw     = 5.0e-03_wp   !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   angvg  = 0._wp        !: turning angle for oceanic stress
+   REAL(wp), PUBLIC ::   pstar  = 1.0e+04_wp   !: first bulk-rheology parameter
+   REAL(wp), PUBLIC ::   c_rhg  = 20._wp       !: second bulk-rhelogy parameter
+   REAL(wp), PUBLIC ::   etamn  = 0._wp        !: minimun value for viscosity
+   REAL(wp), PUBLIC ::   creepl = 2.e-08_wp    !: creep limit
+   REAL(wp), PUBLIC ::   ecc    = 2._wp        !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   ahi0   = 350._wp      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coefficient for the solution of EVP int. stresses
+
+   REAL(wp), PUBLIC ::   usecc2                !:  = 1.0 / ( ecc * ecc )
+   REAL(wp), PUBLIC ::   rhoco                 !: = rau0 * cw
+   REAL(wp), PUBLIC ::   sangvg, cangvg        !: sin and cos of the turning angle for ocean stress
+   REAL(wp), PUBLIC ::   pstarh                !: pstar / 2.0
+
+   REAL(wp), PUBLIC, 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(:,:) ::   rdmsnif       !: Variation of snow mass
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif       !: Variation of ice mass
+   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        !: 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) , rdmsnif(jpi,jpj) , rdmicif(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90	(revision 3437)
@@ -0,0 +1,140 @@
+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 in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+
+   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 namelist file 
+      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
+      !    
+      CALL ice_run_2                   ! read in namelist some run parameters
+      !          
+      rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice time step
+      numit   = nit000 - 1
+      !
+      CALL lim_msh_2                   ! ice mesh initialization
+      !
+      !                                ! Initial sea-ice state
+      IF( .NOT.ln_rstart ) THEN   ;   CALL lim_istate_2     ! start from rest: sea-ice deduced from sst
+      ELSE                        ;   CALL lim_rst_read_2   ! start from a restart file
+      ENDIF
+      !
+      tn_ice(:,:,1) = sist(:,:)        ! 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_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif
+      !!-------------------------------------------------------------------
+      !                    
+      REWIND( numnam_ice )                      ! Read Namelist namicerun 
+      READ  ( numnam_ice , namicerun )
+      !
+      IF(lwp) THEN                              ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ice_run : ice share parameters for dynamics/advection/thermo of sea-ice'
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limadv_2.F90	(revision 3437)
@@ -0,0 +1,423 @@
+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
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdia_2.F90	(revision 3437)
@@ -0,0 +1,279 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC               lim_dia_2          ! called by sbc_ice_lim_2
+
+   INTEGER, PUBLIC ::   ntmoy   = 1 ,   &  !: instantaneous values of ice evolution or averaging ntmoy
+      &                 ninfo   = 1        !: 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  = 4 ,     &  ! 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  = '1PE13.5 ' ! 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 
+      !!-------------------------------------------------------------------
+
+      IF( kt == nit000 )   CALL lim_dia_init_2  ! initialisation of ice_evolu file      
+
+      ! 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
+       REAL(wp) ::   zxx0, zxx1              ! local scalars
+
+       NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
+       !!-------------------------------------------------------------------
+
+       REWIND( numnam_ice )                     ! Read Namelist namicedia
+       READ  ( numnam_ice  , 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', 'REPLACE', '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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90	(revision 3437)
@@ -0,0 +1,182 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_dmp_2     ! called by sbc_ice_lim2
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   resto_ice   ! restoring coeff. on ICE   [s-1]
+
+   INTEGER, PARAMETER :: jp_hicif = 1 , jp_frld = 2
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_icedmp    ! structure of ice damping input
+   
+   !! * 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 : ice model damping : restoring ice thickness and fraction leads
+      !!
+      !! ** method  : the key_tradmp must be used to compute resto(:,:,1) coef.
+      !!---------------------------------------------------------------------
+      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 )
+         !
+!CDIR COLLAPSE
+         hicif(:,:) = MAX( 0._wp,                     &        ! h >= 0         avoid spurious out of physical range
+            &         hicif(:,:) - rdt_ice * resto_ice(:,:,1) * ( hicif(:,:) - sf_icedmp(jp_hicif)%fnow(:,:,1) )  ) 
+!CDIR COLLAPSE
+         hicif(:,:) = MAX( 0._wp, MIN( 1._wp,         &        ! 0<= frld<=1    values which blow the run up
+            &         frld (:,:) - rdt_ice * resto_ice(:,:,1) * ( frld (:,:) - sf_icedmp(jp_frld )%fnow(:,:,1) )  )  )
+         !
+      ENDIF
+      !
+   END SUBROUTINE lim_dmp_2
+
+
+   SUBROUTINE lim_dmp_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_dmp_init  ***
+      !!
+      !! ** Purpose :   Initialization for the ice thickness and concentration 
+      !!                restoring
+      !!              restoring will be used. It is used to mimic ice open
+      !!              boundaries.
+      !!
+      !! ** Method  :  ?????
+      !!      
+      !! ** Action  :   define resto_ice(:,:,1)
+      !!----------------------------------------------------------------------
+      INTEGER  :: ji, jj, jk       ! dummy loop indices
+      INTEGER  :: irelax, ierror   ! error flag for allocation
+      !
+      REAL(wp) :: zdmpmax, zdmpmin, zfactor, zreltim ! temporary scalar
+      !
+      CHARACTER(len=100)           ::   cn_dir       ! Root directory for location of ssr files
+      TYPE(FLD_N), DIMENSION (2)   ::   sl_icedmp    ! informations about the icedmp  field to be read
+      TYPE(FLD_N)                  ::   sn_hicif     ! 
+      TYPE(FLD_N)                  ::   sn_frld      ! 
+      NAMELIST/namice_dmp/ cn_dir, ln_limdmp, sn_hicif, sn_frld
+      !!----------------------------------------------------------------------
+      !
+      ! 1)  initialize fld read structure for input data 
+      !     --------------------------------------------
+      ln_limdmp = .false.                 !* set file information (default values)
+      cn_dir    = './'
+      ! (NB: frequency positive => hours, negative => months)
+      !                !    file     ! frequency ! variable ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+      !                !    name     !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+      sn_hicif = FLD_N( 'ice_damping ', -1       , 'hicif'  ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      )
+      sn_frld  = FLD_N( 'ice_damping ', -1       , 'frld'   ,  .true.    , .true.  ,  'yearly'   ,  ''      ,  ''      )
+
+      REWIND( numnam_ice )                !* read in namelist_ice namicedmp
+      READ  ( numnam_ice, namice_dmp )
+      !
+      IF ( lwp ) THEN                     !* control print
+         WRITE (numout,*)'     lim_dmp_init : lim_dmp initialization ' 
+         WRITE (numout,*)'       Namelist namicedmp read '
+         WRITE (numout,*)'         Ice restoring (T) or not (F) ln_limdmp =', ln_limdmp 
+         WRITE (numout,*)
+         WRITE (numout,*)'     CAUTION : here hard coded ice restoring along northern and southern boundaries'
+         WRITE (numout,*)'               adapt the lim_dmp_init routine to your needs'
+      ENDIF
+
+      ! 2)  initialise resto_ice    ==>  config dependant !
+      !     --------------------         ++++++++++++++++
+      !
+      IF( ln_limdmp ) THEN                !* ice restoring is used, follow initialization
+         ! 
+         sl_icedmp ( jp_hicif ) = sn_hicif
+         sl_icedmp ( jp_frld  ) = sn_frld
+         ALLOCATE ( sf_icedmp (2) , resto_ice(jpi,jpj,1), STAT=ierror )
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'lim_dmp_init: unable to allocate sf_icedmp structure or resto_ice array' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_icedmp(jp_hicif)%fnow(jpi,jpj,1) , sf_icedmp(jp_hicif)%fdta(jpi,jpj,1,2) )
+         ALLOCATE( sf_icedmp(jp_frld )%fnow(jpi,jpj,1) , sf_icedmp(jp_frld )%fdta(jpi,jpj,1,2) )
+         !                         ! fill sf_icedmp with sn_icedmp and control print
+         CALL fld_fill( sf_icedmp, sl_icedmp, cn_dir, 'lim_dmp_init', 'Ice  restoring input data', 'namicedmp' )
+      
+         resto_ice(:,:,:) = 0._wp
+         !      Re-calculate the North and South boundary restoring term
+         !      because those boundaries may change with the prescribed zoom area.
+         !
+         irelax  = 16                     ! width of buffer zone with respect to close boundary
+         zdmpmax = 10._wp                 ! max restoring time scale  (days) (low restoring)
+         zdmpmin = rdt_ice / 86400._wp    ! min restoring time scale  (days) (high restoring)
+         !                                ! days / grid-point
+         zfactor = ( zdmpmax - zdmpmin ) / REAL( irelax, wp )
+
+         !    South boundary restoring term
+         ! REM: if there is no ice in the model and in the data, 
+         !      no restoring even with non zero resto_ice
+         DO jj = mj0(jpjzoom - 1 + 1), mj1(jpjzoom -1 + irelax)
+            zreltim = zdmpmin + zfactor * ( mjg(jj) - jpjzoom + 1 )
+            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp )
+         END DO
+
+         ! North boundary restoring term
+         DO jj =  mj0(jpjzoom -1 + jpjglo - irelax), mj1(jpjzoom - 1 + jpjglo)
+            zreltim = zdmpmin + zfactor * (jpjglo - ( mjg(jj) - jpjzoom + 1 ))
+            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 )
+         END DO
+      ENDIF
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90	(revision 3437)
@@ -0,0 +1,287 @@
+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
+
+   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 .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain
+            i_j1 = 1   
+            i_jpj = jpj
+            IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
+            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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicedyn/ epsd, alpha,     &
+         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
+         &                c_rhg, etamn, creepl, ecc, ahi0,                  &
+         &                nevp, telast,alphaevp
+      !!-------------------------------------------------------------------
+
+      REWIND ( numnam_ice )                       ! Read Namelist namicedyn
+      READ   ( numnam_ice  , 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                                      creepl = ', creepl
+         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc
+         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
+         WRITE(numout,*) '       number of iterations for subcycling nevp   = ', nevp
+         WRITE(numout,*) '       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 / ( ecc * 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limhdf_2.F90	(revision 3437)
@@ -0,0 +1,161 @@
+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
+
+   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
+      IF( .NOT.lk_vopt_loop ) THEN
+         zflu (jpi,:) = 0._wp   
+         zflv (jpi,:) = 0._wp
+         zdiv0(1,  :) = 0._wp
+         zdiv0(jpi,:) = 0._wp
+      ENDIF
+
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90	(revision 3437)
@@ -0,0 +1,221 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_istate_2      ! routine called by lim_init_2.F90
+
+   !!! ** init namelist (namiceini) **
+   LOGICAL  ::   ln_limini = .FALSE.  !: Ice initialization state
+   REAL(wp) ::   ttest     = 2.0      ! threshold water temperature for initial sea ice
+   REAL(wp) ::   hninn     = 0.5      ! initial snow thickness in the north
+   REAL(wp) ::   hginn     = 3.0      ! initial ice thickness in the north
+   REAL(wp) ::   alinn     = 0.05     ! initial leads area in the north
+   REAL(wp) ::   hnins     = 0.1      ! initial snow thickness in the south
+   REAL(wp) ::   hgins     = 1.0      ! initial ice thickness in the south
+   REAL(wp) ::   alins     = 0.1      ! 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  
+         
+         tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
+
+         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( fcor(ji,jj) >= 0.e0 ) 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
+
+      NAMELIST/namiceini/ ln_limini, ttest, hninn, hginn, alinn, &
+         &                hnins, hgins, alins
+      !!-------------------------------------------------------------------
+      !
+      REWIND ( numnam_ice )               ! Read Namelist namiceini 
+      READ   ( numnam_ice , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limmsh_2.F90	(revision 3437)
@@ -0,0 +1,301 @@
+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
+
+   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
+      
+      IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   &
+          &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane' )
+
+      !----------------------------------------------------------                          
+      !    Initialization of local and some global (common) variables 
+      !------------------------------------------------------------------ 
+      
+      njeq   = INT( jpj / 2 )   !i bug mpp potentiel
+      njeqm1 = njeq - 1 
+
+      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   !  coriolis factor at T-point
+ 
+!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( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere
+         l_jeq = .TRUE.
+         njeq  = 1
+         DO WHILE ( njeq <= jpj .AND. fcor(1,njeq) < 0.e0 )
+            njeq = njeq + 1
+         END DO
+         IF(lwp ) WRITE(numout,*) '          the equator is inside the domain at about njeq = ', njeq
+      ELSEIF( fcor(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../LIM_SRC_3/limrhg.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrhg_2.F90	(revision 3437)
@@ -0,0 +1,594 @@
+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
+
+   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), 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
+      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 )
+      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
+
+
+      ! Ice mass, ice strength, and wind stress at the center            |
+      ! of the grid squares.                                             |
+      !-------------------------------------------------------------------
+
+!CDIR NOVERRCHK
+      DO jj = k_j1 , k_jpj-1
+!CDIR NOVERRCHK
+         DO ji = 1 , jpi
+            ! only the sinus changes its sign with the hemisphere
+            zsang(ji,jj)  = SIGN( 1._wp, fcor(ji,jj) ) * sangvg   ! only the sinus changes its sign with the hemisphere
+            !
+            zmasst(ji,jj) = tms(ji,jj) * ( rhosn * hsnm(ji,jj) + rhoic * hicm(ji,jj) )
+            zpresh(ji,jj) = tms(ji,jj) *  pstarh * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) )
+!!gm  :: stress given at I-point (F-point for the ocean) only compute the ponderation with the ice fraction (1-frld)
+            zi1(ji,jj)    = tms(ji,jj) * ( 1._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) &
+               &           *( fcor(ji,jj  ) * wght(ji,jj,2,2) + fcor(ji-1,jj  )*wght(ji,jj,1,2)   &
+               &            + fcor(ji,jj-1) * wght(ji,jj,2,1) + fcor(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 =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji-1,jj  ))/e1u(ji-1,jj  )   &
+               &       +  (ssh_m(ji  ,jj-1) - ssh_m(ji-1,jj-1))/e1u(ji-1,jj-1)   ) * 0.5_wp
+            zgsshy =  (   (ssh_m(ji  ,jj  ) - ssh_m(ji  ,jj-1))/e2v(ji  ,jj-1)   &
+               &       +  (ssh_m(ji-1,jj  ) - ssh_m(ji-1,jj-1))/e2v(ji-1,jj-1)   ) * 0.5_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.
+
+!CDIR NOVERRCHK
+         DO jj = k_j1, k_jpj-1
+!CDIR NOVERRCHK
+            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 ),  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    !
+            !                                                   ! ================ !
+!CDIR NOVERRCHK
+            DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+               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. )
+
+            ! 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 )
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90	(revision 3437)
@@ -0,0 +1,278 @@
+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
+      !!----------------------------------------------------------------------
+      !
+      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
+         ! 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)
+         IF(lwp) THEN
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
+            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
+            END SELECT
+            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+            ENDIF
+         ENDIF
+
+         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
+         lrst_ice = .TRUE.
+      ENDIF
+      !
+   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
+
+      IF ( jprstlib == jprstdimg ) THEN
+        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
+        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+      ENDIF
+
+      CALL iom_open ( 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90	(revision 3437)
@@ -0,0 +1,451 @@
+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
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+#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 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
+
+   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 diaar5, ONLY :   lk_diaar5
+   USE iom              ! I/O library
+   USE prtctl           ! Print control
+   USE cpl_oasis3, ONLY : lk_cpl
+
+   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   ! constant SSS and ice salinity used in levitating sea-ice case
+   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
+      !!              - emp     : freshwater budget: volume flux 
+      !!              - emps    : freshwater budget: concentration/dillution 
+      !!              - utau    : sea surface i-stress (ocean referential)
+      !!              - vtau    : sea surface j-stress (ocean referential)
+      !!              - fr_i    : ice fraction
+      !!              - tn_ice  : sea-ice surface temperature
+      !!              - alb_ice : sea-ice alberdo (lk_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, zfm            ! local scalars
+      REAL(wp) ::   zinda, zfons, zemp         !   -      -
+      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 )
+
+      !------------------------------------------!
+      !      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 
+
+!!$            zinda   = 1.0 - AINT( pfrld(ji,jj) )                   !   = 0. if pure ocean else 1. (at previous time)
+!!$
+!!$            i1mfr   = 1.0 - AINT(  frld(ji,jj) )                   !   = 0. if pure ocean else 1. (at current  time)
+!!$
+!!$            IF( phicif(ji,jj) <= 0. ) THEN   ;   ifvt = zinda      !   = 1. if (snow and no ice at previous time) else 0. ???
+!!$            ELSE                             ;   ifvt = 0.
+!!$            ENDIF
+!!$
+!!$            IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN   ;   idfr = 0.  !   = 0. if lead fraction increases from previous to current
+!!$            ELSE                                     ;   idfr = 1.   
+!!$            ENDIF
+!!$
+!!$            iflt    = zinda  * (1 - i1mfr) * (1 - ifvt )    !   = 1. if ice (not only snow) at previous and pure ocean at current
+!!$
+!!$            ial     = ifvt   * i1mfr    +    ( 1 - ifvt ) * idfr
+!!$!                 snow no ice   ice         ice or nothing  lead fraction increases
+!!$!                 at previous   now           at previous
+!!$!                -> ice aera increases  ???         -> ice aera 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 defined key_coupled 
+            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)     ! ???
+            !
+            qsr  (ji,jj) = zqsr                                          ! solar heat flux 
+            qns  (ji,jj) = zqns - fdtcn(ji,jj)                           ! non solar heat flux
+         END DO
+      END DO
+
+      CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )      
+      CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )      
+      CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) )
+
+      !------------------------------------------!
+      !      mass flux at the ocean surface      !
+      !------------------------------------------!
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+#if defined key_coupled
+            ! freshwater exchanges at the ice-atmosphere / ocean interface (coupled mode)
+            zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) )    &   ! 
+               &   + rdmsnif(ji,jj) * r1_rdtice                                   !  freshwaterflux due to snow melting 
+#else
+            !  computing freshwater exchanges at the ice/ocean interface
+            zemp = + emp(ji,jj)     *         frld(ji,jj)      &   !  e-p budget over open ocean fraction 
+               &   - tprecip(ji,jj) * ( 1. -  frld(ji,jj) )    &   !  liquid precipitation reaches directly the ocean
+               &   + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) )    &   !  change in ice cover within the time step
+               &   + rdmsnif(ji,jj) * r1_rdtice                    !  freshwater flux due to snow melting 
+#endif            
+            !
+            !  computing salt exchanges at the ice/ocean interface
+            zfons = ( soce_0(ji,jj) - sice_0(ji,jj) ) * ( rdmicif(ji,jj) * r1_rdtice ) 
+            !
+            !  converting the salt flux from ice to a freshwater flux from ocean
+            zfm  = zfons / ( sss_m(ji,jj) + epsi16 )
+            !
+            emps(ji,jj) = zemp + zfm      ! surface ocean concentration/dilution effect (use on SSS evolution)
+            emp (ji,jj) = zemp            ! surface ocean volume flux (use on sea-surface height evolution)
+            !
+         END DO
+      END DO
+
+      IF( lk_diaar5 ) THEN       ! AR5 diagnostics
+         CALL iom_put( 'isnwmlt_cea'  ,                 rdmsnif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_virt_cea',   soce_0(:,:) * rdmicif(:,:) * r1_rdtice )
+         CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdmicif(:,:) * r1_rdtice )
+      ENDIF
+
+      !-----------------------------------------------!
+      !   Coupling variables                          !
+      !-----------------------------------------------!
+
+#if defined key_coupled
+      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)
+      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=emps  , clinfo2=' emps    : ')
+         CALL prt_ctl(tab2d_1=utau  , clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
+            &         tab2d_2=vtau  , clinfo2=' vtau    : '        , mask2=vmask )
+         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)
+!CDIR NOVERRCHK
+            DO jj = 1, jpj                               !* modulus of ice-ocean relative velocity at I-point
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  zu_i  = u_ice(ji,jj) - u_oce(ji,jj)                   ! ice-ocean relative velocity at I-point
+                  zv_i  = v_ice(ji,jj) - v_oce(ji,jj)
+                  tmod_io(ji,jj) = SQRT( zu_i * zu_i + zv_i * zv_i )    ! modulus of this velocity (at I-point)
+               END DO
+            END DO
+!CDIR NOVERRCHK
+            DO jj = 1, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+!CDIR NOVERRCHK
+               DO ji = 1, jpim1   ! NO vector opt.
+                  !                                               ! modulus of U_ice-U_oce at T-point
+                  zumt  = 0.25_wp * (  tmod_io(ji+1,jj) + tmod_io(ji  ,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)
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1                          !* modulus of the ice-ocean velocity at T-point
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+                  zu_t  = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   ! 2*(U_ice-U_oce) at T-point
+                  zv_t  = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)      
+                  zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )                      ! |U_ice-U_oce|^2
+                  !                                               ! update the modulus of stress at ocean surface
+                  taum   (ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zmodt
+                  tmod_io(ji,jj) = SQRT( zmodt ) * rhoco          ! rhoco*|Uice-Uoce|
+               END DO
+            END DO
+            CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. )
+            !
+            utau_oce(:,:) = utau(:,:)                 !* save the air-ocean stresses at ice time-step
+            vtau_oce(:,:) = vtau(:,:)
+            !
+         ENDIF
+         !
+         !                                        !==  at each ocean time-step  ==!
+         !
+         DO jj = 2, jpjm1                             !* ice stress over ocean WITHOUT a ice-ocean rotation angle
+            DO ji = fs_2, fs_jpim1
+               !                                            ! ocean area at u- & v-points
+               zfrldu  = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj) )
+               zfrldv  = 0.5_wp * ( frld(ji,jj) + frld(ji,jj+1) )
+               !                                            ! quadratic drag formulation without rotation
+               !                                            ! using instantaneous surface ocean current
+               zutau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+               zvtau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+               !                                            ! update the surface ocean stress (ice-cover wheighted)
+               utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice
+               vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice
+            END DO
+         END DO
+         CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
+         !
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
+         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask )
+      !  
+      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
+      !!-------------------------------------------------------------------
+      !
+      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
+      !
+      IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea 
+         WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &
+            &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         ) 
+            soce_0(:,:) = 4._wp
+            sice_0(:,:) = 2._wp
+         END WHERE
+      ENDIF
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtab_2.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90	(revision 3437)
@@ -0,0 +1,591 @@
+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
+   USE lbclnk
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp
+   USE wrk_nemo        ! work arrays
+   USE iom             ! IOM library
+   USE ice_2           ! LIM sea-ice variables
+   USE sbc_oce         ! 
+   USE sbc_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 prtctl          ! Print control
+   USE cpl_oasis3, ONLY : lk_cpl
+   USE diaar5, ONLY :   lk_diaar5
+      
+   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.e0     !
+   REAL(wp) ::   rone   = 1.e0     !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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) ::   zfnsol               ! total non solar heat
+      REAL(wp) ::   zfontn               ! heat flux from snow thickness
+      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
+!      zdvonif(:,:) = 0.e0   ! lateral variation of 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
+      rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area
+      rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area
+      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.
+      !--------------------------------------------------------------------------
+
+      sst_m(:,:) = sst_m(:,:) + rt0
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         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) - tfu(ji,jj) ) 
+            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * frld(ji,jj) * rdt_ice
+                        
+            !  partial computation of the lead energy budget (qldif)
+#if defined key_coupled 
+            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
+            zfontn         = ( sprecip(ji,jj) / rhosn ) * xlsn  !   energy for melting solid precipitation
+            zfnsol         = qns(ji,jj)                         !  total non solar flux over the ocean
+            qldif(ji,jj)   = tms(ji,jj) * ( qsr(ji,jj) * ( 1.0 - thcm(ji,jj) )   &
+               &                               + zfnsol + fdtcn(ji,jj) - zfontn     &
+               &                               + ( 1.0 - zindb ) * fsbbq(ji,jj) )   &
+               &                        * frld(ji,jj) * rdt_ice    
+!!$            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) - zfontn     &
+!!$               &             + ( 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 * fse3t_m(ji,jj,1)   &
+                &          * ( tfu(ji,jj) - sst_m(ji,jj) ) * ( 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
+      
+      sst_m(:,:) = sst_m(:,:) - rt0
+               
+      !         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. lk_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, rdmicif_1d (1:nbpb)     , rdmicif    , 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, 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, rdmicif    , npb, rdmicif_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, rdmsnif    , npb, rdmsnif_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. lk_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( fcor(1,1) < 0.e0 ) 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(:,:) = rdmicif(:,:)		! 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, rdmicif_1d(1:nbpac)     , rdmicif    , 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, rdmicif    , npac(1:nbpac), rdmicif_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
+      CALL iom_put( 'ioceflxb', fbif )                           ! Oceanic flux at the ice base           [W/m2 ???]
+      CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) )   ! Ice surface temperature                [Celius]
+      CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) )   ! Solar flux over the ice                [W/m2]
+      CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) )   ! Non-solar flux over the ice            [W/m2]
+      IF( .NOT. lk_cpl )   CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) )     ! Latent flux over the ice  [W/m2]
+      !
+      CALL iom_put( 'snowthic_cea', hsnif  (:,:) * fr_i(:,:) )   ! Snow thickness             [m]
+      CALL iom_put( 'icethic_cea' , hicif  (:,:) * fr_i(:,:) )   ! Ice thickness              [m]
+      zztmp = 1.0 / rdt_ice
+      CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp     )   ! Ice produced               [m/s]
+      IF( lk_diaar5 ) THEN
+         CALL iom_put( 'snowmel_cea' , rdmsnif(:,:) * zztmp     )   ! Snow melt                  [kg/m2/s]
+         zztmp = rhoic / rdt_ice
+         CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp     )   ! Snow to Ice transformation [kg/m2/s]
+         CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp     )   ! Melt at Sea Ice top        [kg/m2/s]
+         CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp     )   ! Melt at Sea Ice bottom     [kg/m2/s]
+         zlicegr(:,:) = MAX( 0.e0, rdmicif(:,:)-zlicegr(:,:) )
+         CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp     )   ! Latereal sea ice growth    [kg/m2/s]
+      ENDIF
+      !
+      ! Compute the Eastward & Northward sea-ice transport
+      zztmp = 0.25 * rhoic
+      DO jj = 1, jpjm1 
+         DO ji = 1, jpim1   ! NO vector opt.
+            ! Ice velocities, volume & transport at U & V-points
+            zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj )
+            zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1)
+            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  )
+            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)
+            zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 
+            zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 
+         END DO
+      END DO
+      CALL lbc_lnk( zu_imasstr, 'U', -1. )   ;   CALL lbc_lnk( zv_imasstr, 'V', -1. )
+      CALL iom_put( 'u_imasstr',  zu_imasstr(:,:) )   ! Ice transport along i-axis at U-point [kg/s] 
+      CALL iom_put( 'v_imasstr',  zv_imasstr(:,:) )   ! Ice transport along j-axis at V-point [kg/s] 
+
+      !! Fram Strait sea-ice transport (sea-ice + snow)  (in ORCA2 = 5 points)
+      IF( cp_cfg == "orca" .AND. jp_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
+
+!! 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
+      !
+      CALL iom_put( 'ice_pres'  , ztmp                            )   ! Ice presence                          [-]
+      CALL iom_put( 'ist_ipa'   , ( sist(:,:) - rt0 ) * ztmp(:,:) )   ! Ice surface temperature               [Celius]
+      CALL iom_put( 'uice_ipa'  ,  u_ice(:,:)         * ztmp(:,:) )   ! Ice velocity along i-axis at I-point  [m/s] 
+      CALL iom_put( 'vice_ipa'  ,  v_ice(:,:)         * ztmp(:,:) )   ! Ice velocity along j-axis at I-point  [m/s]
+
+      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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicethd/ hmelt , hiccrit, hicmin, hiclim, amax  ,        &
+         &                swiqst, sbeta  , parlat, hakspl, hibspl, exld,  &
+         &                hakdif, hnzst  , thth  , parsub, alphs
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice )                  ! read namelist
+      READ  ( numnam_ice , namicethd )
+      IF( lk_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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_lac_2.F90	(revision 3437)
@@ -0,0 +1,235 @@
+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
+
+   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
+      !---------------------------------------------------------------------
+      
+!CDIR NOVERRCHK
+      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)
+         rdmicif_1d(ji) = rdmicif_1d(ji) + rhoic * dvlbq_1d(ji)
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limthd_zdf_2.F90	(revision 3437)
@@ -0,0 +1,782 @@
+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 in_out_manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE cpl_oasis3, ONLY : lk_cpl
+      
+   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 ! tempory 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  &       ! tempory scalars used to solve the tri-diagonal system
+          , zb2 , zd2 , zb3 , zd3 &
+          , 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  &  ! tempory 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, zc2, zpc2, zp1, zp2 & ! tempory variables
+          , ztb2, ztb3
+       REAL(wp) :: & 
+          zdrmh         &   ! change in snow/ice thick. after snow-ice formation
+          , zhicnew       &   ! new ice thickness
+          , zhsnnew       &   ! new snow thickness
+          , zquot , ztneq &   ! tempory temp. variables
+          , zqice, zqicetot & ! total heat inside the snow/ice system
+          , zdfrl         &   ! change in ice concentration
+          , zdvsnvol      &   ! change in snow volume
+          , zdrfrl1, zdrfrl2 &  ! tempory scalars
+          , zihsn, zidhb, zihic, zihe, zihq, ziexp, ziqf, zihnf, zibmlt, ziqr, zihgnew, zind
+       !!----------------------------------------------------------------------
+       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
+          zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
+          zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
+          !--computation of energy due to surface melting
+          zqcmlts(ji) = ( MAX ( zzero ,  &
+             &                   rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
+          !--computation of energy due to bottom melting
+          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. lk_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) )
+          rdmsnif_1d(ji) =  rhosn * dvsbq_1d(ji)
+          !-- 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
+          rdmicif_1d(ji) =  rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
+          !---updating new snow thickness and computing the newly formed snow mass
+          zhsnfi   = zhsn + zdhsnm
+          h_snow_1d(ji) = MAX( zzero , zhsnfi )
+          rdmsnif_1d(ji) =  rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
+          !--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
+       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)
+          rdmicif_1d(ji) = rdmicif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhicnew - h_ice_1d (ji) ) * rhoic
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + ( 1.0 - frld_1d(ji) )   * ( zhsnnew - h_snow_1d(ji) ) * rhosn
+
+          !---  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)
+          rdmicif_1d(ji) = rdmicif_1d(ji) + dvlbq_1d(ji) * rhoic
+          !--variation of snow volume and snow mass 
+          zdvsnvol    = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
+          rdmsnif_1d(ji) = rdmsnif_1d(ji) + zdvsnvol * rhosn
+          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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limtrp_2.F90	(revision 3437)
@@ -0,0 +1,311 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_trp_2   ! called by sbc_ice_lim_2
+
+   REAL(wp), PUBLIC ::   bound  = 0.e0          !: boundary condit. (0.0 no-slip, 1.0 free-slip)
+
+   REAL(wp)  ::   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)
+
+      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.e0, SIGN( 1.e0, fcor(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
+      !
+      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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicetrp/ bound
+      !!-------------------------------------------------------------------
+      !
+      REWIND ( numnam_ice )      ! Read Namelist namicetrp
+      READ   ( numnam_ice  , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90	(revision 3437)
@@ -0,0 +1,361 @@
+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
+
+   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
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                                    Direct Access file
+   !!----------------------------------------------------------------------
+# include "limwri_dimg_2.h90"
+# else
+   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 = 40)  ::   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 = 1 , 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)
+            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
+            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) = - emps(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
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
+            END DO
+         END DO
+         
+         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
+            CALL lbc_lnk( zfield, 'T', -1. )
+         ELSE 
+            CALL lbc_lnk( zfield, 'T',  1. )
+         ENDIF
+         
+         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
+     
+# endif
+
+   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      ! ???
+      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 )                ! Read Namelist namicewri
+      READ   ( numnam_ice  , 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, "ioceflxb", "flux at ice base"        , "w/m2"   , 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, "ioceflxb", kt, fbif           , 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90	(revision 3437)
@@ -0,0 +1,203 @@
+    SUBROUTINE lim_wri_2(kt)
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+    !!-------------------------------------------------------------------
+    !!  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
+    !!-------------------------------------------------------------------
+    USE  diadimg                ! use of dia_wri_dimg
+
+    INTEGER, INTENT(in) ::   kt     ! number of iteration
+
+    INTEGER , SAVE ::   nmoyice   !: counter for averaging
+    INTEGER , SAVE ::   nwf       !: number of fields to write on disk
+    INTEGER , SAVE, DIMENSION(:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
+    INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE :: rcmoy
+
+    INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
+    INTEGER :: iyear, iday, imon ! 
+    INTEGER :: ialloc
+    CHARACTER(LEN=80) :: clname, cltext, clmode
+    REAL(wp), DIMENSION(1) ::   zdept
+    REAL(wp) ::   zsto, zsec, zjulian,zout
+    REAL(wp) ::   zindh,zinda,zindb, ztmu
+    REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo   !ARPDBGWORK
+    REAL(wp), DIMENSION(jpi,jpj)          ::   zfield
+
+#if ! defined key_diainstant
+    LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable 
+#else
+    LOGICAL, PARAMETER :: ll_dia_inst=.true.
+#endif
+    !!-------------------------------------------------------------------
+    IF( .NOT. ALLOCATED(rcmoy) )THEN
+        ALLOCATE(rcmoy(jpi,jpj,jpnoumax),  STAT=ialloc )
+       !
+       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
+       IF( ialloc /= 0 )   CALL ctl_warn('lim_wri_2 (limwri_dimg_2.h90) : failed to allocate arrays')
+       rcmoy(:,:,:) = 0._wp
+    ENDIF
+
+    IF( kt == nit000 ) THEN 
+       !
+       CALL lim_wri_init_2 
+
+       nwf = 0 
+       ii  = 0
+
+       IF(lwp ) THEN
+          WRITE(numout,*) 'lim_wri_2 : Write ice outputs in dimg'
+          WRITE(numout,*) '~~~~~~~~'
+          WRITE(numout,*) '   According to namelist_ice, following fields saved:'
+          DO jf =1, noumef
+             IF (nc(jf) == 1 ) THEN
+                WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
+             ENDIF
+          END DO
+       ENDIF
+
+       DO jf = 1, noumef
+          IF (nc(jf) == 1 ) nwf = nwf + 1
+       END DO
+
+       ALLOCATE( nsubindex (nwf) )
+
+       DO jf = 1, noumef
+          IF (nc(jf) == 1 ) THEN 
+             ii = ii +1 
+             nsubindex(ii) = jf
+          END IF
+       END DO
+
+       zsto     = rdt_ice
+       zout     = nwrite * rdt_ice / nn_fsbc
+       zsec     = 0.
+       niter    = 0
+       zdept(1) = 0.
+       nmoyice  = 0
+
+    ENDIF
+
+#if ! defined key_diainstant 
+    !-- calculs des valeurs instantanees
+
+    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)
+          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
+          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) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+          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
+    ! Cumulates values between outputs           
+    rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
+    nmoyice = nmoyice + 1 
+    ! compute mean value if it is time to write on file
+    IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
+       rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
+#else  
+       IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN 
+          !  case of instantaneaous output rcmoy(:,:, 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) ) )
+                rcmoy(ji,jj,1)  = hsnif (ji,jj)
+                rcmoy(ji,jj,2)  = hicif (ji,jj)
+                rcmoy(ji,jj,3)  = hicifp(ji,jj)
+                rcmoy(ji,jj,4)  = frld  (ji,jj)
+                rcmoy(ji,jj,5)  = sist  (ji,jj)
+                rcmoy(ji,jj,6)  = fbif  (ji,jj)
+                rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                   &                       + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                     / ztmu
+
+                rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                   &                       + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                     / ztmu
+                rcmoy(ji,jj,9)  = sst_m(ji,jj)
+                rcmoy(ji,jj,10) = sss_m(ji,jj)
+
+                rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
+                rcmoy(ji,jj,12) = qsr(ji,jj)
+                rcmoy(ji,jj,13) = qns(ji,jj)
+                ! See thersf for the coefficient
+                rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+                rcmoy(ji,jj,15) = utau_ice(ji,jj)
+                rcmoy(ji,jj,16) = vtau_ice(ji,jj)
+                rcmoy(ji,jj,17) = qsr_ice(ji,jj,1)
+                rcmoy(ji,jj,18) = qns_ice(ji,jj,1)
+                rcmoy(ji,jj,19) = sprecip(ji,jj)
+             END DO
+          END DO
+#endif
+
+          !
+          niter = niter + 1
+          DO jf = 1 , noumef
+             zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
+
+             IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
+                CALL lbc_lnk( zfield, 'T', -1. )
+             ELSE 
+                CALL lbc_lnk( zfield, 'T',  1. )
+             ENDIF
+             rcmoy(:,:,jf) = zfield(:,:)
+          END DO
+
+          IF (ll_dia_inst) THEN
+           clmode='instantaneous'
+          ELSE
+           WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
+          END IF
+          iyear = ndastp/10000
+          imon = (ndastp-iyear*10000)/100
+          iday = ndastp - imon*100 - iyear*10000
+          WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
+          cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
+          CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
+9000      FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+
+          rcmoy(:,:,:) = 0.0
+          nmoyice = 0 
+       END IF     !  MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) !
+
+     END SUBROUTINE lim_wri_2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/par_ice_2.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_2/thd_ice_2.F90	(revision 3437)
@@ -0,0 +1,125 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC thd_ice_alloc_2 ! Routine called by nemogcm.F90
+
+   !! * Share Module variables
+   REAL(wp) , PUBLIC ::   & !!! ** ice-thermo namelist (namicethd) **
+      hmelt   = -0.15  ,  &  !: maximum melting at the bottom
+      hicmin  = 0.2    ,  &  !: ice th. corr. to max. ener. in brine pocket
+      hiclim  = 0.05   ,  &  !: minimum ice thickness
+      amax    = 0.999  ,  &  !: maximum lead fraction
+      swiqst  = 1.0    ,  &  !: energy stored in brine pocket (1) or not (0)
+      sbeta   = 1.0    ,  &  !: numerical scheme for diffusion in ice 
+      parlat  = 0.0    ,  &  !: percent. of energy used for lateral ablation
+      hakspl  = 0.5    ,  &  !: slope of distr. for Hakkinen-Mellro's lat. melt
+      hibspl  = 0.5    ,  &  !: slope of distribution for Hibler's lat. melt
+      exld    = 2.0    ,  &  !: exponent for leads-closure rate
+      hakdif  = 1.0    ,  &  !: coefficient for diffusions of ice and snow
+      thth    = 0.2    ,  &  !: thick. for comp. of eq. thermal conduct
+      hnzst   = 0.1    ,  &  !: thick. of the surf. layer in temp. comp.
+      parsub  = 1.0    ,  &  !: switch for snow sublimation or not
+      alphs   = 1.0          !: coef. for snow density when snow-ice formation
+
+   REAL(wp), PUBLIC, DIMENSION(2)  ::  &  !:   
+      hiccrit = (/0.3,0.3/)  !: 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
+      rdmicif_1d  ,     &  !:    "                  "      rdmicif
+      rdmsnif_1d  ,     &  !:    "                  "      rdmsnif
+      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(4)
+      !!----------------------------------------------------------------------
+      !
+      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( rdmicif_1d(jpij), rdmsnif_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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/dom_ice.F90	(revision 3437)
@@ -0,0 +1,57 @@
+MODULE dom_ice
+   !!======================================================================
+   !!                   ***  MODULE  dom_ice  ***
+   !! LIM-3 Sea Ice :   Domain  variables
+   !!======================================================================
+   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3 original code
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+   USE par_ice        ! LIM-3 parameter
+   USE in_out_manager ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dom_ice_alloc   ! Routine called by 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
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcor       !: coriolis coefficient
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   covrai     !: sine of geographic latitude
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   area       !: surface of grid cell 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tms, tmi   !: temperature mask, mask for stress
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmu, tmv   !: mask at u and v velocity points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmf        !: mask at f-point
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   wght   !: weight of the 4 neighbours to compute averages
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION dom_ice_alloc()
+      !!-------------------------------------------------------------------
+      !!            *** Routine dom_ice_alloc ***
+      !!-------------------------------------------------------------------
+      INTEGER :: dom_ice_alloc
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( fcor(jpi,jpj)                   ,      &
+         &      covrai(jpi,jpj) , area(jpi,jpj) ,      &
+         &      tms   (jpi,jpj) , tmi (jpi,jpj) ,      &
+         &      tmu   (jpi,jpj) , tmv (jpi,jpj) ,      &
+         &      tmf   (jpi,jpj) ,                      &
+         &      wght(jpi,jpj,2,2)               , STAT = dom_ice_alloc )
+      !
+      IF( dom_ice_alloc /= 0 )   CALL ctl_warn( 'dom_ice_alloc: failed to allocate arrays.' )
+      !
+   END FUNCTION dom_ice_alloc
+
+   !!======================================================================
+END MODULE dom_ice
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/ice.F90	(revision 3437)
@@ -0,0 +1,540 @@
+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' :                                   LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   USE par_ice          ! LIM sea-ice parameters
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    ice_alloc  !  Called in iceini.F90
+
+   !!======================================================================
+   !! 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_b       |    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                 | 10^9 J| 
+   !!      -      ! q_i_b       !    Ice enthalpy per unit vol.   | J/m3  | 
+   !! e_s         !      -      !    Snow enthalpy                | 10^9 J| 
+   !!      -      ! q_s_b       !    Snow enthalpy per unit vol.  | J/m3  | 
+   !!                                                                     |
+   !!-------------|-------------|---------------------------------|-------|
+   !!                                                                     |
+   !! ** Equivalent variables                                             |
+   !!-------------|-------------|---------------------------------|-------|
+   !!                                                                     |
+   !! ht_i        | ht_i_b      |    Ice thickness                | m     |
+   !! ht_s        ! ht_s_b      |    Snow depth                   | m     |
+   !! sm_i        ! sm_i_b      |    Sea ice bulk salinity        ! ppt   |
+   !! s_i         ! s_i_b       |    Sea ice salinity profile     ! ppt   |
+   !! o_i         !      -      |    Sea ice Age                  ! days  |
+   !! t_i         ! t_i_b       |    Sea ice temperature          ! K     |
+   !! t_s         ! t_s_b       |    Snow temperature             ! K     |
+   !! t_su        ! t_su_b      |    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_b      |    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     |
+   !! ot_i        !      -      !    Sea ice areal age content    | day   |
+   !! et_i        !      -      !    Total ice enthalpy           | 10^9 J| 
+   !! et_s        !      -      !    Total snow enthalpy          | 10^9 J| 
+   !! bv_i        !      -      !    Mean relative brine volume   | ???   | 
+   !!=====================================================================
+
+   LOGICAL, PUBLIC ::   con_i = .false.   ! switch for conservation test
+
+   !!--------------------------------------------------------------------------
+   !! * Share Module variables
+   !!--------------------------------------------------------------------------
+   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
+
+   !                                          !!** ice-dynamic namelist (namicedyn) **
+   INTEGER , PUBLIC ::   nbiter = 1            !: number of sub-time steps for relaxation
+   INTEGER , PUBLIC ::   nbitdr = 250          !: maximum number of iterations for relaxation
+   INTEGER , PUBLIC ::   nevp   = 400          !: number of iterations for subcycling
+   INTEGER , PUBLIC ::   nlay_i = 5            !: number of layers in the ice
+
+   !                                          !!** ice-dynamic namelist (namicedyn) **
+   REAL(wp), PUBLIC ::   epsd   = 1.0e-20_wp   !: tolerance parameter for dynamic
+   REAL(wp), PUBLIC ::   alpha  = 0.5_wp       !: coefficient for semi-implicit coriolis
+   REAL(wp), PUBLIC ::   dm     = 0.6e+03_wp   !: diffusion constant for dynamics
+   REAL(wp), PUBLIC ::   om     = 0.5_wp       !: relaxation constant
+   REAL(wp), PUBLIC ::   resl   = 5.0e-05_wp   !: maximum value for the residual of relaxation
+   REAL(wp), PUBLIC ::   cw     = 5.0e-03_wp   !: drag coefficient for oceanic stress
+   REAL(wp), PUBLIC ::   angvg  = 0._wp        !: turning angle for oceanic stress
+   REAL(wp), PUBLIC ::   pstar  = 1.0e+04_wp   !: determines ice strength (N/M), Hibler JPO79
+   REAL(wp), PUBLIC ::   c_rhg  = 20._wp       !: determines changes in ice strength
+   REAL(wp), PUBLIC ::   etamn  = 0.0e+07_wp   !: minimun value for viscosity : has to be 0
+   REAL(wp), PUBLIC ::   creepl = 2.0e-08_wp   !: creep limit : has to be under 1.0e-9
+   REAL(wp), PUBLIC ::   ecc    = 2._wp        !: eccentricity of the elliptical yield curve
+   REAL(wp), PUBLIC ::   ahi0   = 350._wp      !: sea-ice hor. eddy diffusivity coeff. (m2/s)
+   REAL(wp), PUBLIC ::   telast = 2880._wp     !: timescale for elastic waves (s) !SB
+   REAL(wp), PUBLIC ::   alphaevp = 1._wp      !: coeficient of the internal stresses !SB
+   REAL(wp), PUBLIC ::   unit_fac = 1.e+09_wp  !: conversion factor for ice / snow enthalpy
+
+   !                                              !!** ice-salinity namelist (namicesal) **
+   REAL(wp), PUBLIC ::   s_i_max  = 20.0_wp        !: maximum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   s_i_min  =  0.1_wp        !: minimum ice salinity [PSU]
+   REAL(wp), PUBLIC ::   s_i_0    =  3.5_wp        !: 1st sal. value for the computation of sal .prof. [PSU]
+   REAL(wp), PUBLIC ::   s_i_1    =  4.5_wp        !: 2nd sal. value for the computation of sal .prof. [PSU]
+   REAL(wp), PUBLIC ::   sal_G    =  5.0_wp        !: restoring salinity for gravity drainage [PSU]
+   REAL(wp), PUBLIC ::   sal_F    =  2.5_wp        !: restoring salinity for flushing [PSU]
+   REAL(wp), PUBLIC ::   time_G   =  1.728e+06_wp  !: restoring time constant for gravity drainage (= 20 days) [s]
+   REAL(wp), PUBLIC ::   time_F   =  8.640e+05_wp  !: restoring time constant for gravity drainage (= 10 days) [s]
+   REAL(wp), PUBLIC ::   bulk_sal =  4.0_wp        !: bulk salinity (ppt) in case of constant salinity
+
+   !                                              !!** ice-salinity namelist (namicesal) **
+   INTEGER , PUBLIC ::   num_sal     = 1           !: salinity configuration used in the model
+   !                                               ! 1 - s constant in space and time
+   !                                               ! 2 - prognostic salinity (s(z,t))
+   !                                               ! 3 - salinity profile, constant in time
+   !                                               ! 4 - salinity variations affect only ice thermodynamics
+   INTEGER , PUBLIC ::   sal_prof    = 1           !: salinity profile or not 
+   INTEGER , PUBLIC ::   thcon_i_swi = 1           !: thermal conductivity: =1 Untersteiner (1964) ; =2 Pringle et al (2007)
+
+   !                                              !!** ice-mechanical redistribution namelist (namiceitdme)
+   REAL(wp), PUBLIC ::   Cs        = 0.25_wp       !: fraction of shearing energy contributing to ridging            
+   REAL(wp), PUBLIC ::   Cf        = 17.0_wp       !: ratio of ridging work to PE loss
+   REAL(wp), PUBLIC ::   fsnowrdg  = 0.5_wp        !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   fsnowrft  = 0.5_wp        !: fractional snow loss to the ocean during ridging
+   REAL(wp), PUBLIC ::   Gstar     = 0.15_wp       !: fractional area of young ice contributing to ridging
+   REAL(wp), PUBLIC ::   astar     = 0.05_wp       !: equivalent of G* for an exponential participation function
+   REAL(wp), PUBLIC ::   Hstar     = 100.0_wp      !: thickness that determines the maximal thickness of ridged ice
+   REAL(wp), PUBLIC ::   hparmeter = 0.75_wp       !: threshold thickness (m) for rafting / ridging 
+   REAL(wp), PUBLIC ::   Craft     = 5.0_wp        !: coefficient for smoothness of the hyperbolic tangent in rafting
+   REAL(wp), PUBLIC ::   ridge_por = 0.0_wp        !: initial porosity of ridges (0.3 regular value)
+   REAL(wp), PUBLIC ::   sal_max_ridge = 15.0_wp   !: maximum ridged ice salinity (ppt)
+   REAL(wp), PUBLIC ::   betas    = 1.0_wp         !: coef. for partitioning of snowfall between leads and sea ice
+   REAL(wp), PUBLIC ::   kappa_i  = 1.0_wp         !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m]
+   REAL(wp), PUBLIC ::   nconv_i_thd = 50_wp       !: maximal number of iterations for heat diffusion
+   REAL(wp), PUBLIC ::   maxer_i_thd = 1.0e-4_wp   !: maximal tolerated error (C) for heat diffusion
+
+   !                                              !!** ice-mechanical redistribution namelist (namiceitdme)
+   INTEGER , PUBLIC ::   ridge_scheme_swi = 0      !: scheme used for ice ridging
+   INTEGER , PUBLIC ::   raftswi          = 1      !: rafting of ice or not                        
+   INTEGER , PUBLIC ::   partfun_swi      = 1      !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007)
+   INTEGER , PUBLIC ::   transfun_swi     = 0      !: transfer function: =0 Hibler 1980, =1 Lipscomb et al. 2007
+   INTEGER , PUBLIC ::   brinstren_swi    = 0      !: use brine volume to diminish ice strength
+
+   REAL(wp), PUBLIC ::   usecc2           !:  = 1.0 / ( ecc * ecc )
+   REAL(wp), PUBLIC ::   rhoco            !: = rau0 * cw
+   REAL(wp), PUBLIC ::   sangvg, cangvg   !: sin and cos of the turning angle for ocean stress
+   REAL(wp), PUBLIC ::   pstarh           !: pstar / 2.0
+
+   REAL(wp), PUBLIC, 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(:,:) ::   pahu , pahv    !: ice hor. eddy diffusivity coef. at U- and V-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ust2s, hicol   !: friction velocity, ice collection thickness accreted in leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   strp1, strp2   !: strength at previous time steps
+   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(:,:) ::   firic       !: IR flux over the ice (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fcsic       !: Sensible heat flux over the ice (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fleic       !: Latent heat flux over the ice (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qlatic      !: latent flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvosif     !: Variation of volume at surface (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvobif     !: Variation of ice volume at the bottom ice (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fdvolif     !: Total variation of ice volume (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdvonif     !: Lateral Variation of ice volume (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sist        !: Average Sea-Ice Surface Temperature [Kelvin]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   icethi      !: total ice thickness (for all categories) (diag only)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_bo        !: Sea-Ice bottom temperature [Kelvin]     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hicifp      !: Ice production/melting==>!obsolete... can be removed
+   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(:,:) ::   fbif        !: Heat flux at the ice base
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmsnif     !: Variation of snow mass
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rdmicif     !: Variation of ice mass
+   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 bring the ocean to freezing 
+   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
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fstric      !: transmitted solar radiation under ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fscmbq      !: associated with lead chipotage with solar flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ffltbif     !: related to max heat contained in brine pockets (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbbq       !: Also linked with the solar flux below the ice (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qfvbq       !: store energy in case of total lateral ablation (?)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dmgwi       !: Variation of the mass of snow ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsalt_res   !: Residual salt flux due to correction of ice thickness
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsbri       !: Salt flux due to brine rejection
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fsalt_rpo   !: Salt flux associated with porous ridged ice formation
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_rpo   !: Heat flux associated with porous ridged ice formation
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhbri       !: heat flux due to brine rejection
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmec       !: Mass flux due to snow loss during compression
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fseqv       !: Equivalent salt flux due to ice growth/melt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fhmec       !: Heat flux due to snow loss during compression
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fheat_res   !: Residual heat flux due to correction of ice thickness
+
+   ! temporary arrays for dummy version of the code
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dh_i_surf2D, dh_i_bott2D, fstbif, fsup2D, focea2D, q_s
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   patho_case ! number of the pathological case (if any, of course)
+
+   !!--------------------------------------------------------------------------
+   !! * 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(:,:,:) ::   ov_i    !: Sea-Ice Age times volume per area (days.m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   oa_i    !: Sea-Ice Age times ice area (days)
+
+   !! 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(:,:) ::   tio_u, tio_v   !: components of the ice-ocean stress (N/m2)
+   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(:,:) ::   ot_i           !: mean age over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tm_i           !: mean ice temperature over all categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bv_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(:,:,:) ::   at_i_typ     !: total area   contained in each ice type [m^2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   vt_i_typ     !: total volume contained in each ice type [m^3]
+
+   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(:,:,:)   ::   e_i_cat    !: ! go to trash
+      
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   t_i        !: ice temperatures          [K]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e_i        !: ice thermal contents [Giga J]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   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(:,:,:)   ::   old_v_s, old_v_i               !: snow and ice volumes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   old_a_i, old_smv_i, old_oa_i   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_s                        !: snow heat content
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   old_e_i                        !: ice temperatures
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   old_u_ice, old_v_ice           !: ice velocity (gv6 and gv7)
+      
+
+   !!--------------------------------------------------------------------------
+   !! * Increment of global variables
+   !!--------------------------------------------------------------------------
+   ! thd refers to changes induced by thermodynamics
+   ! trp   ''         ''     ''       advection (transport of ice)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_a_i_thd  , d_a_i_trp                 !: icefractions                  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_s_thd  , d_v_s_trp                 !: snow volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_v_i_thd  , d_v_i_trp                 !: ice  volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_smv_i_thd, d_smv_i_trp               !:     
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_fl  , d_sm_i_gd                 !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_sm_i_se  , d_sm_i_si  , d_sm_i_la    !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   d_oa_i_thd , d_oa_i_trp , s_i_newice   !:
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_s_thd  , d_e_s_trp     !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   d_e_i_thd  , d_e_i_trp     !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   d_u_ice_dyn, d_v_ice_dyn   !: ice velocity 
+      
+   !!--------------------------------------------------------------------------
+   !! * Ice thickness distribution variables
+   !!--------------------------------------------------------------------------
+   ! REMOVE
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_types      !: Vector connecting types and categories
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ice_cat_bounds !: Matrix containing the integer upper and 
+   !                                                                       !  lower boundaries of ice thickness categories
+   ! REMOVE
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   ice_ncat_types !: nb of thickness categories in each ice type
+   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 
+   ! REMOVE
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hi_max_typ     !: Boundary of ice thickness categories in thickness space
+
+   !!--------------------------------------------------------------------------
+   !! * Ice Run
+   !!--------------------------------------------------------------------------
+   !                                                                     !!: ** Namelist namicerun read in iceini **
+   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_in  = "restart_ice_in"   !: suffix of ice restart name (input)
+   CHARACTER(len=32)     , PUBLIC ::   cn_icerst_out = "restart_ice"      !: suffix of ice restart name (output)
+   LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F)
+   LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag for sea-ice points output (T) or not (F)
+   REAL(wp)              , PUBLIC ::   hsndif        = 0.e0               !: computation of temp. in snow (0) or not (9999)
+   REAL(wp)              , PUBLIC ::   hicdif        = 0.e0               !: computation of temp. in ice (0) or not (9999)
+   REAL(wp)              , PUBLIC ::   cai           = 1.40e-3            !: atmospheric drag over sea ice
+   REAL(wp)              , PUBLIC ::   cao           = 1.00e-3            !: atmospheric drag over ocean
+   REAL(wp), DIMENSION(2), PUBLIC ::   acrit  = (/ 1.e-06 , 1.e-06 /)     !: minimum fraction for leads in
+   !                                                                      !: north and south hemisphere
+   !!--------------------------------------------------------------------------
+   !! * Ice diagnostics
+   !!--------------------------------------------------------------------------
+   !! Check if everything down here is necessary
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   v_newice   !: volume of ice formed in the leads
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dv_dt_thd  !: thermodynamic growth rates 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   izero, fstroc, fhbricat
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sni_gr   ! snow ice growth 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_lat_gr   ! lateral ice growth 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_gr   ! bottom ice growth 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_dyn_gr   ! dynamical ice growth 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_bot_me   ! vertical bottom melt 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   diag_sur_me   ! vertical surface melt
+   INTEGER , PUBLIC ::   jiindx, jjindx        !: indexes of the debugging point
+
+   !!----------------------------------------------------------------------
+   !! 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_2 ***
+      !!-----------------------------------------------------------------
+      INTEGER :: ice_alloc
+      !
+      INTEGER :: ierr(20), 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) ,                           &
+         &      pahu     (jpi,jpj) , pahv     (jpi,jpj) ,                           &
+         &      ust2s    (jpi,jpj) , hicol    (jpi,jpj) ,                           &
+         &      strp1    (jpi,jpj) , strp2    (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( firic    (jpi,jpj) , fcsic  (jpi,jpj) , fleic    (jpi,jpj) , qlatic   (jpi,jpj) ,     &
+         &      rdvosif  (jpi,jpj) , rdvobif(jpi,jpj) , fdvolif  (jpi,jpj) , rdvonif  (jpi,jpj) ,     &
+         &      sist     (jpi,jpj) , icethi (jpi,jpj) , t_bo     (jpi,jpj) , hicifp   (jpi,jpj) ,     &
+         &      frld     (jpi,jpj) , pfrld  (jpi,jpj) , phicif   (jpi,jpj) , fbif     (jpi,jpj) ,     &
+         &      rdmsnif  (jpi,jpj) , rdmicif(jpi,jpj) , qldif    (jpi,jpj) , qcmif    (jpi,jpj) ,     &
+         &      fdtcn    (jpi,jpj) , qdtcn  (jpi,jpj) , fstric   (jpi,jpj) , fscmbq   (jpi,jpj) ,     &
+         &      ffltbif  (jpi,jpj) , fsbbq  (jpi,jpj) , qfvbq    (jpi,jpj) , dmgwi    (jpi,jpj) ,     &
+         &      fsalt_res(jpi,jpj) , fsbri  (jpi,jpj) , fsalt_rpo(jpi,jpj) , fheat_rpo(jpi,jpj) ,     &
+         &      fhbri    (jpi,jpj) , fmmec  (jpi,jpj) , fseqv    (jpi,jpj) , fhmec    (jpi,jpj) ,     &
+         &      fheat_res(jpi,jpj)                                                              , STAT=ierr(ii) )
+
+      ii = ii + 1
+      ALLOCATE( dh_i_surf2D(jpi,jpj) , dh_i_bott2D(jpi,jpj) , fstbif(jpi,jpj) ,     &
+         &      fsup2D     (jpi,jpj) , focea2D    (jpi,jpj) , q_s   (jpi,jpj) , STAT=ierr(ii) )
+
+      ii = ii + 1
+      ALLOCATE( patho_case(jpi, jpj, jpl)  , STAT=ierr(ii) )
+
+      ! * Ice global state variables
+      ii = ii + 1
+      ALLOCATE( 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) ,     &
+         &      ov_i (jpi,jpj,jpl) , oa_i (jpi,jpj,jpl)                      , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) , tio_u(jpi,jpj) , tio_v(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) , ot_i (jpi,jpj) , tm_i (jpi,jpj) ,     &
+         &      bv_i (jpi,jpj) , smt_i(jpi,jpj)                                   , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , at_i_typ(jpi,jpj,jpm) ,                            &
+         &      e_s(jpi,jpj,nlay_s,jpl) , vt_i_typ(jpi,jpj,jpm) , e_i_cat(jpi,jpj,jpl) , STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( t_i(jpi,jpj,jkmax,jpl) , e_i(jpi,jpj,jkmax,jpl) , s_i(jpi,jpj,jkmax,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,jkmax,jpl) , sye (jpi,jpj,jkmax,jpl) , sxxe(jpi,jpj,jkmax,jpl) ,     &
+         &      syye(jpi,jpj,jkmax,jpl) , sxye(jpi,jpj,jkmax,jpl)                           , STAT=ierr(ii) )
+
+      ! * Old values of global variables
+      ii = ii + 1
+      ALLOCATE( old_v_s  (jpi,jpj,jpl) , old_v_i  (jpi,jpj,jpl) , old_e_s(jpi,jpj,nlay_s,jpl) ,     &
+         &      old_a_i  (jpi,jpj,jpl) , old_smv_i(jpi,jpj,jpl) , old_e_i(jpi,jpj,jkmax ,jpl) ,     &
+         &      old_oa_i (jpi,jpj,jpl)                                                        ,     &
+         &      old_u_ice(jpi,jpj)     , old_v_ice(jpi,jpj)                                   , STAT=ierr(ii) )
+
+      ! * Increment of global variables
+      ii = ii + 1
+      ALLOCATE( d_a_i_thd(jpi,jpj,jpl) , d_a_i_trp (jpi,jpj,jpl) , d_v_s_thd  (jpi,jpj,jpl) , d_v_s_trp  (jpi,jpj,jpl) ,   &
+         &      d_v_i_thd(jpi,jpj,jpl) , d_v_i_trp (jpi,jpj,jpl) , d_smv_i_thd(jpi,jpj,jpl) , d_smv_i_trp(jpi,jpj,jpl) ,   &     
+         &      d_sm_i_fl(jpi,jpj,jpl) , d_sm_i_gd (jpi,jpj,jpl) , d_sm_i_se  (jpi,jpj,jpl) , d_sm_i_si  (jpi,jpj,jpl) ,   &
+         &      d_sm_i_la(jpi,jpj,jpl) , d_oa_i_thd(jpi,jpj,jpl) , d_oa_i_trp (jpi,jpj,jpl) , s_i_newice (jpi,jpj,jpl) ,   &
+         &     STAT=ierr(ii) )
+      ii = ii + 1
+      ALLOCATE( d_e_s_thd(jpi,jpj,nlay_s,jpl) , d_e_i_thd(jpi,jpj,jkmax,jpl) , d_u_ice_dyn(jpi,jpj) ,     &
+         &      d_e_s_trp(jpi,jpj,nlay_s,jpl) , d_e_i_trp(jpi,jpj,jkmax,jpl) , d_v_ice_dyn(jpi,jpj) , STAT=ierr(ii) )
+      
+      ! * Ice thickness distribution variables
+      ii = ii + 1
+      ALLOCATE( ice_types(jpl) , ice_cat_bounds(jpm,2) , ice_ncat_types  (jpm) ,     &
+         &      hi_max (0:jpl) , hi_mean(jpl)          , hi_max_typ(0:jpl,jpm) , STAT=ierr(ii) )
+
+      ! * Ice diagnostics
+      ii = ii + 1
+      ALLOCATE( dv_dt_thd(jpi,jpj,jpl) , diag_sni_gr(jpi,jpj) , diag_lat_gr(jpi,jpj) ,     &
+         &      izero    (jpi,jpj,jpl) , diag_bot_gr(jpi,jpj) , diag_dyn_gr(jpi,jpj) ,     &
+         &      fstroc   (jpi,jpj,jpl) , diag_bot_me(jpi,jpj) , diag_sur_me(jpi,jpj) ,     &
+         &      fhbricat (jpi,jpj,jpl) , v_newice   (jpi,jpj)                        , STAT=ierr(ii) )
+
+      ice_alloc = MAXVAL( ierr(:) )
+      IF( ice_alloc /= 0 )   CALL ctl_warn('ice_alloc_2: failed to allocate arrays.')
+      !
+   END FUNCTION ice_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE ice
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90	(revision 3437)
@@ -0,0 +1,253 @@
+MODULE iceini
+   !!======================================================================
+   !!                       ***  MODULE iceini   ***
+   !!   Sea-ice model : LIM Sea ice model Initialization
+   !!======================================================================
+   !! History :  3.0  ! 2008-03  (M. Vancoppenolle) LIM-3 original code
+   !!            3.3  ! 2010-12  (G. Madec) add call to lim_thd_init and lim_thd_sal_init
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                   LIM sea-ice model
+   !!----------------------------------------------------------------------
+   !!   ice_init       : sea-ice model initialization
+   !!----------------------------------------------------------------------
+   USE phycst           ! physical constants
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE ice              ! LIM variables
+   USE par_ice          ! LIM parameters
+   USE dom_ice          ! LIM domain
+   USE thd_ice          ! LIM thermodynamical variables
+   USE limitd_me        ! LIM ice thickness distribution
+   USE limmsh           ! LIM mesh
+   USE limistate        ! LIM initial state
+   USE limrst           ! LIM restart
+   USE limthd           ! LIM ice thermodynamics
+   USE limthd_sal       ! LIM ice thermodynamics: salinity
+   USE limvar           ! LIM variables
+   USE limsbc           ! LIM surface boundary condition
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ice_init   ! called by sbcice_lim.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ice_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_init  ***
+      !!
+      !! ** purpose :   Allocate all the dynamic arrays of the LIM-3 modules
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+
+      !                                ! Allocate the ice arrays
+      ierr =        ice_alloc        ()      ! ice variables
+      ierr = ierr + dom_ice_alloc    ()      ! domain
+      ierr = ierr + sbc_ice_alloc    ()      ! surface forcing
+      ierr = ierr + thd_ice_alloc    ()      ! thermodynamics
+      ierr = ierr + lim_itd_me_alloc ()      ! ice thickness distribution - mechanics
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop('STOP', 'ice_init : unable to allocate ice arrays')
+      !
+      !                                ! adequation jpk versus ice/snow layers/categories
+      IF( jpl   > jpk  .OR.  jpm    > jpk .OR.                                    &
+          jkmax > jpk  .OR.  nlay_s > jpk      )   CALL ctl_stop( 'STOP',         &
+         &     'ice_init: the 3rd dimension of workspace arrays is too small.',   &
+         &     'use more ocean levels or less ice/snow layers/categories.' )
+
+      !                                ! Open the namelist file 
+      CALL ctl_opn( numnam_ice, 'namelist_ice', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      !
+      CALL ice_run                     ! set some ice run parameters
+      !
+      CALL lim_thd_init                ! set ice thermodynics parameters
+      !
+      CALL lim_thd_sal_init            ! set ice salinity parameters
+      !
+      rdt_ice = nn_fsbc * rdttra(1)    ! sea-ice timestep
+      !
+      CALL lim_msh                     ! ice mesh initialization
+      !
+      CALL lim_itd_ini                 ! ice thickness distribution initialization
+      !
+      CALL lim_sbc_init                ! ice surface boundary condition   
+
+
+      !                                ! Initial sea-ice state
+      IF( .NOT.ln_rstart ) THEN              ! start from rest
+         numit = 0
+         numit = nit000 - 1
+         CALL lim_istate                        ! start from rest: sea-ice deduced from sst
+         CALL lim_var_agg(1)                    ! aggregate category variables in bulk variables
+         CALL lim_var_glo2eqv                   ! convert global variables in equivalent variables
+      ELSE                                   ! start from a restart file
+         CALL lim_rst_read                      ! read the restart file
+         numit = nit000 - 1
+         CALL lim_var_agg(1)                    ! aggregate ice variables
+         CALL lim_var_glo2eqv                   ! convert global var in equivalent variables
+      ENDIF
+      !
+      fr_i(:,:) = at_i(:,:)           ! initialisation of sea-ice fraction
+      !
+      nstart = numit  + nn_fsbc      
+      nitrun = nitend - nit000 + 1 
+      nlast  = numit  + nitrun 
+      !
+      IF( nstock == 0  )   nstock = nlast + 1
+      !
+   END SUBROUTINE ice_init
+
+
+   SUBROUTINE ice_run
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE ice_run ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for ice model
+      !!
+      !! ** Method  :   Read the namicerun namelist and check the parameter 
+      !!              values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicerun
+      !!-------------------------------------------------------------------
+      NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, acrit, hsndif, hicdif, cai, cao, ln_nicep
+      !!-------------------------------------------------------------------
+      !                    
+      REWIND( numnam_ice )                ! Read Namelist namicerun 
+      READ  ( numnam_ice , namicerun )
+      !
+      IF( lk_mpp .AND. ln_nicep ) THEN
+         ln_nicep = .FALSE.
+         CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' )
+      ENDIF       
+      !
+      IF(lwp) THEN                        ! 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,*) '   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
+         WRITE(numout,*) '   atmospheric drag over sea ice                           = ', cai
+         WRITE(numout,*) '   atmospheric drag over ocean                             = ', cao
+         WRITE(numout,*) '   Several ice points in the ice or not in ocean.output    = ', ln_nicep
+      ENDIF
+      !
+   END SUBROUTINE ice_run
+
+
+   SUBROUTINE lim_itd_ini
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_ini ***
+      !!
+      !! ** Purpose :   Initializes the ice thickness distribution
+      !! ** Method  :   ...
+      !!------------------------------------------------------------------
+      INTEGER  ::   jl, jm               ! dummy loop index
+      REAL(wp) ::   zc1, zc2, zc3, zx1   ! local scalars
+      !!------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_itd_ini : Initialization of ice thickness distribution '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
+
+      !------------------------------------------------------------------------------!
+      ! 1) Ice thickness distribution parameters initialization    
+      !------------------------------------------------------------------------------!
+
+      !- Types boundaries (integer)
+      !----------------------------
+      ice_cat_bounds(1,1) = 1
+      ice_cat_bounds(1,2) = jpl
+
+      !- Number of ice thickness categories in each ice type
+      DO jm = 1, jpm
+         ice_ncat_types(jm) = ice_cat_bounds(jm,2) - ice_cat_bounds(jm,1) + 1 
+      END DO
+
+      !- Make the correspondence between thickness categories and ice types
+      !---------------------------------------------------------------------
+      DO jm = 1, jpm       !over types
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2) !over thickness categories
+            ice_types(jl) = jm
+         END DO
+      END DO
+
+      IF(lwp) THEN  
+         WRITE(numout,*) ' Number of ice types jpm =      ', jpm
+         WRITE(numout,*) ' Number of ice categories jpl = ', jpl
+         DO jm = 1, jpm
+            WRITE(numout,*) ' Ice type ', jm
+            WRITE(numout,*) ' Number of thickness categories ', ice_ncat_types(jm)
+            WRITE(numout,*) ' Thickness category boundaries  ', ice_cat_bounds(jm,1:2)
+         END DO
+         WRITE(numout,*) 'Ice type vector', ice_types(1:jpl)
+         WRITE(numout,*)
+      ENDIF
+
+      !- Thickness categories boundaries 
+      !----------------------------------
+      hi_max(:) = 0._wp
+      hi_max_typ(:,:) = 0._wp
+
+      !- Type 1 - undeformed ice
+      zc1 =  3._wp / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+      zc2 = 10._wp * zc1
+      zc3 =  3._wp
+
+      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
+         zx1 = REAL( jl-1 , wp ) / REAL( ice_cat_bounds(1,2) - ice_cat_bounds(1,1) + 1 , wp )
+         hi_max(jl) = hi_max(jl-1) + zc1 + zc2 * (1._wp + TANH( zc3 * (zx1 - 1._wp ) ) )
+      END DO
+
+      !- Fill in the hi_max_typ vector, useful in other circumstances
+      ! Tricky trick: hi_max_typ is actually not used in the code and will be removed in a
+      ! next flyspray at this time, the tricky trick will also be removed (Martin, march 08)
+      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
+         hi_max_typ(jl,1) = hi_max(jl)
+      END DO
+
+      IF(lwp) WRITE(numout,*) ' Thickness category boundaries independently of ice type '
+      IF(lwp) WRITE(numout,*) ' hi_max ', hi_max(0:jpl)
+
+      IF(lwp) WRITE(numout,*) ' Thickness category boundaries inside ice types '
+      IF(lwp) THEN 
+         DO jm = 1, jpm
+            WRITE(numout,*) ' Type number ', jm
+            WRITE(numout,*) ' hi_max_typ : ', hi_max_typ(0:ice_ncat_types(jm),jm)
+         END DO
+      ENDIF
+      !
+      DO jl = 1, jpl
+         hi_mean(jl) = ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp
+      END DO
+      !
+      tn_ice(:,:,:) = t_su(:,:,:)
+      !
+   END SUBROUTINE lim_itd_ini
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :        Empty module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ice_init        ! Empty routine
+   END SUBROUTINE ice_init
+#endif
+
+   !!======================================================================
+END MODULE iceini
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90	(revision 3437)
@@ -0,0 +1,422 @@
+MODULE limadv 
+   !!======================================================================
+   !!                       ***  MODULE limadv   ***
+   !! LIM sea-ice model : sea-ice advection
+   !!======================================================================
+   !! 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 dom_ice          ! LIM-3 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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_adv_x   ! called by lim_trp
+   PUBLIC   lim_adv_y   ! called by lim_trp
+
+   REAL(wp)  ::   epsi20 = 1.e-20_wp   ! constant values
+   REAL(wp)  ::   rzero  = 0._wp       !    -       -
+   REAL(wp)  ::   rone   = 1._wp       !    -       -
+
+   !! * 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_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, zin0   ! 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( 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  *   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( 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  *   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( 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
+
+
+   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, zin0   ! 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( 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  *   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( 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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module         NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limadv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90	(revision 3437)
@@ -0,0 +1,158 @@
+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 
+   !!            4.0  ! 2011-02  (G. Madec)  add mpp considerations
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                   LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_cons   :   checks whether energy, mass and salt are conserved 
+   !!----------------------------------------------------------------------
+   USE par_ice          ! LIM-3 parameter
+   USE ice              ! LIM-3 variables
+   USE dom_ice          ! LIM-3 domain
+   USE dom_oce          ! ocean domain
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_column_sum
+   PUBLIC   lim_column_sum_energy
+   PUBLIC   lim_cons_check
+
+   !!----------------------------------------------------------------------
+   !! 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,jkmax,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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module            NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+   !!======================================================================
+END MODULE limcons
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdia.F90	(revision 3437)
@@ -0,0 +1,588 @@
+MODULE limdia
+   !!======================================================================
+   !!                       ***  MODULE limdia   ***
+   !!  LIM-3 sea ice model :   diagnostics of ice model 
+   !!======================================================================
+   !! History :  3.2  ! 2007-01  (M. Vancoppenolle)  Code adapted from LIM-2
+   !!             -   ! 2008-03  (M. Vancoppenolle)  add lim_dia_init
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                       LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_dia        : computation and output of the time evolution of keys variables
+   !!   lim_dia_init   : initialization and namelist read
+   !!----------------------------------------------------------------------
+   USE ice             ! LIM-3: sea-ice variable
+   USE par_ice         ! LIM-3: ice parameters
+   USE dom_ice         ! LIM-3: sea-ice domain
+   USE dom_oce         ! ocean domain
+   USE sbc_oce         ! surface boundary condition: ocean fields
+   USE daymod          ! model calendar
+   USE phycst          ! physical constant
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_dia       ! called by ice_step
+
+   INTEGER, PUBLIC  ::   ntmoy   = 1   !: instantaneous values of ice evolution or averaging ntmoy
+   INTEGER, PUBLIC  ::   ninfo   = 1   !: frequency of ouputs on file ice_evolu in case of averaging
+
+   !                                              !!! Parameters for outputs to files "evolu"
+   INTEGER, PARAMETER ::   jpinfmx = 100           ! maximum number of key variables
+   INTEGER, PARAMETER ::   jpchinf = 5             ! ???
+   INTEGER, PARAMETER ::   jpchsep = jpchinf + 2   ! ???
+
+   INTEGER  ::   nfrinf  = 4         ! number of variables written in one line 
+   INTEGER  ::   nferme              ! last time step at which the var. are written on file
+   INTEGER  ::   nvinfo              ! number of total variables 
+   INTEGER  ::   nbvt                ! number of time variables
+   INTEGER  ::   naveg               ! number of step for accumulation before averaging
+   REAL(wp) ::   epsi06 = 1.e-6_wp   ! small number
+
+   CHARACTER(len= 8) ::   fmtinf = '1PE13.5 '   ! format of the output values  
+   CHARACTER(len=30) ::   fmtw                  ! formats
+   CHARACTER(len=30) ::   fmtr                  ! ???
+   CHARACTER(len=30) ::   fmtitr                ! ???
+
+   CHARACTER(len=jpchsep), DIMENSION(jpinfmx) ::   titvar   ! title of key variables
+
+   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/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_dia
+      !!--------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dia  ***
+      !!   
+      !! ** Purpose :   Computation and outputs on file ice.evolu 
+      !!              the temporal evolution of some key variables
+      !!-------------------------------------------------------------------
+      INTEGER  ::   jv, ji, jj, jl   ! dummy loop indices
+      REAL(wp) ::   zshift_date      ! date from the minimum ice extent
+      REAL(wp) ::   zday, zday_min   ! current day, day of minimum extent
+      REAL(wp) ::   zafy, zamy       ! temporary area of fy and my ice
+      REAL(wp) ::   zindb
+      REAL(wp), DIMENSION(jpinfmx) ::   vinfor           ! temporary working space 
+      !!-------------------------------------------------------------------
+
+      ! 0) date from the minimum of ice extent
+      !---------------------------------------
+      zday_min = 273._wp        ! zday_min = date of minimum extent, here September 30th
+      zday = REAL(numit-nit000,wp) * rdt_ice / ( 86400._wp * REAL(nn_fsbc,wp) )
+      !
+      IF( zday > zday_min ) THEN   ;   zshift_date  =  zday - zday_min
+      ELSE                         ;   zshift_date  =  zday - (365.0 - zday_min)
+      ENDIF
+
+      IF( numit == nstart )   CALL lim_dia_init   ! initialisation of ice_evolu file      
+
+      vinfor(1) = REAL(numit)       ! time diagnostics 
+      vinfor(2) = nyear
+
+      DO jv = nbvt + 1, nvinfo      ! put everything to zero
+         vinfor(jv) = 0._wp
+      END DO
+
+      !!-------------------------------------------------------------------
+      !! 1) Northern hemisphere
+      !!-------------------------------------------------------------------
+      !! 1.1) Diagnostics independent on age
+      !!------------------------------------
+      DO jj = njeq, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               vinfor(3)  = vinfor(3)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area
+               IF (at_i(ji,jj).GT.0.15) vinfor(5) = vinfor(5) + aire(ji,jj) * 1.e-12_wp !ice extent
+               vinfor(7)  = vinfor(7)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(9)  = vinfor(9)  + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume
+               vinfor(15) = vinfor(15) + ot_i(ji,jj) *vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean age
+               vinfor(29) = vinfor(29) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity
+               ! the computation of this diagnostic is not reliable
+               vinfor(31) = vinfor(31) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
+                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 
+               vinfor(53) = vinfor(53) + emps(ji,jj)*aire(ji,jj) * 1.e-12_wp !salt flux
+               vinfor(55) = vinfor(55) + fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp !brine drainage flux
+               vinfor(57) = vinfor(57) + fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp !equivalent salt flux
+               vinfor(59) = vinfor(59) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST
+               vinfor(61) = vinfor(61) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS
+               vinfor(65) = vinfor(65) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp  ! snow temperature
+               vinfor(67) = vinfor(67) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp       ! ice heat content
+               vinfor(69) = vinfor(69) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(71) = vinfor(71) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(73) = vinfor(73) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(75) = vinfor(75) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(77) = vinfor(77) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(79) = 0.0
+               vinfor(81) = vinfor(81) + emp(ji,jj)*aire(ji,jj) * 1.e-12_wp ! mass flux
+            ENDIF
+         END DO
+      END DO
+
+      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
+         DO jj = njeq, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tms(ji,jj) == 1 ) THEN
+                  vinfor(11) = vinfor(11) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !undef def ice volume
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      vinfor(13) = 0._wp
+
+      vinfor(15) = vinfor(15) / MAX(vinfor(7),epsi06) ! these have to be divided by total ice volume to have the
+      vinfor(29) = vinfor(29) / MAX(vinfor(7),epsi06) ! right value
+      vinfor(31) = SQRT( vinfor(31) / MAX( vinfor(7) , epsi06 ) )
+      vinfor(67) = vinfor(67) / MAX(vinfor(7),epsi06)
+
+      vinfor(53) = vinfor(53) / MAX(vinfor(5),epsi06) ! these have to be divided by total ice extent to have the
+      vinfor(55) = vinfor(55) / MAX(vinfor(5),epsi06) ! right value 
+      vinfor(57) = vinfor(57) / MAX(vinfor(5),epsi06) ! 
+      vinfor(79) = vinfor(79) / MAX(vinfor(5),epsi06) !
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(3))) !
+      vinfor(59) = zindb*vinfor(59) / MAX(vinfor(3),epsi06) ! divide by ice area
+      vinfor(61) = zindb*vinfor(61) / MAX(vinfor(3),epsi06) !
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(9))) !
+      vinfor(65) = zindb*vinfor(65) / MAX(vinfor(9),epsi06) ! divide it by snow volume
+
+
+      DO jl = 1, jpl
+         DO jj = njeq, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tms(ji,jj) == 1 ) THEN
+                  vinfor(33) = vinfor(33) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+                  vinfor(35) = vinfor(35) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jj = njeq, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               vinfor(37) = vinfor(37) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp !th growth rates
+               vinfor(39) = vinfor(39) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(41) = vinfor(41) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp
+               vinfor(43) = vinfor(43) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(45) = vinfor(45) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp
+               vinfor(47) = vinfor(47) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW
+            ENDIF
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = njeq, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tms(ji,jj) == 1 ) THEN
+                  vinfor(63) = vinfor(63) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+      vinfor(63) = vinfor(63) / MAX(vinfor(3),epsi06) ! these have to be divided by total ice area
+
+      !! 1.2) Diagnostics dependent on age
+      !!------------------------------------
+      DO jj = njeq, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               zafy = 0.0
+               zamy = 0.0
+               DO jl = 1, jpl
+                  IF ((o_i(ji,jj,jl) - zshift_date).LT.0.0) THEN
+                     vinfor(17) = vinfor(17) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice area
+                     vinfor(25) = vinfor(25) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice volume
+                     vinfor(49) = vinfor(49) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
+                     zafy = zafy + a_i(ji,jj,jl)
+                  ENDIF
+                  IF ((o_i(ji,jj,jl) - zshift_date).GT.0.0) THEN
+                     vinfor(19) = vinfor(19) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp    ! MY ice area
+                     vinfor(27) = vinfor(27) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! MY ice volume
+                     vinfor(51) = vinfor(51) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !MY ice salinity
+                     zamy = zamy + a_i(ji,jj,jl)
+                  ENDIF
+               END DO
+               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
+                  vinfor(21) = vinfor(21) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent
+               ENDIF
+               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
+                  vinfor(23) = vinfor(23) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(25))) !=0 if no multiyear ice 1 if yes
+      vinfor(49) = zindb*vinfor(49) / MAX(vinfor(25),epsi06)
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(27))) !=0 if no multiyear ice 1 if yes
+      vinfor(51) = zindb*vinfor(51) / MAX(vinfor(27),epsi06)
+
+      !! Fram Strait Export
+      !! 83 = area export
+      !! 84 = volume export
+      !! Fram strait in ORCA2 = 5 points
+      !! export = -v_ice*e1t*ddtb*at_i or -v_ice*e1t*ddtb*at_i*h_i
+      jj = 136 ! C grid
+      vinfor(83) = 0.0
+      vinfor(84) = 0.0
+      DO ji = 134, 138
+         vinfor(83) = vinfor(83) - v_ice(ji,jj) * & 
+            e1t(ji,jj)*at_i(ji,jj)*rdt_ice * 1.e-12_wp
+         vinfor(84) = vinfor(84) - v_ice(ji,jj) * & 
+            e1t(ji,jj)*vt_i(ji,jj)*rdt_ice * 1.e-12_wp
+      END DO
+
+      !!-------------------------------------------------------------------
+      !! 2) Southern hemisphere
+      !!-------------------------------------------------------------------
+      !! 2.1) Diagnostics independent on age
+      !!------------------------------------
+      DO jj = 2, njeqm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               vinfor(4)  = vinfor(4)  + at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice area
+               IF (at_i(ji,jj).GT.0.15) vinfor(6) = vinfor(6) + aire(ji,jj) * 1.e-12_wp !ice extent
+               vinfor(8)  = vinfor(8)  + vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(10) = vinfor(10) + vt_s(ji,jj)*aire(ji,jj) * 1.e-12_wp !snow volume
+               vinfor(16) = vinfor(16) + ot_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean age
+               vinfor(30) = vinfor(30) + smt_i(ji,jj)*vt_i(ji,jj)*aire(ji,jj) * 1.e-12_wp !mean salinity
+               ! this diagnostic is not well computed (weighted by vol instead
+               ! of area)
+               vinfor(32) = vinfor(32) + vt_i(ji,jj)*( u_ice(ji,jj)*u_ice(ji,jj) + & 
+                  v_ice(ji,jj)*v_ice(ji,jj) )*aire(ji,jj)/1.0e12 !ice vel
+               vinfor(54) = vinfor(54) + at_i(ji,jj)*emps(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Total salt flux
+               vinfor(56) = vinfor(56) + at_i(ji,jj)*fsbri(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Brine drainage salt flux
+               vinfor(58) = vinfor(58) + at_i(ji,jj)*fseqv(ji,jj)*aire(ji,jj) * 1.e-12_wp ! Equivalent salt flux
+               vinfor(60) = vinfor(60) +(sst_m(ji,jj)+rt0)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SST
+               vinfor(62) = vinfor(62) + sss_m(ji,jj)*at_i(ji,jj)*aire(ji,jj) * 1.e-12_wp  !SSS
+               vinfor(66) = vinfor(66) + et_s(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp ! snow temperature
+               vinfor(68) = vinfor(68) + et_i(ji,jj)/1.0e9*aire(ji,jj) * 1.e-12_wp ! ice enthalpy
+               vinfor(70) = vinfor(70) + v_i(ji,jj,1)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(72) = vinfor(72) + v_i(ji,jj,2)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(74) = vinfor(74) + v_i(ji,jj,3)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(76) = vinfor(76) + v_i(ji,jj,4)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(78) = vinfor(78) + v_i(ji,jj,5)*aire(ji,jj) * 1.e-12_wp !ice volume
+               vinfor(80) = 0.0
+               vinfor(82) = vinfor(82) + emp(ji,jj)*aire(ji,jj) * 1.e-12_wp ! mass flux
+            ENDIF
+         END DO
+      END DO
+
+      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
+         DO jj = 2, njeqm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               vinfor(12) = vinfor(12) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !undef def ice volume
+            END DO
+         END DO
+      END DO
+
+      vinfor(14) = 0.0
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(8))) 
+      vinfor(16) = zindb * vinfor(16) / MAX(vinfor(8),epsi06) ! these have to be divided by ice vol
+      vinfor(30) = zindb * vinfor(30) / MAX(vinfor(8),epsi06) ! 
+      vinfor(32) = zindb * SQRT( vinfor(32) / MAX( vinfor(8) , epsi06 ) )
+      vinfor(68) = zindb * vinfor(68) / MAX(vinfor(8),epsi06) ! 
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(6))) 
+      vinfor(54) = zindb * vinfor(54) / MAX(vinfor(6),epsi06) ! these have to be divided by ice extt
+      vinfor(56) = zindb * vinfor(56) / MAX(vinfor(6),epsi06) ! 
+      vinfor(58) = zindb * vinfor(58) / MAX(vinfor(6),epsi06) ! 
+      vinfor(80) = zindb * vinfor(80) / MAX(vinfor(6),epsi06) !
+      !      vinfor(84) = vinfor(84) / vinfor(6) !
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) !
+      vinfor(60) = zindb*vinfor(60) / ( MAX(vinfor(4), epsi06) ) ! divide by ice area
+      vinfor(62) = zindb*vinfor(62) / ( MAX(vinfor(4), epsi06) ) !
+
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(10))) !
+      vinfor(66) = zindb*vinfor(66) / MAX(vinfor(10),epsi06) ! divide it by snow volume
+
+      DO jl = 1, jpl
+         DO jj = 2, njeqm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tms(ji,jj) == 1 ) THEN
+                  vinfor(34) = vinfor(34) + d_v_i_trp(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+                  vinfor(36) = vinfor(36) + d_v_i_thd(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !ice volume
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      DO jj = 2, njeqm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               vinfor(38) = vinfor(38) + diag_sni_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp !th growth rates
+               vinfor(40) = vinfor(40) + diag_lat_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(42) = vinfor(42) + diag_bot_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp
+               vinfor(44) = vinfor(44) + diag_dyn_gr(ji,jj)*aire(ji,jj) * 1.e-12_wp 
+               vinfor(46) = vinfor(46) + dv_dt_thd(ji,jj,5)*aire(ji,jj) * 1.e-12_wp
+               vinfor(48) = vinfor(48) + v_newice(ji,jj) *aire(ji,jj) * 1.e-12_wp / rdt_ice ! volume acc in OW
+            ENDIF
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = 2, njeqm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               IF( tms(ji,jj) == 1 ) THEN
+                  vinfor(64) = vinfor(64) + t_su(ji,jj,jl)*a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(4))) !
+      vinfor(64) = zindb * vinfor(64) / MAX(vinfor(4),epsi06) ! divide by ice extt
+      !! 2.2) Diagnostics dependent on age
+      !!------------------------------------
+      DO jj = 2, njeqm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            IF( tms(ji,jj) == 1 ) THEN
+               zafy = 0._wp
+               zamy = 0._wp
+               DO jl = 1, jpl
+                  IF( (o_i(ji,jj,jl) - zshift_date) < 0._wp ) THEN
+                     vinfor(18) = vinfor(18) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice area
+                     vinfor(26) = vinfor(26) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp ! FY ice volume
+                     zafy = zafy + a_i(ji,jj,jl)
+                     vinfor(50) = vinfor(50) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
+                  ENDIF
+                  IF( (o_i(ji,jj,jl) - zshift_date) > 0._wp ) THEN
+                     vinfor(20) = vinfor(20) + a_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp    ! MY ice area
+                     vinfor(28) = vinfor(28) + v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp
+                     vinfor(52) = vinfor(52) + sm_i(ji,jj,jl)*v_i(ji,jj,jl)*aire(ji,jj) * 1.e-12_wp !FY ice salinity
+                     zamy = zamy + a_i(ji,jj,jl)
+                  ENDIF
+               END DO ! jl
+               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.GT.zamy)) THEN
+                  vinfor(22) = vinfor(22) + aire(ji,jj) * 1.e-12_wp ! Seasonal ice extent
+               ENDIF
+               IF ((at_i(ji,jj).GT.0.15).AND.(zafy.LE.zamy)) THEN
+                  vinfor(24) = vinfor(24) + aire(ji,jj) * 1.e-12_wp ! Perennial ice extent
+               ENDIF
+            ENDIF ! tms
+         END DO ! jj
+      END DO ! ji
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(26))) !=0 if no multiyear ice 1 if yes
+      vinfor(50) = zindb*vinfor(50) / MAX(vinfor(26),epsi06)
+      zindb      = 1.0 - MAX(0.0,SIGN(1.0,-vinfor(28))) !=0 if no multiyear ice 1 if yes
+      vinfor(52) = zindb*vinfor(52) / MAX(vinfor(28),epsi06)
+
+      !  Accumulation before averaging 
+      DO jv = 1, nvinfo
+         vinfom(jv) = vinfom(jv) + vinfor(jv)
+      END DO
+      naveg = naveg + 1  
+
+      ! oututs on file ice_evolu    
+      !MV      IF( MOD( numit , ninfo ) == 0 ) THEN
+      WRITE(numevo_ice,fmtw) ( titvar(jv), vinfom(jv)/naveg, jv = 1, nvinfo )
+      naveg = 0
+      DO jv = 1, nvinfo
+         vinfom(jv) = 0._wp
+      END DO
+      !MV      ENDIF
+      !
+   END SUBROUTINE lim_dia
+
+
+   SUBROUTINE lim_dia_init
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_dia_init  ***
+      !!             
+      !! ** Purpose : Preparation of the file ice_evolu for the output of
+      !!      the temporal evolution of key variables
+      !!
+      !! ** input   : Namelist namicedia
+      !!-------------------------------------------------------------------
+      INTEGER  ::   jv    ! dummy loop indice
+      INTEGER  ::   ierr, ntot , ndeb , irecl   ! local integers
+      REAL(wp) ::   zxx0, zxx1    ! local scalars
+      CHARACTER(len=jpchinf) ::   titinf
+      CHARACTER(len=50)      ::   clname
+      !!
+      NAMELIST/namicedia/fmtinf, nfrinf, ninfo, ntmoy
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice )             ! read namicedia namelist
+      READ  ( numnam_ice, namicedia )
+      !
+      IF(lwp) THEN                     ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_dia_init : 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 (interior domain only)
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'lim_dia_init_2 : unable to allocate arrays' )
+      aire(:,:) = area(:,:) * tms(:,:) * tmask_i(:,:)
+
+      ! Titles of ice key variables :
+      titvar(1) = 'NoIt'  ! iteration number
+      titvar(2) = 'T yr'  ! time step in years
+      nbvt      = 2       ! number of time variables
+
+      titvar(3) = 'AI_N'  ! sea ice area in the northern Hemisp.(10^12 km2)
+      titvar(4) = 'AI_S'  ! sea ice area in the southern Hemisp.(10^12 km2)
+      titvar(5) = 'EI_N'  ! sea ice extent (15%) in the northern Hemisp.(10^12 km2)
+      titvar(6) = 'EI_S'  ! sea ice extent (15%) in the southern Hemisp.(10^12 km2)
+      titvar(7) = 'VI_N'  ! sea ice volume in the northern Hemisp.(10^3 km3)
+      titvar(8) = 'VI_S'  ! sea ice volume in the southern Hemisp.(10^3 km3)
+      titvar(9) = 'VS_N'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
+      titvar(10)= 'VS_S'  ! snow volume over sea ice in the northern Hemisp.(10^3 km3)
+      titvar(11)= 'VuIN'  ! undeformed sea ice volume in the northern Hemisp.(10^3 km3)
+      titvar(12)= 'VuIS'  ! undeformed sea ice volume in the southern Hemisp.(10^3 km3)
+      titvar(13)= 'VdIN'  ! deformed sea ice volume in the northern Hemisp.(10^3 km3)
+      titvar(14)= 'VdIS'  ! deformed sea ice volume in the southern Hemisp.(10^3 km3)
+      titvar(15)= 'OI_N'  ! sea ice mean age in the northern Hemisp.(years)
+      titvar(16)= 'OI_S'  ! sea ice mean age in the southern Hemisp.(years)
+      titvar(17)= 'AFYN'  ! total FY ice area northern Hemisp.(10^12 km2)
+      titvar(18)= 'AFYS'  ! total FY ice area southern Hemisp.(10^12 km2)
+      titvar(19)= 'AMYN'  ! total MY ice area northern Hemisp.(10^12 km2)
+      titvar(20)= 'AMYS'  ! total MY ice area southern Hemisp.(10^12 km2)
+      titvar(21)= 'EFYN'  ! total FY ice extent northern Hemisp.(10^12 km2) (with more 50% FY ice)
+      titvar(22)= 'EFYS'  ! total FY ice extent southern Hemisp.(10^12 km2) (with more 50% FY ice)
+      titvar(23)= 'EMYN'  ! total MY ice extent northern Hemisp.(10^12 km2) (with more 50% MY ice)
+      titvar(24)= 'EMYS'  ! total MY ice extent southern Hemisp.(10^12 km2) (with more 50% MY ice)
+      titvar(25)= 'VFYN'  ! total undeformed FY ice volume northern Hemisp.(10^3 km3) 
+      titvar(26)= 'VFYS'  ! total undeformed FY ice volume southern Hemisp.(10^3 km3)
+      titvar(27)= 'VMYN'  ! total undeformed MY ice volume northern Hemisp.(10^3 km3) 
+      titvar(28)= 'VMYS'  ! total undeformed MY ice volume southern Hemisp.(10^3 km3) 
+      titvar(29)= 'IS_N'  ! sea ice mean salinity in the northern hemisphere (ppt)  
+      titvar(30)= 'IS_S'  ! sea ice mean salinity in the southern hemisphere (ppt)  
+      titvar(31)= 'IVeN'  ! sea ice mean velocity in the northern hemisphere (m/s) 
+      titvar(32)= 'IVeS'  ! sea ice mean velocity in the southern hemisphere (m/s) 
+      titvar(33)= 'DVDN'  ! variation of sea ice volume due to dynamics in the northern hemisphere
+      titvar(34)= 'DVDS'  ! variation of sea ice volume due to dynamics in the southern hemisphere
+      titvar(35)= 'DVTN'  ! variation of sea ice volume due to thermo in the   northern hemisphere
+      titvar(36)= 'DVTS'  ! variation of sea ice volume due to thermo in the   southern hemisphere
+      titvar(37)= 'TG1N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 1  
+      titvar(38)= 'TG1S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 1  
+      titvar(39)= 'TG2N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 2  
+      titvar(40)= 'TG2S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 2  
+      titvar(41)= 'TG3N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 3  
+      titvar(42)= 'TG3S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 3  
+      titvar(43)= 'TG4N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 4  
+      titvar(44)= 'TG4S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 4  
+      titvar(45)= 'TG5N'  ! thermodynamic vertical growth rate in the northern hemisphere, cat 5  
+      titvar(46)= 'TG5S'  ! thermodynamic vertical growth rate in the souhtern hemisphere, cat 5  
+      titvar(47)= 'LA_N'  ! lateral accretion growth rate, northern hemisphere
+      titvar(48)= 'LA_S'  ! lateral accretion growth rate, southern hemisphere 
+      titvar(49)= 'SF_N'  ! Salinity FY, NH 
+      titvar(50)= 'SF_S'  ! Salinity FY, SH 
+      titvar(51)= 'SF_N'  ! Salinity MY, NH 
+      titvar(52)= 'SF_S'  ! Salinity MY, SH 
+      titvar(53)= 'Fs_N'  ! Total salt flux NH
+      titvar(54)= 'Fs_S'  ! Total salt flux SH
+      titvar(55)= 'FsbN'  ! Salt - brine drainage flux NH
+      titvar(56)= 'FsbS'  ! Salt - brine drainage flux SH
+      titvar(57)= 'FseN'  ! Salt - Equivalent salt flux NH
+      titvar(58)= 'FseS'  ! Salt - Equivalent salt flux SH
+      titvar(59)= 'SSTN'  ! SST, NH
+      titvar(60)= 'SSTS'  ! SST, SH
+      titvar(61)= 'SSSN'  ! SSS, NH
+      titvar(62)= 'SSSS'  ! SSS, SH
+      titvar(63)= 'TsuN'  ! Tsu, NH
+      titvar(64)= 'TsuS'  ! Tsu, SH
+      titvar(65)= 'TsnN'  ! Tsn, NH
+      titvar(66)= 'TsnS'  ! Tsn, SH
+      titvar(67)= 'ei_N'  ! ei, NH
+      titvar(68)= 'ei_S'  ! ei, SH
+      titvar(69)= 'vi1N'  ! vi1, NH
+      titvar(70)= 'vi1S'  ! vi1, SH
+      titvar(71)= 'vi2N'  ! vi2, NH
+      titvar(72)= 'vi2S'  ! vi2, SH
+      titvar(73)= 'vi3N'  ! vi3, NH
+      titvar(74)= 'vi3S'  ! vi3, SH
+      titvar(75)= 'vi4N'  ! vi4, NH
+      titvar(76)= 'vi4S'  ! vi4, SH
+      titvar(77)= 'vi5N'  ! vi5, NH
+      titvar(78)= 'vi5S'  ! vi5, SH
+      titvar(79)= 'vi6N'  ! vi6, NH
+      titvar(80)= 'vi6S'  ! vi6, SH
+      titvar(81)= 'fmaN'  ! mass flux in the ocean, NH
+      titvar(82)= 'fmaS'  ! mass flux in the ocean, SH
+      titvar(83)= 'AFSE'  ! Fram Strait Area export
+      titvar(84)= 'VFSE'  ! Fram Strait Volume export
+      nvinfo = 84
+
+      ! Definition et Ecriture de l'entete : nombre d'enregistrements 
+      ndeb   = ( nstart - 1 ) / ninfo
+      IF( nstart == 1 ) ndeb = -1
+
+      nferme = ( nstart - 1 + nitrun) / ninfo
+      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
+      IF( lk_mpp ) THEN   ;   WRITE(clname,FMT="('ice.evolu_',I4.4)") narea-1
+      ELSE                ;   clname = 'ice.evolu'
+      END IF
+      irecl = ( jpchinf + 1 ) * nvinfo 
+      CALL ctl_opn( numevo_ice, clname, 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',    &
+         &         irecl, numout, lwp, narea )
+
+      !- 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._wp
+      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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                             NO LIM-3 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_dia         ! Empty routine
+   END SUBROUTINE lim_dia
+#endif
+
+   !!======================================================================
+END MODULE limdia
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90	(revision 3437)
@@ -0,0 +1,289 @@
+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
+   !!            4.0  ! 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_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice   fields
+   USE ice              ! LIM-3 variables
+   USE par_ice          ! LIM-3 parameters
+   USE dom_ice          ! LIM-3 domain
+   USE limrhg           ! LIM-3 rheology
+   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 prtctl           ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_dyn   ! 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_dyn( kt )
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_dyn  ***
+      !!               
+      !! ** Purpose :   compute ice velocity and ocean-ice stress
+      !!                
+      !! ** Method  : 
+      !!
+      !! ** Action  : - Initialisation
+      !!              - Call of the dynamic routine for each hemisphere
+      !!              - computation of the stress at the ocean surface         
+      !!              - treatment of the case if no ice dynamic
+      !!------------------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt     ! number of iteration
+      !!
+      INTEGER  ::   ji, jj, jl, ja    ! dummy loop indices
+      INTEGER  ::   i_j1, i_jpj       ! Starting/ending j-indices for rheology
+      REAL(wp) ::   zcoef             ! local 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   ! Initialization (first time-step only)
+
+      IF( ln_limdyn ) THEN
+         !
+         old_u_ice(:,:) = u_ice(:,:) * tmu(:,:)
+         old_v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+
+         ! Rheology (ice dynamics)
+         ! ========
+
+         !  Define the j-limits where ice rheology is computed
+         ! ---------------------------------------------------
+
+         IF( lk_mpp .OR. lk_mpp_rep ) THEN                    ! mpp: compute over the whole domain
+            i_j1 = 1
+            i_jpj = jpj
+            IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
+            CALL lim_rhg( i_j1, i_jpj )
+         ELSE                                 ! optimization of the computational area
+            !
+            DO jj = 1, jpj
+               zind(jj) = SUM( 1.0 - at_i(:,jj) )   ! = REAL(jpj) if ocean everywhere on a j-line
+               zmsk(jj) = SUM( tmask(:,jj,1)    )   ! = 0         if land  everywhere on a j-line
+            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
+               i_j1 = MAX( 1, i_j1-2 )
+               IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : NH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
+               CALL lim_rhg( i_j1, 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
+               i_jpj = MIN( jpj, i_jpj+1 )
+               IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : SH  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
+               !
+               CALL lim_rhg( i_j1, 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-2 )
+
+               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+1)
+               !
+               IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn  : one hemisphere:  i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj )
+               !
+               CALL lim_rhg( i_j1, i_jpj )
+               !
+            ENDIF
+            !
+         ENDIF
+
+         ! computation of friction velocity
+         ! --------------------------------
+         ! ice-ocean velocity at U & V-points (u_ice v_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points)
+         zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
+         zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
+         ! frictional velocity at T-point
+         zcoef = 0.5_wp * cw
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ust2s(ji,jj) = zcoef * (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   &
+                  &                    + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1)   ) * tms(ji,jj)
+            END DO
+         END DO
+         !
+      ELSE      ! no ice dynamics : transmit directly the atmospheric stress to the ocean
+         !
+         zcoef = SQRT( 0.5_wp ) / 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) THEN   ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=ust2s     , clinfo1=' lim_dyn  : ust2s     :')
+         CALL prt_ctl(tab2d_1=divu_i    , clinfo1=' lim_dyn  : divu_i    :')
+         CALL prt_ctl(tab2d_1=delta_i   , clinfo1=' lim_dyn  : delta_i   :')
+         CALL prt_ctl(tab2d_1=strength  , clinfo1=' lim_dyn  : strength  :')
+         CALL prt_ctl(tab2d_1=area      , clinfo1=' lim_dyn  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i      , clinfo1=' lim_dyn  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i      , clinfo1=' lim_dyn  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s      , clinfo1=' lim_dyn  : vt_s      :')
+         CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' lim_dyn  : stress1_i :')
+         CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' lim_dyn  : stress2_i :')
+         CALL prt_ctl(tab2d_1=stress12_i, clinfo1=' lim_dyn  : stress12_i:')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_dyn  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_dyn  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_dyn  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_dyn  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_dyn  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_dyn  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_dyn  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_dyn  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_dyn  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_dyn  : smv_i    : ')
+            DO ja = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=ja)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_dyn  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_dyn  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zu_io, zv_io )
+      CALL wrk_dealloc( jpj, zind, zmsk )
+      !
+   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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicedyn/ epsd, alpha,     &
+         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   &
+         &                c_rhg, etamn, creepl, ecc, ahi0, &
+         &                nevp, telast, alphaevp
+      !!-------------------------------------------------------------------
+
+      REWIND( numnam_ice )                ! Read Namelist namicedyn
+      READ  ( numnam_ice  , namicedyn )
+      
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_dyn_init : ice parameters for ice dynamics '
+         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
+         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                                      creepl = ', creepl
+         WRITE(numout,*) '   eccentricity of the elliptical yield curve       ecc    = ', ecc
+         WRITE(numout,*) '   horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0
+         WRITE(numout,*) '   number of iterations for subcycling              nevp   = ', nevp
+         WRITE(numout,*) '   timescale for elastic waves                      telast = ', telast
+         WRITE(numout,*) '   coefficient for the solution of int. stresses  alphaevp = ', alphaevp
+      ENDIF
+      !
+      IF( angvg /= 0._wp ) THEN
+         CALL ctl_warn( 'lim_dyn_init: turning angle for oceanic stress not properly coded for EVP ',   &
+            &           '(see limsbc module). We force  angvg = 0._wp'  )
+         angvg = 0._wp
+      ENDIF
+      
+      usecc2 = 1._wp / ( ecc * ecc )
+      rhoco  = rau0  * cw
+      angvg  = angvg * rad
+      sangvg = SIN( angvg )
+      cangvg = COS( angvg )
+      pstarh = pstar * 0.5_wp
+
+      !  Diffusion coefficients.
+      ahiu(:,:) = ahi0 * umask(:,:,1)
+      ahiv(:,:) = ahi0 * vmask(:,:,1)
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90	(revision 3437)
@@ -0,0 +1,158 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_hdf  : 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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_hdf     ! called by lim_tra
+
+   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/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_hdf( ptab )
+      !!-------------------------------------------------------------------
+      !!                  ***  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
+      !!-------------------------------------------------------------------
+      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), POINTER, DIMENSION(:,:) ::   zrlx, zflu, zflv, zdiv0, zdiv, ztab0
+      CHARACTER(lc) ::   charout   ! local character
+      !!-------------------------------------------------------------------
+      
+      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 : 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) ) / ( 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
+      IF( .NOT.lk_vopt_loop ) THEN
+         zflu (jpi,:) = 0._wp   
+         zflv (jpi,:) = 0._wp
+         zdiv0(1,  :) = 0._wp
+         zdiv0(jpi,:) = 0._wp
+      ENDIF
+
+      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 = fs_2, fs_jpim1
+               zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) )  )
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zconv )            ! max over the global domain
+         !
+         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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option          Dummy module           NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_hdf         ! Empty routine
+   END SUBROUTINE lim_hdf
+#endif
+
+   !!======================================================================
+END MODULE limhdf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90	(revision 3437)
@@ -0,0 +1,575 @@
+MODULE limistate
+   !!======================================================================
+   !!                     ***  MODULE  limistate  ***
+   !!              Initialisation of diagnostics ice variables
+   !!======================================================================
+   !! History :  2.0  ! 2004-01 (C. Ethe, G. Madec)  Original code
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#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 eosbn2           ! equation of state
+   USE ice              ! sea-ice variables
+   USE par_ice          ! ice parameters
+   USE dom_ice          ! sea-ice domain
+   USE in_out_manager   ! I/O manager
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_istate      ! routine called by lim_init.F90
+
+   !                                  !!** init namelist (namiceini) **
+   REAL(wp) ::   ttest    = 2.0_wp     ! threshold water temperature for initial sea ice
+   REAL(wp) ::   hninn    = 0.5_wp     ! initial snow thickness in the north
+   REAL(wp) ::   hginn_u  = 2.5_wp     ! initial ice thickness in the north
+   REAL(wp) ::   aginn_u  = 0.7_wp     ! initial leads area in the north
+   REAL(wp) ::   hginn_d  = 5.0_wp     ! initial ice thickness in the north
+   REAL(wp) ::   aginn_d  = 0.25_wp    ! initial leads area in the north
+   REAL(wp) ::   hnins    = 0.1_wp     ! initial snow thickness in the south
+   REAL(wp) ::   hgins_u  = 1.0_wp     ! initial ice thickness in the south
+   REAL(wp) ::   agins_u  = 0.7_wp     ! initial leads area in the south
+   REAL(wp) ::   hgins_d  = 2.0_wp     ! initial ice thickness in the south
+   REAL(wp) ::   agins_d  = 0.2_wp     ! initial leads area in the south
+   REAL(wp) ::   sinn     = 6.301_wp   ! initial salinity 
+   REAL(wp) ::   sins     = 6.301_wp   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_istate
+      !!-------------------------------------------------------------------
+      !!                    ***  ROUTINE lim_istate  ***
+      !!
+      !! ** 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, jl             ! dummy loop indices
+      REAL(wp) ::   zeps6, zeps, ztmelts, epsi06   ! local scalars
+      REAL(wp) ::   zvol, zare, zh, zh1, zh2, zh3, zan, zbn, zas, zbs 
+      REAL(wp), POINTER, DIMENSION(:)   ::   zgfactorn, zhin 
+      REAL(wp), POINTER, DIMENSION(:)   ::   zgfactors, zhis
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zidto      ! ice indicator
+      !--------------------------------------------------------------------
+
+      CALL wrk_alloc( jpm, zgfactorn, zgfactors, zhin, zhis )
+      CALL wrk_alloc( jpi, jpj, zidto )
+
+      !--------------------------------------------------------------------
+      ! 1) Preliminary things 
+      !--------------------------------------------------------------------
+      epsi06 = 1.e-6_wp
+
+      CALL lim_istate_init     !  reading the initials parameters of the ice
+
+!!gm  in lim2  the initialisation if only done if required in the namelist :
+!!gm      IF( .NOT. ln_limini ) THEN
+!!gm  this should be added in lim3 namelist...
+
+      !--------------------------------------------------------------------
+      ! 2) Ice initialization (hi,hs,frld,t_su,sm_i,t_i,t_s)              | 
+      !--------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'lim_istate : Ice initialization '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+
+      t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius]
+
+      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest
+         DO ji = 1, jpi
+            IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice
+            ELSE                                                     ;   zidto(ji,jj) = 1.e0      !    ice
+            ENDIF
+         END DO
+      END DO
+
+      t_bo(:,:) = t_bo(:,:) + rt0                          ! t_bo converted from Celsius to Kelvin (rt0 over land)
+
+      ! constants for heat contents
+      zeps   = 1.e-20_wp
+      zeps6  = 1.e-06_wp
+
+      ! zgfactor for initial ice distribution
+      zgfactorn(:) = 0._wp
+      zgfactors(:) = 0._wp
+
+      ! first ice type
+      DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2)
+         zhin (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
+         zgfactorn(1) = zgfactorn(1) + exp(-(zhin(1)-hginn_u)*(zhin(1)-hginn_u) * 0.5_wp )
+         zhis (1)     = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
+         zgfactors(1) = zgfactors(1) + exp(-(zhis(1)-hgins_u)*(zhis(1)-hgins_u) * 0.5_wp )
+      END DO ! jl
+      zgfactorn(1) = aginn_u / zgfactorn(1)
+      zgfactors(1) = agins_u / zgfactors(1)
+
+      ! -------------
+      ! new distribution, polynom of second order, conserving area and volume
+      zh1 = 0._wp
+      zh2 = 0._wp
+      zh3 = 0._wp
+      DO jl = 1, jpl
+         zh = ( hi_max(jl-1) + hi_max(jl) ) * 0.5_wp
+         zh1 = zh1 + zh
+         zh2 = zh2 + zh * zh
+         zh3 = zh3 + zh * zh * zh
+      END DO
+      IF(lwp) WRITE(numout,*) ' zh1 : ', zh1
+      IF(lwp) WRITE(numout,*) ' zh2 : ', zh2
+      IF(lwp) WRITE(numout,*) ' zh3 : ', zh3
+
+      zvol = aginn_u * hginn_u
+      zare = aginn_u
+      IF( jpl >= 2 ) THEN
+         zbn = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3)
+         zan = ( zare - zbn*zh1 ) / zh2
+      ENDIF
+
+      IF(lwp) WRITE(numout,*) ' zvol: ', zvol
+      IF(lwp) WRITE(numout,*) ' zare: ', zare
+      IF(lwp) WRITE(numout,*) ' zbn : ', zbn 
+      IF(lwp) WRITE(numout,*) ' zan : ', zan 
+
+      zvol = agins_u * hgins_u
+      zare = agins_u
+      IF( jpl >= 2 ) THEN
+         zbs = ( zvol*zh2 - zare*zh3 ) / ( zh2*zh2 - zh1*zh3)
+         zas = ( zare - zbs*zh1 ) / zh2
+      ENDIF
+
+      IF(lwp) WRITE(numout,*) ' zvol: ', zvol
+      IF(lwp) WRITE(numout,*) ' zare: ', zare
+      IF(lwp) WRITE(numout,*) ' zbn : ', zbn 
+      IF(lwp) WRITE(numout,*) ' zan : ', zan 
+
+      !end of new lines
+      ! -------------
+!!!
+      ! retour a LIMA_MEC
+      !     ! second ice type
+      !     zdummy  = hi_max(ice_cat_bounds(2,1)-1)
+      !     hi_max(ice_cat_bounds(2,1)-1) = 0.0
+
+      !     ! here to change !!!!
+      !     jm = 2
+      !     DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+      !        zhin (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+      !        zhin (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + &
+      !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0
+      !        zgfactorn(2) = zgfactorn(2) + exp(-(zhin(2)-hginn_d)*(zhin(2)-hginn_d)/2.0)
+      !        zhis (2)     = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+      !        zhis (2)     = ( hi_max_typ(jl-ice_cat_bounds(2,1),jm    ) + &
+      !                         hi_max_typ(jl-ice_cat_bounds(2,1) + 1,jm)   ) / 2.0
+      !        zgfactors(2) = zgfactors(2) + exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0)
+      !     END DO ! jl
+      !     zgfactorn(2) = aginn_d / zgfactorn(2)
+      !     zgfactors(2) = agins_d / zgfactors(2)
+      !     hi_max(ice_cat_bounds(2,1)-1) = zdummy
+      ! END retour a LIMA_MEC
+!!!
+
+!!gm  optimisation :  loop over the ice categories inside the ji, jj loop !!!
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            !--- Northern hemisphere
+            !----------------------------------------------------------------
+            IF( fcor(ji,jj) >= 0._wp ) THEN    
+
+               !-----------------------
+               ! Ice area / thickness
+               !-----------------------
+
+               IF ( jpl .EQ. 1) THEN ! one category
+
+                  DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories
+                     a_i(ji,jj,jl)    = zidto(ji,jj) * aginn_u
+                     ht_i(ji,jj,jl)   = zidto(ji,jj) * hginn_u
+                     v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+                  END DO
+
+               ELSE ! several categories
+
+                  DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories
+                     zhin(1)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+                     a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(1) * exp(-(zhin(1)-hginn_u)* & 
+                        (zhin(1)-hginn_u)/2.0) , epsi06)
+                     ! new line
+                     a_i(ji,jj,jl)    = zidto(ji,jj) * ( zan * zhin(1) * zhin(1) + zbn * zhin(1) )
+                     ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(1) 
+                     v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+                  END DO
+
+               ENDIF
+
+
+!!!
+               ! retour a LIMA_MEC
+               !              !ridged ice
+               !              zdummy  = hi_max(ice_cat_bounds(2,1)-1)
+               !              hi_max(ice_cat_bounds(2,1)-1) = 0.0
+               !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) ! loop over ice thickness categories
+               !                 zhin(2)          = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+               !                 a_i(ji,jj,jl)    = zidto(ji,jj) * MAX( zgfactorn(2) * exp(-(zhin(2)-hginn_d)* &
+               !                                    (zhin(2)-hginn_d)/2.0) , epsi06)
+               !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhin(2) 
+               !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+               !              END DO
+               !              hi_max(ice_cat_bounds(2,1)-1) = zdummy
+
+               !              !rafted ice
+               !              jl = 6
+               !              a_i(ji,jj,jl)       = 0.0
+               !              ht_i(ji,jj,jl)      = 0.0
+               !              v_i(ji,jj,jl)       = 0.0
+               ! END retour a LIMA_MEC
+!!!
+
+               DO jl = 1, jpl
+
+                  !-------------
+                  ! Snow depth
+                  !-------------
+                  ht_s(ji,jj,jl)   = zidto(ji,jj) * hninn
+                  v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl)
+
+                  !---------------
+                  ! Ice salinity
+                  !---------------
+                  sm_i(ji,jj,jl)   = zidto(ji,jj) * sinn  + ( 1.0 - zidto(ji,jj) ) * 0.1
+                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
+
+                  !----------
+                  ! Ice age
+                  !----------
+                  o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) )
+                  oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl)
+
+                  !------------------------------
+                  ! Sea ice surface temperature
+                  !------------------------------
+
+                  t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj)
+
+                  !------------------------------------
+                  ! Snow temperature and heat content
+                  !------------------------------------
+
+                  DO jk = 1, nlay_s
+                     t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt
+                     ! Snow energy of melting
+                     e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
+                     ! Change dimensions
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
+                     ! Multiply by volume, so that heat content in 10^9 Joules
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * &
+                        v_s(ji,jj,jl)  / nlay_s
+                  END DO !jk
+
+                  !-----------------------------------------------
+                  ! Ice salinities, temperature and heat content 
+                  !-----------------------------------------------
+
+                  DO jk = 1, nlay_i
+                     t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
+                     s_i(ji,jj,jk,jl) = zidto(ji,jj) * sinn + ( 1.0 - zidto(ji,jj) ) * 0.1
+                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+
+                     ! heat content per unit volume
+                     e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * &
+                        (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                        +   lfus    * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) &
+                        - rcp      * ( ztmelts - rtt ) &
+                        )
+
+                     ! Correct dimensions to avoid big values
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
+
+                     ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 
+                        area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / &
+                        nlay_i
+                  END DO ! jk
+
+               END DO ! jl 
+
+            ELSE ! on fcor 
+
+               !--- Southern hemisphere
+               !----------------------------------------------------------------
+
+               !-----------------------
+               ! Ice area / thickness
+               !-----------------------
+
+               IF ( jpl .EQ. 1) THEN ! one category
+
+                  DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) ! loop over ice thickness categories
+                     a_i(ji,jj,jl)    = zidto(ji,jj) * agins_u
+                     ht_i(ji,jj,jl)   = zidto(ji,jj) * hgins_u
+                     v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+                  END DO
+
+               ELSE ! several categories
+
+                  !level ice
+                  DO jl = ice_cat_bounds(1,1), ice_cat_bounds(1,2) !over thickness categories
+
+                     zhis(1)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+                     a_i(ji,jj,jl) = zidto(ji,jj) * MAX( zgfactors(1) * exp(-(zhis(1)-hgins_u) * & 
+                        (zhis(1)-hgins_u)/2.0) , epsi06 )
+                     ! new line square distribution volume conserving
+                     a_i(ji,jj,jl)    = zidto(ji,jj) * ( zas * zhis(1) * zhis(1) + zbs * zhis(1) )
+                     ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(1) 
+                     v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+
+                  END DO ! jl
+
+               ENDIF
+
+!!!
+               ! retour a LIMA_MEC
+               !              !ridged ice
+               !              zdummy  = hi_max(ice_cat_bounds(2,1)-1)
+               !              hi_max(ice_cat_bounds(2,1)-1) = 0.0
+               !              DO jl = ice_cat_bounds(2,1), ice_cat_bounds(2,2) !over thickness categories
+               !                 zhis(2)       = ( hi_max(jl-1) + hi_max(jl) ) / 2.0
+               !                 a_i(ji,jj,jl) = zidto(ji,jj)*MAX( zgfactors(2)   &
+               !                    &          * exp(-(zhis(2)-hgins_d)*(zhis(2)-hgins_d)/2.0), epsi06 )
+               !                 ht_i(ji,jj,jl)   = zidto(ji,jj) * zhis(2) 
+               !                 v_i(ji,jj,jl)    = ht_i(ji,jj,jl)*a_i(ji,jj,jl)
+               !              END DO
+               !              hi_max(ice_cat_bounds(2,1)-1) = zdummy
+
+               !              !rafted ice
+               !              jl = 6
+               !              a_i(ji,jj,jl)       = 0.0
+               !              ht_i(ji,jj,jl)      = 0.0
+               !              v_i(ji,jj,jl)       = 0.0
+               ! END retour a LIMA_MEC
+!!!
+
+               DO jl = 1, jpl !over thickness categories
+
+                  !---------------
+                  ! Snow depth
+                  !---------------
+
+                  ht_s(ji,jj,jl)   = zidto(ji,jj) * hnins
+                  v_s(ji,jj,jl)    = ht_s(ji,jj,jl)*a_i(ji,jj,jl)
+
+                  !---------------
+                  ! Ice salinity
+                  !---------------
+
+                  sm_i(ji,jj,jl)   = zidto(ji,jj) * sins  + ( 1.0 - zidto(ji,jj) ) * 0.1
+                  smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl)
+
+                  !----------
+                  ! Ice age
+                  !----------
+
+                  o_i(ji,jj,jl)    = zidto(ji,jj) * 1.0   + ( 1.0 - zidto(ji,jj) )
+                  oa_i(ji,jj,jl)   = o_i(ji,jj,jl) * a_i(ji,jj,jl)
+
+                  !------------------------------
+                  ! Sea ice surface temperature
+                  !------------------------------
+
+                  t_su(ji,jj,jl)   = zidto(ji,jj) * 270.0 + ( 1.0 - zidto(ji,jj) ) * t_bo(ji,jj)
+
+                  !----------------------------------
+                  ! Snow temperature / heat content
+                  !----------------------------------
+
+                  DO jk = 1, nlay_s
+                     t_s(ji,jj,jk,jl) = zidto(ji,jj) * 270.00 + ( 1.0 - zidto(ji,jj) ) * rtt
+                     ! Snow energy of melting
+                     e_s(ji,jj,jk,jl) = zidto(ji,jj) * rhosn * ( cpic * ( rtt - t_s(ji,jj,jk,jl) ) + lfus )
+                     ! Change dimensions
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / unit_fac
+                     ! Multiply by volume, so that heat content in 10^9 Joules
+                     e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * area(ji,jj) * &
+                        v_s(ji,jj,jl)  / nlay_s
+                  END DO
+
+                  !---------------------------------------------
+                  ! Ice temperature, salinity and heat content
+                  !---------------------------------------------
+
+                  DO jk = 1, nlay_i
+                     t_i(ji,jj,jk,jl) = zidto(ji,jj)*270.00 + ( 1.0 - zidto(ji,jj) ) * rtt 
+                     s_i(ji,jj,jk,jl) = zidto(ji,jj) * sins + ( 1.0 - zidto(ji,jj) ) * 0.1
+                     ztmelts          = - tmut * s_i(ji,jj,jk,jl) + rtt !Melting temperature in K
+
+                     ! heat content per unit volume
+                     e_i(ji,jj,jk,jl) = zidto(ji,jj) * rhoic * &
+                        (   cpic    * ( ztmelts - t_i(ji,jj,jk,jl) ) &
+                        +   lfus  * ( 1.0 - (ztmelts-rtt) / MIN((t_i(ji,jj,jk,jl)-rtt),-zeps) ) &
+                        - rcp      * ( ztmelts - rtt ) &
+                        )
+
+                     ! Correct dimensions to avoid big values
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / unit_fac 
+
+                     ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J
+                     e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * & 
+                        area(ji,jj) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) / &
+                        nlay_i
+                  END DO !jk
+
+               END DO ! jl 
+
+            ENDIF ! on fcor
+
+         END DO
+      END DO
+
+      !--------------------------------------------------------------------
+      ! 3) Global ice variables for output diagnostics                    | 
+      !--------------------------------------------------------------------
+
+      fsbbq (:,:)     = 0.e0
+      u_ice (:,:)     = 0.e0
+      v_ice (:,:)     = 0.e0
+      stress1_i(:,:)  = 0.0
+      stress2_i(:,:)  = 0.0
+      stress12_i(:,:) = 0.0
+
+      !--------------------------------------------------------------------
+      ! 4) Moments for advection
+      !--------------------------------------------------------------------
+
+      sxopw (:,:) = 0.e0 
+      syopw (:,:) = 0.e0 
+      sxxopw(:,:) = 0.e0 
+      syyopw(:,:) = 0.e0 
+      sxyopw(:,:) = 0.e0
+
+      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   ;   sxe  (:,:,:,:)= 0.e0   
+      syc0  (:,:,:)  = 0.e0   ;   sye  (:,:,:,:)= 0.e0   
+      sxxc0 (:,:,:)  = 0.e0   ;   sxxe (:,:,:,:)= 0.e0   
+      syyc0 (:,:,:)  = 0.e0   ;   syye (:,:,:,:)= 0.e0   
+      sxyc0 (:,:,:)  = 0.e0   ;   sxye (:,:,:,:)= 0.e0   
+
+      sxsal  (:,:,:)  = 0.e0
+      sysal  (:,:,:)  = 0.e0
+      sxxsal (:,:,:)  = 0.e0
+      syysal (:,:,:)  = 0.e0
+      sxysal (:,:,:)  = 0.e0
+
+      !--------------------------------------------------------------------
+      ! 5) Lateral boundary conditions                                    | 
+      !--------------------------------------------------------------------
+
+      DO jl = 1, jpl
+         CALL lbc_lnk( a_i(:,:,jl)  , 'T', 1. )
+         CALL lbc_lnk( v_i(:,:,jl)  , 'T', 1. )
+         CALL lbc_lnk( v_s(:,:,jl)  , 'T', 1. )
+         CALL lbc_lnk( smv_i(:,:,jl), 'T', 1. )
+         CALL lbc_lnk( oa_i(:,:,jl) , 'T', 1. )
+         !
+         CALL lbc_lnk( ht_i(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( ht_s(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( sm_i(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( o_i(:,:,jl)  , 'T', 1. )
+         CALL lbc_lnk( t_su(:,:,jl) , 'T', 1. )
+         DO jk = 1, nlay_s
+            CALL lbc_lnk(t_s(:,:,jk,jl), 'T', 1. )
+            CALL lbc_lnk(e_s(:,:,jk,jl), 'T', 1. )
+         END DO
+         DO jk = 1, nlay_i
+            CALL lbc_lnk(t_i(:,:,jk,jl), 'T', 1. )
+            CALL lbc_lnk(e_i(:,:,jk,jl), 'T', 1. )
+         END DO
+         !
+         a_i(:,:,jl) = tms(:,:) * a_i(:,:,jl)
+      END DO
+
+      CALL lbc_lnk( at_i , 'T', 1. )
+      at_i(:,:) = tms(:,:) * at_i(:,:)                       ! put 0 over land
+      !
+      CALL lbc_lnk( fsbbq  , 'T', 1. )
+      !
+      CALL wrk_dealloc( jpm, zgfactorn, zgfactors, zhin, zhis )
+      CALL wrk_dealloc( jpi, jpj, zidto )
+      !
+   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
+      !!-----------------------------------------------------------------------------
+      NAMELIST/namiceini/ ttest, hninn, hginn_u, aginn_u, hginn_d, aginn_d, hnins,   &
+         &                hgins_u, agins_u, hgins_d, agins_d, sinn, sins
+      !!-----------------------------------------------------------------------------
+      !
+      REWIND ( numnam_ice )               ! Read Namelist namiceini 
+      READ   ( numnam_ice , namiceini )
+      !
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_istate_init : 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 undef ice thickness in the north     hginn_u    = ', hginn_u
+         WRITE(numout,*) '   initial undef ice concentr. in the north     aginn_u    = ', aginn_u          
+         WRITE(numout,*) '   initial  def  ice thickness in the north     hginn_d    = ', hginn_d
+         WRITE(numout,*) '   initial  def  ice concentr. in the north     aginn_d    = ', aginn_d          
+         WRITE(numout,*) '   initial snow thickness in the south          hnins      = ', hnins 
+         WRITE(numout,*) '   initial undef ice thickness in the north     hgins_u    = ', hgins_u
+         WRITE(numout,*) '   initial undef ice concentr. in the north     agins_u    = ', agins_u          
+         WRITE(numout,*) '   initial  def  ice thickness in the north     hgins_d    = ', hgins_d
+         WRITE(numout,*) '   initial  def  ice concentr. in the north     agins_d    = ', agins_d          
+         WRITE(numout,*) '   initial  ice salinity       in the north     sinn       = ', sinn
+         WRITE(numout,*) '   initial  ice salinity       in the south     sins       = ', sins
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90	(revision 3437)
@@ -0,0 +1,1584 @@
+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 & fsalt_rpo
+   !!            4.0  ! 2011-02  (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                    LIM3 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 par_ice          ! LIM parameters
+   USE dom_ice          ! LIM domain
+   USE limthd_lac       ! LIM
+   USE limvar           ! LIM
+   USE limcons          ! LIM
+   USE in_out_manager   ! I/O manager
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE prtctl           ! Print control
+
+   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_zapsmall
+   PUBLIC   lim_itd_me_alloc        ! called by iceini.F90
+
+   REAL(wp)  ::   epsi11 = 1.e-11_wp   ! constant values
+   REAL(wp)  ::   epsi10 = 1.e-10_wp   ! constant values
+   REAL(wp)  ::   epsi06 = 1.e-06_wp   ! constant values
+
+   !-----------------------------------------------------------------------
+   ! Variables shared among ridging subroutines
+   !-----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   asum     ! sum of total ice and open water area
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aksum    ! ratio of area removed to area ridged
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   athorn   ! participation function; fraction of ridging/
+   !                                                           !  closing associated w/ category n
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmin    ! minimum ridge thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hrmax    ! maximum ridge thickness
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hraft    ! thickness of rafted ice
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   krdg     ! mean ridge thickness/thickness of ridging ice 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aridge   ! participating ice ridging
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   araft    ! participating ice rafting
+
+   REAL(wp), PARAMETER ::   krdgmin = 1.1_wp    ! min ridge thickness multiplier
+   REAL(wp), PARAMETER ::   kraft   = 2.0_wp    ! rafting multipliyer
+
+   REAL(wp) ::   Cp                             ! 
+   !
+   !-----------------------------------------------------------------------
+   ! Ridging diagnostic arrays for history files
+   !-----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg1dt   ! rate of fractional area loss by ridging ice (1/s)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dardg2dt   ! rate of fractional area gain by new ridges (1/s)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dvirdgdt   ! rate of ice volume ridged (m/s)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   opening    ! rate of opening due to divergence/shear (1/s)
+   !!----------------------------------------------------------------------
+   !! 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) ,     &
+         !
+         !* Ridging diagnostic arrays for history files
+         &      dardg1dt(jpi,jpj)  , dardg2dt(jpi,jpj)                        ,     & 
+         &      dvirdgdt(jpi,jpj)  , opening(jpi,jpj)                         , 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, nitermax = 20   ! local integer 
+      LOGICAL  ::   asum_error              ! flag for asum .ne. 1
+      INTEGER  ::   iterate_ridging         ! if true, repeat the ridging
+      REAL(wp) ::   w1, tmpfac, dti         ! local scalar
+      CHARACTER (len = 15) ::   fieldid
+      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_net     ! net rate at which area is removed    (1/s)
+                                                             ! (ridging ice area - area of new ridges) / dt
+      REAL(wp), POINTER, DIMENSION(:,:) ::   divu_adv        ! divu as implied by transport scheme  (1/s)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   opning          ! rate of opening due to divergence/shear
+      REAL(wp), POINTER, DIMENSION(:,:) ::   closing_gross   ! rate at which area removed, not counting area of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   msnow_mlt       ! mass of snow added to ocean (kg m-2)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   esnow_mlt       ! energy needed to melt snow in ocean (J m-2)
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vt_i_init, vt_i_final  !  ice volume summed over categories
+      !!-----------------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+
+      IF( numit == nstart  )   CALL lim_itd_me_init   ! Initialization (first time-step only)
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=ato_i , clinfo1=' lim_itd_me: ato_i  : ', tab2d_2=at_i   , clinfo2=' at_i    : ')
+         CALL prt_ctl(tab2d_1=divu_i, clinfo1=' lim_itd_me: divu_i : ', tab2d_2=delta_i, clinfo2=' delta_i : ')
+      ENDIF
+
+      !-----------------------------------------------------------------------------!
+      ! 1) Thickness categories boundaries, ice / o.w. concentrations, init_ons
+      !-----------------------------------------------------------------------------!
+      ! Set hi_max(ncat) to a big value to ensure that all ridged ice 
+      ! is thinner than hi_max(ncat).
+
+      hi_max(jpl) = 999.99
+
+      Cp = 0.5 * grav * (rau0-rhoic) * rhoic / rau0      ! proport const for PE
+      CALL lim_itd_me_ridgeprep ! prepare ridging
+
+      IF( con_i)   CALL lim_column_sum( jpl, v_i, vt_i_init )      ! conservation check
+
+      DO jj = 1, jpj                                     ! Initialize arrays.
+         DO ji = 1, jpi
+            msnow_mlt(ji,jj) = 0._wp
+            esnow_mlt(ji,jj) = 0._wp
+            dardg1dt (ji,jj)  = 0._wp
+            dardg2dt (ji,jj)  = 0._wp
+            dvirdgdt (ji,jj)  = 0._wp
+            opening  (ji,jj)  = 0._wp
+
+            !-----------------------------------------------------------------------------!
+            ! 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) = 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) ) / rdt_ice  ! 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 )
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               ! 3.2 closing_gross
+               !-----------------------------------------------------------------------------!
+               ! Based on the ITD of ridging and ridged ice, convert the net
+               !  closing rate to a gross closing rate.  
+               ! NOTE: 0 < aksum <= 1
+               closing_gross(ji,jj) = closing_net(ji,jj) / aksum(ji,jj)
+
+               ! correction to closing rate and opening if closing rate is excessive
+               !---------------------------------------------------------------------
+               ! Reduce the closing rate if more than 100% of the open water 
+               ! would be removed.  Reduce the opening rate proportionately.
+               IF ( ato_i(ji,jj) .GT. epsi11 .AND. athorn(ji,jj,0) .GT. 0.0 ) THEN
+                  w1 = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice
+                  IF ( w1 .GT. ato_i(ji,jj)) THEN
+                     tmpfac = ato_i(ji,jj) / w1
+                     closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
+                     opning(ji,jj) = opning(ji,jj) * tmpfac
+                  ENDIF !w1
+               ENDIF !at0i and athorn
+
+            END DO ! ji
+         END DO ! jj
+
+         ! 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
+                  IF ( a_i(ji,jj,jl) > epsi11 .AND. athorn(ji,jj,jl) > 0._wp )THEN
+                     w1 = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice
+                     IF ( w1 > a_i(ji,jj,jl) ) THEN
+                        tmpfac = a_i(ji,jj,jl) / w1
+                        closing_gross(ji,jj) = closing_gross(ji,jj) * tmpfac
+                        opning       (ji,jj) = opning       (ji,jj) * tmpfac
+                     ENDIF
+                  ENDIF
+               END DO !ji
+            END DO ! jj
+         END DO !jl
+
+         ! 3.3 Redistribute area, volume, and energy.
+         !-----------------------------------------------------------------------------!
+
+         CALL lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt )
+
+         ! 3.4 Compute total area of ice plus open water after ridging.
+         !-----------------------------------------------------------------------------!
+
+         CALL lim_itd_me_asumr
+
+         ! 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.0) .LT. epsi11) THEN
+                  closing_net(ji,jj) = 0._wp
+                  opning     (ji,jj) = 0._wp
+               ELSE
+                  iterate_ridging    = 1
+                  divu_adv   (ji,jj) = (1._wp - asum(ji,jj)) / rdt_ice
+                  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
+            IF( niter .GT. nitermax ) THEN
+               WRITE(numout,*) ' ALERTE : non-converging ridging scheme '
+               WRITE(numout,*) ' niter, iterate_ridging ', niter, iterate_ridging
+            ENDIF
+            CALL lim_itd_me_ridgeprep
+         ENDIF
+
+      END DO !! on the do while over iter
+
+      !-----------------------------------------------------------------------------!
+      ! 4) Ridging diagnostics
+      !-----------------------------------------------------------------------------!
+      ! Convert ridging rate diagnostics to correct units.
+      ! Update fresh water and heat fluxes due to snow melt.
+
+      dti = 1._wp / rdt_ice
+
+      asum_error = .false. 
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) asum_error = .true.
+
+            dardg1dt(ji,jj) = dardg1dt(ji,jj) * dti
+            dardg2dt(ji,jj) = dardg2dt(ji,jj) * dti
+            dvirdgdt(ji,jj) = dvirdgdt(ji,jj) * dti
+            opening (ji,jj) = opening (ji,jj) * dti
+
+            !-----------------------------------------------------------------------------!
+            ! 5) Heat, salt and freshwater fluxes
+            !-----------------------------------------------------------------------------!
+            fmmec(ji,jj) = fmmec(ji,jj) + msnow_mlt(ji,jj) * dti     ! fresh water source for ocean
+            fhmec(ji,jj) = fhmec(ji,jj) + esnow_mlt(ji,jj) * dti     ! heat sink for ocean
+
+         END DO
+      END DO
+
+      ! Check if there is a ridging error
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF (ABS(asum(ji,jj) - 1.0) .GT. epsi11) THEN ! there is a bug
+               WRITE(numout,*) ' '
+               WRITE(numout,*) ' ALERTE : Ridging error: total area = ', asum(ji,jj)
+               WRITE(numout,*) ' limitd_me '
+               WRITE(numout,*) ' POINT : ', ji, jj
+               WRITE(numout,*) ' jpl, a_i, athorn '
+               WRITE(numout,*) 0, ato_i(ji,jj), athorn(ji,jj,0)
+               DO jl = 1, jpl
+                  WRITE(numout,*) jl, a_i(ji,jj,jl), athorn(ji,jj,jl)
+               END DO
+            ENDIF  ! asum
+
+         END DO !ji
+      END DO !jj
+
+      ! Conservation check
+      IF ( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vt_i_final)
+         fieldid = ' v_i : limitd_me '
+         CALL lim_cons_check (vt_i_init, vt_i_final, 1.0e-6, fieldid) 
+      ENDIF
+
+      !-----------------------------------------------------------------------------!
+      ! 6) Updating state variables and trend terms
+      !-----------------------------------------------------------------------------!
+
+      CALL lim_var_glo2eqv
+      CALL lim_itd_me_zapsmall
+
+      !-----------------
+      !  Trend terms
+      !-----------------
+
+      d_u_ice_dyn(:,:)     = u_ice(:,:)     - old_u_ice(:,:)
+      d_v_ice_dyn(:,:)     = v_ice(:,:)     - old_v_ice(:,:)
+      d_a_i_trp  (:,:,:)   = a_i  (:,:,:)   - old_a_i  (:,:,:)
+      d_v_s_trp  (:,:,:)   = v_s  (:,:,:)   - old_v_s  (:,:,:)  
+      d_v_i_trp  (:,:,:)   = v_i  (:,:,:)   - old_v_i  (:,:,:)   
+      d_e_s_trp  (:,:,:,:) = e_s  (:,:,:,:) - old_e_s  (:,:,:,:)  
+      d_e_i_trp  (:,:,:,:) = e_i  (:,:,:,:) - old_e_i  (:,:,:,:)
+      d_oa_i_trp (:,:,:)   = oa_i (:,:,:)   - old_oa_i (:,:,:)
+      d_smv_i_trp(:,:,:)   = 0._wp
+      IF(  num_sal == 2  .OR.  num_sal == 4  )   d_smv_i_trp(:,:,:)  = smv_i(:,:,:) - old_smv_i(:,:,:)
+
+      IF(ln_ctl) THEN     ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_me  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_me  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_me  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_me  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_me  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_me  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_me  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_me  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_me  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_me  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_me  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_me  : smv_i    : ')
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_me  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_me  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
+
+      !-------------------------!
+      ! Back to initial values
+      !-------------------------!
+
+      ! update of fields will be made later in lim update
+      u_ice(:,:)    = old_u_ice(:,:)
+      v_ice(:,:)    = old_v_ice(:,:)
+      a_i(:,:,:)    = old_a_i(:,:,:)
+      v_s(:,:,:)    = old_v_s(:,:,:)
+      v_i(:,:,:)    = old_v_i(:,:,:)
+      e_s(:,:,:,:)  = old_e_s(:,:,:,:)
+      e_i(:,:,:,:)  = old_e_i(:,:,:,:)
+      oa_i(:,:,:)   = old_oa_i(:,:,:)
+      IF(  num_sal == 2  .OR.  num_sal == 4  )   smv_i(:,:,:)  = old_smv_i(:,:,:)
+
+      !----------------------------------------------------!
+      ! Advection of ice in a free cell, newly ridged ice
+      !----------------------------------------------------!
+
+      ! to allow for thermodynamics to melt new ice
+      ! we immediately advect ice in free cells
+
+      ! heat content has to be corrected before ice volume
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. &
+                     ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN
+                     old_e_i(ji,jj,jk,jl)   = d_e_i_trp(ji,jj,jk,jl)
+                     d_e_i_trp(ji,jj,jk,jl) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ( old_v_i(ji,jj,jl) < epsi06 ) .AND. &
+                  ( d_v_i_trp(ji,jj,jl) > epsi06 ) ) THEN
+                  old_v_i(ji,jj,jl)     = d_v_i_trp(ji,jj,jl)
+                  d_v_i_trp(ji,jj,jl)   = 0._wp
+                  old_a_i(ji,jj,jl)     = d_a_i_trp(ji,jj,jl)
+                  d_a_i_trp(ji,jj,jl)   = 0._wp
+                  old_v_s(ji,jj,jl)     = d_v_s_trp(ji,jj,jl)
+                  d_v_s_trp(ji,jj,jl)   = 0._wp
+                  old_e_s(ji,jj,1,jl)   = d_e_s_trp(ji,jj,1,jl)
+                  d_e_s_trp(ji,jj,1,jl) = 0._wp
+                  old_oa_i(ji,jj,jl)    = d_oa_i_trp(ji,jj,jl)
+                  d_oa_i_trp(ji,jj,jl)  = 0._wp
+                  IF(  num_sal == 2  .OR.  num_sal == 4  )   old_smv_i(ji,jj,jl)   = d_smv_i_trp(ji,jj,jl)
+                  d_smv_i_trp(ji,jj,jl) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      CALL wrk_dealloc( jpi, jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final )
+      !
+   END SUBROUTINE lim_itd_me
+
+
+   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) ::   hi, zw1, zp, zdummy, zzc, z1_3   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zworka   ! temporary array used here
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zworka )
+
+      !------------------------------------------------------------------------------!
+      ! 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(  a_i(ji,jj,jl)    > epsi11  .AND.     &
+                       athorn(ji,jj,jl) > 0._wp   ) THEN
+                     hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                     !----------------------------
+                     ! PE loss from deforming ice
+                     !----------------------------
+                     strength(ji,jj) = strength(ji,jj) - athorn(ji,jj,jl) * hi * hi
+
+                     !--------------------------
+                     ! PE gain from rafting ice
+                     !--------------------------
+                     strength(ji,jj) = strength(ji,jj) + 2._wp * araft(ji,jj,jl) * hi * hi
+
+                     !----------------------------
+                     ! PE gain from ridging ice
+                     !----------------------------
+                     strength(ji,jj) = strength(ji,jj) + aridge(ji,jj,jl)/krdg(ji,jj,jl)     &
+                        * z1_3 * (hrmax(ji,jj,jl)**3 - hrmin(ji,jj,jl)**3) / ( hrmax(ji,jj,jl)-hrmin(ji,jj,jl) )   
+!!gm Optimization:  (a**3-b**3)/(a-b) = a*a+ab+b*b   ==> less costly operations even if a**3 is replaced by a*a*a...                    
+                  ENDIF            ! aicen > epsi11
+                  !
+               END DO ! ji
+            END DO !jj
+         END DO !jl
+
+         zzc = Cf * Cp     ! where Cp = (g/2)*(rhow-rhoi)*(rhoi/rhow) and Cf accounts for frictional dissipation
+         strength(:,:) = zzc * strength(:,:) / aksum(:,:)
+
+         ksmooth = 1
+
+         !------------------------------------------------------------------------------!
+         ! 4) Hibler (1979)' method
+         !------------------------------------------------------------------------------!
+      ELSE                      ! kstrngth ne 1:  Hibler (1979) form
+         !
+         strength(:,:) = Pstar * vt_i(:,:) * EXP( - C_rhg * ( 1._wp - at_i(:,:) )  )
+         !
+         ksmooth = 1
+         !
+      ENDIF                     ! kstrngth
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 5) Impact of brine volume
+      !------------------------------------------------------------------------------!
+      ! CAN BE REMOVED
+      !
+      IF ( brinstren_swi == 1 ) THEN
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( bv_i(ji,jj) .GT. 0.0 ) THEN
+                  zdummy = MIN ( bv_i(ji,jj), 0.10 ) * MIN( bv_i(ji,jj), 0.10 )
+               ELSE
+                  zdummy = 0.0
+               ENDIF
+               strength(ji,jj) = strength(ji,jj) * exp(-5.88*SQRT(MAX(bv_i(ji,jj),0.0)))
+            END DO              ! j
+         END DO                 ! i
+
+      ENDIF
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 6) Smoothing ice strength
+      !------------------------------------------------------------------------------!
+      !
+      !-------------------
+      ! Spatial smoothing
+      !-------------------
+      IF ( ksmooth == 1 ) THEN
+
+         CALL lbc_lnk( strength, 'T', 1. )
+
+         DO jj = 2, jpj - 1
+            DO ji = 2, jpi - 1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN ! ice is
+                  ! present
+                  zworka(ji,jj) = 4.0 * strength(ji,jj)              &
+                     + strength(ji-1,jj) * tms(ji-1,jj) &  
+                     + strength(ji+1,jj) * tms(ji+1,jj) &  
+                     + strength(ji,jj-1) * tms(ji,jj-1) &  
+                     + strength(ji,jj+1) * tms(ji,jj+1)    
+
+                  zw1 = 4.0 + tms(ji-1,jj) + tms(ji+1,jj) + tms(ji,jj-1) + tms(ji,jj+1)
+                  zworka(ji,jj) = zworka(ji,jj) / zw1
+               ELSE
+                  zworka(ji,jj) = 0.0
+               ENDIF
+            END DO
+         END DO
+
+         DO jj = 2, jpj - 1
+            DO ji = 2, jpi - 1
+               strength(ji,jj) = zworka(ji,jj)
+            END DO
+         END DO
+         CALL lbc_lnk( strength, 'T', 1. )
+
+      ENDIF ! ksmooth
+
+      !--------------------
+      ! Temporal smoothing
+      !--------------------
+      IF ( numit == nit000 + nn_fsbc - 1 ) THEN
+         strp1(:,:) = 0.0            
+         strp2(:,:) = 0.0            
+      ENDIF
+
+      IF ( ksmooth == 2 ) THEN
+
+
+         CALL lbc_lnk( strength, 'T', 1. )
+
+         DO jj = 1, jpj - 1
+            DO ji = 1, jpi - 1
+               IF ( ( asum(ji,jj) - ato_i(ji,jj) ) .GT. epsi11) THEN       ! ice is present
+                  numts_rm = 1 ! number of time steps for the running mean
+                  IF ( strp1(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
+                  IF ( strp2(ji,jj) .GT. 0.0 ) numts_rm = numts_rm + 1
+                  zp = ( strength(ji,jj) + strp1(ji,jj) + strp2(ji,jj) ) / numts_rm
+                  strp2(ji,jj) = strp1(ji,jj)
+                  strp1(ji,jj) = strength(ji,jj)
+                  strength(ji,jj) = zp
+
+               ENDIF
+            END DO
+         END DO
+
+      ENDIF ! ksmooth
+
+      CALL lbc_lnk( strength, 'T', 1. )      ! Boundary conditions
+
+      CALL wrk_dealloc( jpi, jpj, zworka )
+      !
+   END SUBROUTINE lim_itd_me_icestrength
+
+
+   SUBROUTINE lim_itd_me_ridgeprep
+      !!---------------------------------------------------------------------!
+      !!                ***  ROUTINE lim_itd_me_ridgeprep ***
+      !!
+      !! ** Purpose :   preparation for ridging and strength calculations
+      !!
+      !! ** Method  :   Compute the thickness distribution of the ice and open water 
+      !!              participating in ridging and of the resulting ridges.
+      !!---------------------------------------------------------------------!
+      INTEGER ::   ji,jj, jl    ! dummy loop indices
+      INTEGER ::   krdg_index   ! 
+      REAL(wp) ::   Gstari, astari, hi, hrmean, zdummy   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zworka    ! temporary array used here
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   Gsum      ! Gsum(n) = sum of areas in categories 0 to n
+      !------------------------------------------------------------------------------!
+
+      CALL wrk_alloc( jpi,jpj, zworka )
+      CALL wrk_alloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+
+      Gstari     = 1.0/Gstar    
+      astari     = 1.0/astar    
+      aksum(:,:)    = 0.0
+      athorn(:,:,:) = 0.0
+      aridge(:,:,:) = 0.0
+      araft (:,:,:) = 0.0
+      hrmin(:,:,:)  = 0.0 
+      hrmax(:,:,:)  = 0.0 
+      hraft(:,:,:)  = 0.0 
+      krdg (:,:,:)  = 1.0
+
+      !     ! Zero out categories with very small areas
+      CALL lim_itd_me_zapsmall
+
+      !------------------------------------------------------------------------------!
+      ! 1) Participation function 
+      !------------------------------------------------------------------------------!
+
+      ! Compute total area of ice plus open water.
+      CALL lim_itd_me_asumr
+      ! This is in general not equal to one 
+      ! because of divergence during transport
+
+      ! 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
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ato_i(ji,jj) > epsi11 ) THEN   ;   Gsum(ji,jj,0) = ato_i(ji,jj)
+            ELSE                               ;   Gsum(ji,jj,0) = 0._wp
+            ENDIF
+         END DO
+      END DO
+
+      ! for each value of h, you have to add ice concentration then
+      DO jl = 1, jpl
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               IF( a_i(ji,jj,jl) .GT. epsi11 ) THEN   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl)
+               ELSE                                   ;   Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1)
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Normalize the cumulative distribution to 1
+      zworka(:,:) = 1._wp / Gsum(:,:,jpl)
+      DO jl = 0, jpl
+         Gsum(:,:,jl) = Gsum(:,:,jl) * zworka(:,:)
+      END DO
+
+      ! 1.3 Compute participation function a(h) = b(h).g(h) (athorn)
+      !--------------------------------------------------------------------------------------------------
+      ! Compute the participation function athorn; this is analogous to
+      ! a(h) = b(h)g(h) as defined in Thorndike et al. (1975).
+      ! area lost from category n due to ridging/closing
+      ! athorn(n)   = total area lost due to ridging/closing
+      ! assume b(h) = (2/Gstar) * (1 - G(h)/Gstar). 
+      !
+      ! The expressions for athorn are found by integrating b(h)g(h) between
+      ! the category boundaries.
+      !-----------------------------------------------------------------
+
+      krdg_index = 1
+
+      IF( krdg_index == 0 ) THEN       !--- Linear formulation (Thorndike et al., 1975)
+         DO jl = 0, ice_cat_bounds(1,2)       ! only undeformed ice participates
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  IF( Gsum(ji,jj,jl) < Gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * (Gsum(ji,jj,jl)-Gsum(ji,jj,jl-1)) * &
+                        (2.0 - (Gsum(ji,jj,jl-1)+Gsum(ji,jj,jl))*Gstari)
+                  ELSEIF (Gsum(ji,jj,jl-1) < Gstar) THEN
+                     athorn(ji,jj,jl) = Gstari * (Gstar-Gsum(ji,jj,jl-1)) *  &
+                        (2.0 - (Gsum(ji,jj,jl-1)+Gstar)*Gstari)
+                  ELSE
+                     athorn(ji,jj,jl) = 0.0
+                  ENDIF
+               END DO ! ji
+            END DO ! jj
+         END DO ! jl 
+
+      ELSE                             !--- Exponential, more stable formulation (Lipscomb et al, 2007)
+         !                        
+         zdummy = 1._wp / ( 1._wp - EXP(-astari) )        ! precompute exponential terms using Gsum as a work array
+
+         DO jl = -1, jpl
+            Gsum(:,:,jl) = EXP( -Gsum(:,:,jl) * astari ) * zdummy
+         END DO !jl
+         DO jl = 0, ice_cat_bounds(1,2)
+             athorn(:,:,jl) = Gsum(:,:,jl-1) - Gsum(:,:,jl)
+         END DO
+         !
+      ENDIF ! krdg_index
+
+      IF( raftswi == 1 ) THEN      ! Ridging and rafting ice participation functions
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  IF ( athorn(ji,jj,jl) .GT. 0._wp ) THEN
+!!gm  TANH( -X ) = - TANH( X )  so can be computed only 1 time....
+                     aridge(ji,jj,jl) = ( TANH (  Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     araft (ji,jj,jl) = ( TANH ( -Craft * ( ht_i(ji,jj,jl) - hparmeter ) ) + 1.0 ) * 0.5 * athorn(ji,jj,jl)
+                     IF ( araft(ji,jj,jl) < epsi06 )   araft(ji,jj,jl)  = 0._wp
+                     aridge(ji,jj,jl) = MAX( athorn(ji,jj,jl) - araft(ji,jj,jl), 0.0 )
+                  ENDIF ! athorn
+               END DO ! ji
+            END DO ! jj
+         END DO ! jl
+
+      ELSE  ! raftswi = 0
+         !
+         DO jl = 1, jpl
+            aridge(:,:,jl) = athorn(:,:,jl)
+         END DO
+         !
+      ENDIF
+
+      IF ( raftswi == 1 ) THEN
+
+         IF( MAXVAL(aridge + araft - athorn(:,:,1:jpl)) .GT. epsi11 ) THEN
+            DO jl = 1, jpl
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF ( aridge(ji,jj,jl) + araft(ji,jj,jl) - athorn(ji,jj,jl) .GT. &
+                        epsi11 ) THEN
+                        WRITE(numout,*) ' ALERTE 96 : wrong participation function ... '
+                        WRITE(numout,*) ' ji, jj, jl : ', ji, jj, jl
+                        WRITE(numout,*) ' lat, lon   : ', gphit(ji,jj), glamt(ji,jj)
+                        WRITE(numout,*) ' aridge     : ', aridge(ji,jj,1:jpl)
+                        WRITE(numout,*) ' araft      : ', araft(ji,jj,1:jpl)
+                        WRITE(numout,*) ' athorn     : ', athorn(ji,jj,1:jpl)
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+      ENDIF
+
+      !-----------------------------------------------------------------
+      ! 2) Transfer function
+      !-----------------------------------------------------------------
+      ! Compute max and min ridged ice thickness for each ridging category.
+      ! Assume ridged ice is uniformly distributed between hrmin and hrmax.
+      ! 
+      ! This parameterization is a modified version of Hibler (1980).
+      ! The mean ridging thickness, hrmean, is proportional to hi^(0.5)
+      !  and for very thick ridging ice must be >= krdgmin*hi
+      !
+      ! The minimum ridging thickness, hrmin, is equal to 2*hi 
+      !  (i.e., rafting) and for very thick ridging ice is
+      !  constrained by hrmin <= (hrmean + hi)/2.
+      ! 
+      ! The maximum ridging thickness, hrmax, is determined by
+      !  hrmean and hrmin.
+      !
+      ! These modifications have the effect of reducing the ice strength
+      ! (relative to the Hibler formulation) when very thick ice is
+      ! ridging.
+      !
+      ! aksum = net area removed/ total area removed
+      ! where total area removed = area of ice that ridges
+      !         net area removed = total area removed - area of new ridges
+      !-----------------------------------------------------------------
+
+      ! Transfer function
+      DO jl = 1, jpl !all categories have a specific transfer function
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               IF (a_i(ji,jj,jl) .GT. epsi11 .AND. athorn(ji,jj,jl) .GT. 0.0 ) THEN
+                  hi = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                  hrmean          = MAX(SQRT(Hstar*hi), hi*krdgmin)
+                  hrmin(ji,jj,jl) = MIN(2.0*hi, 0.5*(hrmean + hi))
+                  hrmax(ji,jj,jl) = 2.0*hrmean - hrmin(ji,jj,jl)
+                  hraft(ji,jj,jl) = kraft*hi
+                  krdg(ji,jj,jl)  = hrmean / hi
+               ELSE
+                  hraft(ji,jj,jl) = 0.0
+                  hrmin(ji,jj,jl) = 0.0 
+                  hrmax(ji,jj,jl) = 0.0 
+                  krdg (ji,jj,jl) = 1.0
+               ENDIF
+
+            END DO ! ji
+         END DO ! jj
+      END DO ! jl
+
+      ! Normalization factor : aksum, ensures mass conservation
+      aksum(:,:) = athorn(:,:,0)
+      DO jl = 1, jpl 
+         aksum(:,:)    = aksum(:,:) + aridge(:,:,jl) * ( 1._wp - 1._wp / krdg(:,:,jl) )    &
+            &                       + araft (:,:,jl) * ( 1._wp - 1._wp / kraft        )
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj, zworka )
+      CALL wrk_dealloc( jpi,jpj,jpl+2, Gsum, kkstart = -1 )
+      !
+   END SUBROUTINE lim_itd_me_ridgeprep
+
+
+   SUBROUTINE lim_itd_me_ridgeshift( opning, closing_gross, msnow_mlt, esnow_mlt )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_me_icestrength ***
+      !!
+      !! ** Purpose :   shift ridging ice among thickness categories of ice thickness
+      !!
+      !! ** Method  :   Remove area, volume, and energy from each ridging category
+      !!              and add to thicker ice categories.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   opning         ! rate of opening due to divergence/shear
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   closing_gross  ! rate at which area removed, excluding area of new ridges
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   msnow_mlt      ! mass of snow added to ocean (kg m-2)
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   esnow_mlt      ! energy needed to melt snow in ocean (J m-2)
+      !
+      CHARACTER (len=80) ::   fieldid   ! field identifier
+      LOGICAL, PARAMETER ::   l_conservation_check = .true.  ! if true, check conservation (useful for debugging)
+      !
+      LOGICAL ::   neg_ato_i      ! flag for ato_i(i,j) < -puny
+      LOGICAL ::   large_afrac    ! flag for afrac > 1
+      LOGICAL ::   large_afrft    ! flag for afrac > 1
+      INTEGER ::   ji, jj, jl, jl1, jl2, jk   ! dummy loop indices
+      INTEGER ::   ij                ! horizontal index, combines i and j loops
+      INTEGER ::   icells            ! number of cells with aicen > puny
+      REAL(wp) ::   zeps, zindb, zsrdg2   ! local scalar
+      REAL(wp) ::   hL, hR, farea, zdummy, zdummy0, ztmelts    ! left and right limits of integration
+
+      INTEGER , POINTER, DIMENSION(:) ::   indxi, indxj   ! compressed indices
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vice_init, vice_final   ! ice volume summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   eice_init, eice_final   ! ice energy summed over layers
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   aicen_init, vicen_init   ! ice  area    & volume before ridging
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   vsnon_init, esnon_init   ! snow volume  & energy before ridging
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   smv_i_init, oa_i_init    ! ice salinity & age    before ridging
+
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   eicen_init        ! ice energy before ridging
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   afrac , fvol     ! fraction of category area ridged & new ridge volume going to n2
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ardg1 , ardg2    ! area of ice ridged & new ridges
+      REAL(wp), POINTER, DIMENSION(:,:) ::   vsrdg , esrdg    ! snow volume & energy of ridging ice
+      REAL(wp), POINTER, DIMENSION(:,:) ::   oirdg1, oirdg2   ! areal age content of ridged & rifging 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(:,:) ::   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   ! areal age content of rafted ice & rafting ice
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   eirft      ! ice energy of rafting ice
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg1      ! enth*volume of ice ridged
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   erdg2      ! enth*volume of new ridges
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ersw       ! enth of water trapped into ridges
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( (jpi+1)*(jpj+1),      indxi, indxj )
+      CALL wrk_alloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_alloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
+      CALL wrk_alloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
+      CALL wrk_alloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_alloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init )
+      CALL wrk_alloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_alloc( jpi, jpj, jkmax, jpl, eicen_init )
+
+      ! Conservation check
+      eice_init(:,:) = 0._wp
+
+      IF( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vice_init )
+         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx)
+         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_init )
+         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx)
+      ENDIF
+
+      zeps   = 1.e-20_wp
+
+      !-------------------------------------------------------------------------------
+      ! 1) Compute change in open water area due to closing and opening.
+      !-------------------------------------------------------------------------------
+
+      neg_ato_i = .false.
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice        &
+               &                        + opning(ji,jj)                          * rdt_ice
+            IF( ato_i(ji,jj) < -epsi11 ) THEN
+               neg_ato_i = .TRUE.
+            ELSEIF( ato_i(ji,jj) < 0._wp ) THEN    ! roundoff error
+               ato_i(ji,jj) = 0._wp
+            ENDIF
+         END DO !jj
+      END DO !ji
+
+      ! if negative open water area alert it
+      IF( neg_ato_i ) THEN       ! there is a bug
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               IF( ato_i(ji,jj) < -epsi11 ) THEN 
+                  WRITE(numout,*) ''  
+                  WRITE(numout,*) 'Ridging error: ato_i < 0'
+                  WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)
+               ENDIF               ! ato_i < -epsi11
+            END DO
+         END DO
+      ENDIF
+
+      !-----------------------------------------------------------------
+      ! 2) Save initial state variables
+      !-----------------------------------------------------------------
+
+      DO jl = 1, jpl
+         aicen_init(:,:,jl) = a_i(:,:,jl)
+         vicen_init(:,:,jl) = v_i(:,:,jl)
+         vsnon_init(:,:,jl) = v_s(:,:,jl)
+         !
+         smv_i_init(:,:,jl) = smv_i(:,:,jl)
+         oa_i_init (:,:,jl) = oa_i (:,:,jl)
+      END DO !jl
+
+      esnon_init(:,:,:) = e_s(:,:,1,:)
+
+      DO jl = 1, jpl  
+         DO jk = 1, nlay_i
+            eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl)
+         END DO
+      END DO
+
+      !
+      !-----------------------------------------------------------------
+      ! 3) Pump everything from ice which is being ridged / rafted
+      !-----------------------------------------------------------------
+      ! Compute the area, volume, and energy of ice ridging in each
+      ! category, along with the area of the resulting ridge.
+
+      DO jl1 = 1, jpl !jl1 describes the ridging category
+
+         !------------------------------------------------
+         ! 3.1) Identify grid cells with nonzero ridging
+         !------------------------------------------------
+
+         icells = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (aicen_init(ji,jj,jl1) .GT. epsi11 .AND. athorn(ji,jj,jl1) .GT. 0.0       &
+                  .AND. closing_gross(ji,jj) > 0.0) THEN
+                  icells = icells + 1
+                  indxi(icells) = ji
+                  indxj(icells) = jj
+               ENDIF ! test on a_icen_init 
+            END DO ! ji
+         END DO ! jj
+
+         large_afrac = .false.
+         large_afrft = .false.
+
+!CDIR NODEP
+         DO ij = 1, icells
+            ji = indxi(ij)
+            jj = indxj(ij)
+
+            !--------------------------------------------------------------------
+            ! 3.2) Compute area of ridging ice (ardg1) and of new ridge (ardg2)
+            !--------------------------------------------------------------------
+
+            ardg1(ji,jj) = aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
+            arft1(ji,jj) = araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
+            ardg2(ji,jj) = ardg1(ji,jj) / krdg(ji,jj,jl1)
+            arft2(ji,jj) = arft1(ji,jj) / kraft
+
+            oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
+            oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice
+            oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)
+            oirft2(ji,jj)= oirft1(ji,jj) / kraft
+
+            !---------------------------------------------------------------
+            ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 
+            !---------------------------------------------------------------
+
+            afrac(ji,jj) = ardg1(ji,jj) / aicen_init(ji,jj,jl1) !ridging
+            afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting
+
+            IF (afrac(ji,jj) > 1.0 + epsi11) THEN  !riging
+               large_afrac = .true.
+            ELSEIF (afrac(ji,jj) > 1.0) THEN  ! roundoff error
+               afrac(ji,jj) = 1.0
+            ENDIF
+            IF (afrft(ji,jj) > 1.0 + epsi11) THEN !rafting
+               large_afrft = .true.
+            ELSEIF (afrft(ji,jj) > 1.0) THEN  ! roundoff error
+               afrft(ji,jj) = 1.0
+            ENDIF
+
+            !--------------------------------------------------------------------------
+            ! 3.4) Subtract area, volume, and energy from ridging 
+            !     / rafting category n1.
+            !--------------------------------------------------------------------------
+            vrdg1(ji,jj) = vicen_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )
+            vrdg2(ji,jj) = vrdg1(ji,jj) * ( 1. + ridge_por )
+            vsw  (ji,jj) = vrdg1(ji,jj) * ridge_por
+
+            vsrdg(ji,jj) = vsnon_init(ji,jj,jl1) * afrac(ji,jj)
+            esrdg(ji,jj) = esnon_init(ji,jj,jl1) * afrac(ji,jj)
+            srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por )
+            srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj)
+
+            ! rafting volumes, heat contents ...
+            virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj)
+            vsrft(ji,jj) = vsnon_init(ji,jj,jl1) * afrft(ji,jj)
+            esrft(ji,jj) = esnon_init(ji,jj,jl1) * afrft(ji,jj)
+            smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 
+
+            ! substract everything
+            a_i(ji,jj,jl1)   = a_i(ji,jj,jl1)   - ardg1(ji,jj)  - arft1(ji,jj)
+            v_i(ji,jj,jl1)   = v_i(ji,jj,jl1)   - vrdg1(ji,jj)  - virft(ji,jj)
+            v_s(ji,jj,jl1)   = v_s(ji,jj,jl1)   - vsrdg(ji,jj)  - vsrft(ji,jj)
+            e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj)  - esrft(ji,jj)
+            oa_i(ji,jj,jl1)  = oa_i(ji,jj,jl1)  - oirdg1(ji,jj) - oirft1(ji,jj)
+            smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj)  - smrft(ji,jj)
+
+            !-----------------------------------------------------------------
+            ! 3.5) Compute properties of new ridges
+            !-----------------------------------------------------------------
+            !-------------
+            ! Salinity
+            !-------------
+            smsw(ji,jj)  = sss_m(ji,jj) * vsw(ji,jj) * rhoic / rau0       ! salt content of water frozen in voids
+
+            zsrdg2       = srdg1(ji,jj) + smsw(ji,jj)                     ! salt content of new ridge
+
+            srdg2(ji,jj) = MIN( s_i_max * vrdg2(ji,jj) , zsrdg2 )         ! impose a maximum salinity
+            
+            !                                                             ! excess of salt is flushed into the ocean
+            fsalt_rpo(ji,jj) = fsalt_rpo(ji,jj) + ( zsrdg2 - srdg2(ji,jj) ) * rhoic / rdt_ice
+
+            !------------------------------------            
+            ! 3.6 Increment ridging diagnostics
+            !------------------------------------            
+
+            !        jl1 looping 1-jpl
+            !           ij looping 1-icells
+
+            dardg1dt   (ji,jj) = dardg1dt(ji,jj) + ardg1(ji,jj) + arft1(ji,jj)
+            dardg2dt   (ji,jj) = dardg2dt(ji,jj) + ardg2(ji,jj) + arft2(ji,jj)
+            diag_dyn_gr(ji,jj) = diag_dyn_gr(ji,jj) + ( vrdg2(ji,jj) + virft(ji,jj) ) / rdt_ice
+            opening    (ji,jj) = opening (ji,jj) + opning(ji,jj)*rdt_ice
+
+            IF( con_i )   vice_init(ji,jj) = vice_init(ji,jj) + vrdg2(ji,jj) - vrdg1(ji,jj)
+
+            !------------------------------------------            
+            ! 3.7 Put the snow somewhere in the ocean
+            !------------------------------------------            
+
+            !  Place part of the snow lost by ridging into the ocean. 
+            !  Note that esnow_mlt < 0; the ocean must cool to melt snow.
+            !  If the ocean temp = Tf already, new ice must grow.
+            !  During the next time step, thermo_rates will determine whether
+            !  the ocean cools or new ice grows.
+            !        jl1 looping 1-jpl
+            !           ij looping 1-icells
+
+            msnow_mlt(ji,jj) = msnow_mlt(ji,jj) + rhosn*vsrdg(ji,jj)*(1.0-fsnowrdg)   &   ! rafting included
+               &                                + rhosn*vsrft(ji,jj)*(1.0-fsnowrft)
+
+            esnow_mlt(ji,jj) = esnow_mlt(ji,jj) + esrdg(ji,jj)*(1.0-fsnowrdg)         &   !rafting included
+               &                                + esrft(ji,jj)*(1.0-fsnowrft)          
+
+            !-----------------------------------------------------------------
+            ! 3.8 Compute quantities used to apportion ice among categories
+            ! in the n2 loop below
+            !-----------------------------------------------------------------
+
+            !        jl1 looping 1-jpl
+            !           ij looping 1-icells
+
+            dhr(ji,jj)  = hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1)
+            dhr2(ji,jj) = hrmax(ji,jj,jl1) * hrmax(ji,jj,jl1) - hrmin(ji,jj,jl1) * hrmin(ji,jj,jl1)
+
+
+         END DO                 ! ij
+
+         !--------------------------------------------------------------------
+         ! 3.9 Compute ridging ice enthalpy, remove it from ridging ice and
+         !      compute ridged ice enthalpy 
+         !--------------------------------------------------------------------
+         DO jk = 1, nlay_i
+!CDIR NODEP
+            DO ij = 1, icells
+               ji = indxi(ij)
+               jj = indxj(ij)
+               ! heat content of ridged ice
+               erdg1(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrac(ji,jj) / ( 1._wp + ridge_por ) 
+               eirft(ji,jj,jk)      = eicen_init(ji,jj,jk,jl1) * afrft(ji,jj)
+               e_i  (ji,jj,jk,jl1)  = e_i(ji,jj,jk,jl1) - erdg1(ji,jj,jk) - eirft(ji,jj,jk)
+               ! sea water heat content
+               ztmelts          = - tmut * sss_m(ji,jj) + rtt
+               ! heat content per unit volume
+               zdummy0          = - rcp * ( sst_m(ji,jj) + rt0 - rtt ) * vsw(ji,jj)
+
+               ! corrected sea water salinity
+               zindb  = MAX( 0._wp , SIGN( 1._wp , vsw(ji,jj) - zeps ) )
+               zdummy = zindb * ( srdg1(ji,jj) - srdg2(ji,jj) ) / MAX( ridge_por * vsw(ji,jj), zeps )
+
+               ztmelts          = - tmut * zdummy + rtt
+               ersw(ji,jj,jk)   = - rcp * ( ztmelts - rtt ) * vsw(ji,jj)
+
+               ! heat flux
+               fheat_rpo(ji,jj) = fheat_rpo(ji,jj) + ( ersw(ji,jj,jk) - zdummy0 ) / rdt_ice
+
+               ! Correct dimensions to avoid big values
+               ersw(ji,jj,jk)   = ersw(ji,jj,jk) * 1.e-09
+
+               ! Mutliply by ice volume, and divide by number of layers to get heat content in 10^9 J
+               ersw (ji,jj,jk)  = ersw(ji,jj,jk) * area(ji,jj) * vsw(ji,jj) / nlay_i
+
+               erdg2(ji,jj,jk)  = erdg1(ji,jj,jk) + ersw(ji,jj,jk)
+            END DO ! ij
+         END DO !jk
+
+
+         IF( con_i ) THEN
+            DO jk = 1, nlay_i
+!CDIR NODEP
+               DO ij = 1, icells
+                  ji = indxi(ij)
+                  jj = indxj(ij)
+                  eice_init(ji,jj) = eice_init(ji,jj) + erdg2(ji,jj,jk) - erdg1(ji,jj,jk)
+               END DO ! ij
+            END DO !jk
+         ENDIF
+
+         IF( large_afrac ) THEN   ! there is a bug
+!CDIR NODEP
+            DO ij = 1, icells
+               ji = indxi(ij)
+               jj = indxj(ij)
+               IF( afrac(ji,jj) > 1.0 + epsi11 ) THEN 
+                  WRITE(numout,*) ''
+                  WRITE(numout,*) ' ardg > a_i'
+                  WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)
+               ENDIF
+            END DO
+         ENDIF
+         IF( large_afrft ) THEN  ! there is a bug
+!CDIR NODEP
+            DO ij = 1, icells
+               ji = indxi(ij)
+               jj = indxj(ij)
+               IF( afrft(ji,jj) > 1.0 + epsi11 ) THEN 
+                  WRITE(numout,*) ''
+                  WRITE(numout,*) ' arft > a_i'
+                  WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)
+               ENDIF
+            END DO
+         ENDIF
+
+         !-------------------------------------------------------------------------------
+         ! 4) Add area, volume, and energy of new ridge to each category jl2
+         !-------------------------------------------------------------------------------
+         !        jl1 looping 1-jpl
+         DO jl2  = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
+            ! over categories to which ridged ice is transferred
+!CDIR NODEP
+            DO ij = 1, icells
+               ji = indxi(ij)
+               jj = indxj(ij)
+
+               ! Compute the fraction of ridged ice area and volume going to 
+               ! thickness category jl2.
+               ! Transfer area, volume, and energy accordingly.
+
+               IF (hrmin(ji,jj,jl1) .GE. hi_max(jl2) .OR.        &
+                  hrmax(ji,jj,jl1) .LE. hi_max(jl2-1)) THEN
+                  hL = 0.0
+                  hR = 0.0
+               ELSE
+                  hL = MAX (hrmin(ji,jj,jl1), hi_max(jl2-1))
+                  hR = MIN (hrmax(ji,jj,jl1), hi_max(jl2))
+               ENDIF
+
+               ! fraction of ridged ice area and volume going to n2
+               farea = (hR-hL) / dhr(ji,jj) 
+               fvol(ji,jj) = (hR*hR - hL*hL) / dhr2(ji,jj)
+
+               a_i  (ji,jj,jl2)   = a_i  (ji,jj,jl2)   + ardg2 (ji,jj) * farea
+               v_i  (ji,jj,jl2)   = v_i  (ji,jj,jl2)   + vrdg2 (ji,jj) * fvol(ji,jj)
+               v_s  (ji,jj,jl2)   = v_s  (ji,jj,jl2)   + vsrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
+               e_s  (ji,jj,1,jl2) = e_s  (ji,jj,1,jl2) + esrdg (ji,jj) * fvol(ji,jj) * fsnowrdg
+               smv_i(ji,jj,jl2)   = smv_i(ji,jj,jl2)   + srdg2 (ji,jj) * fvol(ji,jj)
+               oa_i (ji,jj,jl2)   = oa_i (ji,jj,jl2)   + oirdg2(ji,jj) * farea
+
+            END DO ! ij
+
+            ! Transfer ice energy to category jl2 by ridging
+            DO jk = 1, nlay_i
+!CDIR NODEP
+               DO ij = 1, icells
+                  ji = indxi(ij)
+                  jj = indxj(ij)
+                  e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + fvol(ji,jj)*erdg2(ji,jj,jk)
+               END DO
+            END DO
+            !
+         END DO                 ! jl2 (new ridges)            
+
+         DO jl2 = ice_cat_bounds(1,1), ice_cat_bounds(1,2) 
+
+!CDIR NODEP
+            DO ij = 1, icells
+               ji = indxi(ij)
+               jj = indxj(ij)
+               ! Compute the fraction of rafted ice area and volume going to 
+               ! thickness category jl2, transfer area, volume, and energy accordingly.
+
+               IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        &
+                  hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN
+                  a_i(ji,jj,jl2) = a_i(ji,jj,jl2) + arft2(ji,jj)
+                  v_i(ji,jj,jl2) = v_i(ji,jj,jl2) + virft(ji,jj)
+                  v_s(ji,jj,jl2) = v_s(ji,jj,jl2) + vsrft(ji,jj)*fsnowrft
+                  e_s(ji,jj,1,jl2) = e_s(ji,jj,1,jl2) + esrft(ji,jj)*fsnowrft
+                  smv_i(ji,jj,jl2) = smv_i(ji,jj,jl2) + smrft(ji,jj)    
+                  oa_i(ji,jj,jl2)  = oa_i(ji,jj,jl2)  + oirft2(ji,jj)    
+               ENDIF ! hraft
+
+            END DO ! ij
+
+            ! Transfer rafted ice energy to category jl2 
+            DO jk = 1, nlay_i
+!CDIR NODEP
+               DO ij = 1, icells
+                  ji = indxi(ij)
+                  jj = indxj(ij)
+                  IF (hraft(ji,jj,jl1) .LE. hi_max(jl2) .AND.        &
+                     hraft(ji,jj,jl1) .GT. hi_max(jl2-1)) THEN
+                     e_i(ji,jj,jk,jl2) = e_i(ji,jj,jk,jl2) + eirft(ji,jj,jk)
+                  ENDIF
+               END DO           ! ij
+            END DO !jk
+
+         END DO ! jl2
+
+      END DO ! jl1 (deforming categories)
+
+      ! Conservation check
+      IF ( con_i ) THEN
+         CALL lim_column_sum (jpl,   v_i, vice_final)
+         fieldid = ' v_i : limitd_me '
+         CALL lim_cons_check (vice_init, vice_final, 1.0e-6, fieldid) 
+         WRITE(numout,*) ' vice_init  : ', vice_init(jiindx,jjindx)
+         WRITE(numout,*) ' vice_final : ', vice_final(jiindx,jjindx)
+
+         CALL lim_column_sum_energy (jpl, nlay_i,  e_i, eice_final )
+         fieldid = ' e_i : limitd_me '
+         CALL lim_cons_check (eice_init, eice_final, 1.0e-2, fieldid) 
+         WRITE(numout,*) ' eice_init  : ', eice_init(jiindx,jjindx)
+         WRITE(numout,*) ' eice_final : ', eice_final(jiindx,jjindx)
+      ENDIF
+      !
+      CALL wrk_dealloc( (jpi+1)*(jpj+1),      indxi, indxj )
+      CALL wrk_dealloc( jpi, jpj,             vice_init, vice_final, eice_init, eice_final )
+      CALL wrk_dealloc( jpi, jpj,             afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )
+      CALL wrk_dealloc( jpi, jpj,             vrdg1, vrdg2, vsw  , srdg1, srdg2, smsw )
+      CALL wrk_dealloc( jpi, jpj,             afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )
+      CALL wrk_dealloc( jpi, jpj, jpl,        aicen_init, vicen_init, vsnon_init, esnon_init, smv_i_init, oa_i_init )
+      CALL wrk_dealloc( jpi, jpj, jkmax,      eirft, erdg1, erdg2, ersw )
+      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, eicen_init )
+      !
+   END SUBROUTINE lim_itd_me_ridgeshift
+
+
+   SUBROUTINE lim_itd_me_asumr
+      !!-----------------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_me_asumr ***
+      !!
+      !! ** Purpose :   finds total fractional area
+      !!
+      !! ** Method  :   Find the total area of ice plus open water in each grid cell.
+      !!              This is similar to the aggregate_area subroutine except that the
+      !!              total area can be greater than 1, so the open water area is 
+      !!              included in the sum instead of being computed as a residual. 
+      !!-----------------------------------------------------------------------------
+      INTEGER ::   jl   ! dummy loop index
+      !!-----------------------------------------------------------------------------
+      !
+      asum(:,:) = ato_i(:,:)                    ! open water
+      DO jl = 1, jpl                            ! ice categories
+         asum(:,:) = asum(:,:) + a_i(:,:,jl)
+      END DO
+      !
+   END SUBROUTINE lim_itd_me_asumr
+
+
+   SUBROUTINE lim_itd_me_init
+      !!-------------------------------------------------------------------
+      !!                   ***  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
+      !!-------------------------------------------------------------------
+      NAMELIST/namiceitdme/ ridge_scheme_swi, Cs, Cf, fsnowrdg, fsnowrft,& 
+         Gstar, astar,                                &
+         Hstar, raftswi, hparmeter, Craft, ridge_por, &
+         sal_max_ridge,  partfun_swi, transfun_swi,   &
+         brinstren_swi
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice )                   ! read namiceitdme namelist
+      READ  ( numnam_ice , namiceitdme)
+      !
+      IF (lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)' lim_itd_me_init : ice parameters for mechanical ice redistribution '
+         WRITE(numout,*)' ~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'   Switch choosing the ice redistribution scheme           ridge_scheme_swi', ridge_scheme_swi 
+         WRITE(numout,*)'   Fraction of shear energy contributing to ridging        Cs              ', Cs 
+         WRITE(numout,*)'   Ratio of ridging work to PotEner change in ridging      Cf              ', Cf 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrdg        ', fsnowrdg 
+         WRITE(numout,*)'   Fraction of snow volume conserved during ridging        fsnowrft        ', fsnowrft 
+         WRITE(numout,*)'   Fraction of total ice coverage contributing to ridging  Gstar           ', Gstar
+         WRITE(numout,*)'   Equivalent to G* for an exponential part function       astar           ', astar
+         WRITE(numout,*)'   Quantity playing a role in max ridged ice thickness     Hstar           ', Hstar
+         WRITE(numout,*)'   Rafting of ice sheets or not                            raftswi         ', raftswi
+         WRITE(numout,*)'   Parmeter thickness (threshold between ridge-raft)       hparmeter       ', hparmeter
+         WRITE(numout,*)'   Rafting hyperbolic tangent coefficient                  Craft           ', Craft  
+         WRITE(numout,*)'   Initial porosity of ridges                              ridge_por       ', ridge_por
+         WRITE(numout,*)'   Maximum salinity of ridging ice                         sal_max_ridge   ', sal_max_ridge
+         WRITE(numout,*)'   Switch for part. function (0) linear (1) exponential    partfun_swi     ', partfun_swi
+         WRITE(numout,*)'   Switch for tran. function (0) linear (1) exponential    transfun_swi    ', transfun_swi
+         WRITE(numout,*)'   Switch for including brine volume in ice strength comp. brinstren_swi   ', brinstren_swi
+      ENDIF
+      !
+   END SUBROUTINE lim_itd_me_init
+
+
+   SUBROUTINE lim_itd_me_zapsmall
+      !!-------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_itd_me_zapsmall ***
+      !!
+      !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes
+      !!
+      !! history :
+      !! author: William H. Lipscomb, LANL
+      !! Nov 2003:  Modified by Julie Schramm to conserve volume and energy
+      !! Sept 2004: Modified by William Lipscomb; replaced normalize_state with
+      !!            additions to local freshwater, salt, and heat fluxes
+      !!  9.0, LIM3.0 - 02-2006 (M. Vancoppenolle) original code
+      !!-------------------------------------------------------------------
+      INTEGER ::   ji, jj, jl, jk   ! dummy loop indices
+      INTEGER ::   icells           ! number of cells with ice to zap
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask   ! 2D workspace
+      
+!!gm      REAL(wp) ::   xtmp      ! temporary variable
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zmask )
+
+      DO jl = 1, jpl
+
+         !-----------------------------------------------------------------
+         ! Count categories to be zapped.
+         ! Abort model in case of negative area.
+         !-----------------------------------------------------------------
+         IF( MINVAL(a_i(:,:,jl)) .LT. -epsi11 .AND. ln_nicep ) THEN
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF ( a_i(ji,jj,jl) .LT. -epsi11 ) THEN
+                     WRITE (numout,*) ' ALERTE 98 ' 
+                     WRITE (numout,*) ' Negative ice area: ji, jj, jl: ', ji, jj,jl
+                     WRITE (numout,*) ' a_i    ', a_i(ji,jj,jl)
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+
+         icells = 0
+         zmask  = 0._wp
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF(  ( a_i(ji,jj,jl) .GE. -epsi11 .AND. a_i(ji,jj,jl) .LT. 0._wp   ) .OR.   &
+                  & ( a_i(ji,jj,jl) .GT. 0._wp   .AND. a_i(ji,jj,jl) .LE. 1.0e-11 ) .OR.   &
+                  & ( v_i(ji,jj,jl)  ==  0._wp   .AND. a_i(ji,jj,jl) .GT. 0._wp   ) .OR.   &
+                  & ( v_i(ji,jj,jl) .GT. 0._wp   .AND. v_i(ji,jj,jl) .LT. 1.e-12  )      )   zmask(ji,jj) = 1._wp
+            END DO
+         END DO
+         IF( ln_nicep )   WRITE(numout,*) SUM(zmask), ' cells of ice zapped in the ocean '
+
+         !-----------------------------------------------------------------
+         ! Zap ice energy and use ocean heat to melt ice
+         !-----------------------------------------------------------------
+
+         DO jk = 1, nlay_i
+            DO jj = 1 , jpj
+               DO ji = 1 , jpi
+!!gm                  xtmp = e_i(ji,jj,jk,jl) / area(ji,jj) / rdt_ice
+!!gm                  xtmp = xtmp * unit_fac
+                  ! fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * ( 1 - zmask(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1 , jpj
+            DO ji = 1 , jpi
+
+               !-----------------------------------------------------------------
+               ! Zap snow energy and use ocean heat to melt snow
+               !-----------------------------------------------------------------
+               !           xtmp = esnon(i,j,n) / dt ! < 0
+               !           fhnet(i,j)      = fhnet(i,j)      + xtmp
+               !           fhnet_hist(i,j) = fhnet_hist(i,j) + xtmp
+               ! xtmp is greater than 0
+               ! fluxes are positive to the ocean
+               ! here the flux has to be negative for the ocean
+!!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice
+               !           fheat_res(ji,jj) = fheat_res(ji,jj) - xtmp
+
+!!gm               xtmp = ( rhosn*cpic*( rtt-t_s(ji,jj,1,jl) ) + rhosn*lfus ) / rdt_ice !RB   ???????
+
+               t_s(ji,jj,1,jl) = rtt * zmask(ji,jj) + t_s(ji,jj,1,jl) * ( 1 - zmask(ji,jj) )
+
+               !-----------------------------------------------------------------
+               ! zap ice and snow volume, add water and salt to ocean
+               !-----------------------------------------------------------------
+
+               !           xtmp = (rhoi*vicen(i,j,n) + rhos*vsnon(i,j,n)) / dt
+               !           fresh(i,j)      = fresh(i,j)      + xtmp
+               !           fresh_hist(i,j) = fresh_hist(i,j) + xtmp
+
+               !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj)                  ) * & 
+               !                               rhosn * v_s(ji,jj,jl) / rdt_ice
+
+               !           fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 
+               !                               rhoic * v_i(ji,jj,jl) / rdt_ice
+
+               !           emps(i,j)      = emps(i,j)      + xtmp
+               !           fsalt_hist(i,j) = fsalt_hist(i,j) + xtmp
+
+               ato_i(ji,jj)    = a_i  (ji,jj,jl) *       zmask(ji,jj)   + ato_i(ji,jj)
+               a_i  (ji,jj,jl) = a_i  (ji,jj,jl) * ( 1 - zmask(ji,jj) )
+               v_i  (ji,jj,jl) = v_i  (ji,jj,jl) * ( 1 - zmask(ji,jj) )
+               v_s  (ji,jj,jl) = v_s  (ji,jj,jl) * ( 1 - zmask(ji,jj) )
+               t_su (ji,jj,jl) = t_su (ji,jj,jl) * ( 1 - zmask(ji,jj) ) + t_bo(ji,jj) * zmask(ji,jj)
+               oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * ( 1 - zmask(ji,jj) )
+               smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * ( 1 - zmask(ji,jj) )
+               !
+            END DO
+         END DO
+         !
+      END DO                 ! jl 
+      !
+      CALL wrk_dealloc( jpi, jpj, zmask )
+      !
+   END SUBROUTINE lim_itd_me_zapsmall
+
+#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_sort
+   END SUBROUTINE lim_itd_me_sort
+   SUBROUTINE lim_itd_me_init
+   END SUBROUTINE lim_itd_me_init
+   SUBROUTINE lim_itd_me_zapsmall
+   END SUBROUTINE lim_itd_me_zapsmall
+#endif
+   !!======================================================================
+END MODULE limitd_me
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90	(revision 3437)
@@ -0,0 +1,1060 @@
+MODULE limitd_th
+   !!======================================================================
+   !!                       ***  MODULE limitd_th ***
+   !!              Thermodynamics of ice thickness distribution
+   !!                   computation of changes in g(h)      
+   !!======================================================================
+   !! 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 and types
+   !!             -   ! 2007-04  (M. Vancoppenolle) Mass conservation checked
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3' :                                   LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_itd_th       : thermodynamics of ice thickness distribution
+   !!   lim_itd_th_rem   :
+   !!   lim_itd_th_reb   :
+   !!   lim_itd_fitline  :
+   !!   lim_itd_shiftice :
+   !!----------------------------------------------------------------------
+   USE dom_ice          ! LIM-3 domain
+   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 par_ice          ! LIM-3 parameters
+   USE limthd_lac       ! LIM-3 lateral accretion
+   USE limvar           ! LIM-3 variables
+   USE limcons          ! LIM-3 conservation
+   USE prtctl           ! Print control
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_itd_th         ! called by ice_stp
+   PUBLIC   lim_itd_th_rem
+   PUBLIC   lim_itd_th_reb
+   PUBLIC   lim_itd_fitline
+   PUBLIC   lim_itd_shiftice
+
+   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values
+   REAL(wp) ::   epsi13 = 1e-13_wp   !
+   REAL(wp) ::   epsi10 = 1e-10_wp   !
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_itd_th( kt )
+      !!------------------------------------------------------------------
+      !!                ***  ROUTINE lim_itd_th ***
+      !!
+      !! ** Purpose :   computes the thermodynamics of ice thickness distribution
+      !!
+      !! ** Method  :
+      !!------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! time step index
+      !
+      INTEGER ::   jl, ja, jm, jbnd1, jbnd2   ! ice types    dummy loop index         
+
+      !!------------------------------------------------------------------
+
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_itd_th  : Thermodynamics of the ice thickness distribution'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      !------------------------------------------------------------------------------|
+      !  1) Transport of ice between thickness categories.                           |
+      !------------------------------------------------------------------------------|
+      ! Given thermodynamic growth rates, transport ice between
+      ! thickness categories.
+      DO jm = 1, jpm
+         jbnd1 = ice_cat_bounds(jm,1)
+         jbnd2 = ice_cat_bounds(jm,2)
+         IF( ice_ncat_types(jm) > 1 )   CALL lim_itd_th_rem( jbnd1, jbnd2, jm, kt )
+      END DO
+      !
+      CALL lim_var_glo2eqv    ! only for info
+      CALL lim_var_agg(1)
+
+      !------------------------------------------------------------------------------|
+      !  3) Add frazil ice growing in leads.
+      !------------------------------------------------------------------------------|
+
+      CALL lim_thd_lac
+      CALL lim_var_glo2eqv    ! only for info
+
+      !----------------------------------------------------------------------------------------
+      !  4) Computation of trend terms and get back to old values      
+      !----------------------------------------------------------------------------------------
+
+      !- Trend terms
+      d_a_i_thd (:,:,:)  = a_i(:,:,:)   - old_a_i(:,:,:) 
+      d_v_s_thd (:,:,:)  = v_s(:,:,:)   - old_v_s(:,:,:)
+      d_v_i_thd (:,:,:)  = v_i(:,:,:)   - old_v_i(:,:,:)  
+      d_e_s_thd(:,:,:,:) = e_s(:,:,:,:) - old_e_s(:,:,:,:) 
+      d_e_i_thd(:,:,:,:) = e_i(:,:,:,:) - old_e_i(:,:,:,:)
+
+      d_smv_i_thd(:,:,:) = 0._wp
+      IF( num_sal == 2 .OR. num_sal == 4 )   d_smv_i_thd(:,:,:) = smv_i(:,:,:) - old_smv_i(:,:,:)
+
+      IF(ln_ctl) THEN   ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_itd_th  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_itd_th  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_itd_th  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_itd_th  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_itd_th  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_itd_th  : smv_i    : ')
+            DO ja = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=ja)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,ja,jl) , clinfo1= ' lim_itd_th  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
+
+      !- Recover Old values
+      a_i(:,:,:)   = old_a_i (:,:,:)
+      v_s(:,:,:)   = old_v_s (:,:,:)
+      v_i(:,:,:)   = old_v_i (:,:,:)
+      e_s(:,:,:,:) = old_e_s (:,:,:,:)
+      e_i(:,:,:,:) = old_e_i (:,:,:,:)
+      !
+      IF( num_sal == 2 .OR. num_sal == 4 )   smv_i(:,:,:)       = old_smv_i (:,:,:)
+      !
+   END SUBROUTINE lim_itd_th
+   !
+
+   SUBROUTINE lim_itd_th_rem( klbnd, kubnd, ntyp, 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) ::   ntyp    ! Number of the type used
+      INTEGER , INTENT (in) ::   kt      ! Ocean time step 
+      !
+      INTEGER  ::   ji, jj, jl     ! dummy loop index
+      INTEGER  ::   zji, zjj, nd   ! local integer
+      REAL(wp) ::   zx1, zwk1, zdh0, zetamin, zdamax   ! local scalars
+      REAL(wp) ::   zx2, zwk2, zda0, zetamax, zhimin   !   -      -
+      REAL(wp) ::   zx3,             zareamin, zindb   !   -      -
+      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_o     ! 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 )    ! integer
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_alloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es )
+      CALL wrk_alloc( jpi,jpj,jpl-1, zdaice, zdvice )   
+      CALL wrk_alloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
+      CALL wrk_alloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_alloc( jpi,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 )
+
+      zhimin   = 0.1      !minimum ice thickness tolerated by the model
+      zareamin = epsi10   !minimum area in thickness categories tolerated by the conceptors of the model
+
+      !!----------------------------------------------------------------------------------------------
+      !! 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
+         WRITE(numout,*) ' ntyp  :       ', ntyp 
+      ENDIF
+
+      zdhice(:,:,:) = 0._wp
+      DO jl = klbnd, kubnd
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindb             = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl)))     !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) * zindb
+               zindb             = 1.0-MAX(0.0,SIGN(1.0,-old_a_i(ji,jj,jl))) !0 if no ice and 1 if yes
+               zht_i_o(ji,jj,jl) = old_v_i(ji,jj,jl) / MAX(old_a_i(ji,jj,jl),epsi10) * zindb
+               IF( a_i(ji,jj,jl) > 1e-6 )   zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_o(ji,jj,jl) 
+            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) .gt. zareamin ) 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 !ji
+      END DO !jj
+
+      !-----------------------------------------------------------------------------------------------
+      !  4) Compute new category boundaries
+      !-----------------------------------------------------------------------------------------------
+      !- 4.1 Compute category boundaries
+      ! Tricky trick see limitd_me.F90
+      ! will be soon removed, CT
+      ! hi_max(kubnd) = 999.99
+      zhbnew(:,:,:) = 0._wp
+
+      DO jl = klbnd, kubnd - 1
+         DO ji = 1, nbrem
+            zji = nind_i(ji)
+            zjj = nind_j(ji)
+            !
+            IF ( ( zht_i_o(zji,zjj,jl)  .GT.epsi10 ) .AND. & 
+               ( zht_i_o(zji,zjj,jl+1).GT.epsi10 ) ) THEN
+               !interpolate between adjacent category growth rates
+               zslope = ( zdhice(zji,zjj,jl+1)     - zdhice(zji,zjj,jl) ) / &
+                  ( zht_i_o   (zji,zjj,jl+1) - zht_i_o   (zji,zjj,jl) )
+               zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl) + &
+                  zslope * ( hi_max(jl) - zht_i_o(zji,zjj,jl) )
+            ELSEIF (zht_i_o(zji,zjj,jl).gt.epsi10) THEN
+               zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl)
+            ELSEIF (zht_i_o(zji,zjj,jl+1).gt.epsi10) THEN
+               zhbnew(zji,zjj,jl) = hi_max(jl) + zdhice(zji,zjj,jl+1)
+            ELSE
+               zhbnew(zji,zjj,jl) = hi_max(jl)
+            ENDIF
+         END DO
+
+         !- 4.2 Check that each zhbnew lies between adjacent values of ice thickness
+         DO ji = 1, nbrem
+            ! jl, ji
+            zji = nind_i(ji)
+            zjj = nind_j(ji)
+            ! jl, ji
+            IF ( ( a_i(zji,zjj,jl) .GT.epsi10) .AND. & 
+               ( ht_i(zji,zjj,jl).GE. zhbnew(zji,zjj,jl) ) &
+               ) THEN
+               zremap_flag(zji,zjj) = 0
+            ELSEIF ( ( a_i(zji,zjj,jl+1) .GT. epsi10 ) .AND. &
+               ( ht_i(zji,zjj,jl+1).LE. zhbnew(zji,zjj,jl) ) &
+               ) THEN
+               zremap_flag(zji,zjj) = 0
+            ENDIF
+
+            !- 4.3 Check that each zhbnew does not exceed maximal values hi_max  
+            ! jl, ji
+            IF (zhbnew(zji,zjj,jl).gt.hi_max(jl+1)) THEN
+               zremap_flag(zji,zjj) = 0
+            ENDIF
+            ! jl, ji
+            IF (zhbnew(zji,zjj,jl).lt.hi_max(jl-1)) THEN
+               zremap_flag(zji,zjj) = 0
+            ENDIF
+            ! jl, ji
+         END DO !ji
+         ! ji
+      END DO !jl
+
+      !-----------------------------------------------------------------------------------------------
+      !  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 !ji
+      END DO !jj
+
+      !-----------------------------------------------------------------------------------------------
+      !  6) Fill arrays with lowermost / uppermost boundaries of 'new' categories
+      !-----------------------------------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zhb0(ji,jj) = hi_max_typ(0,ntyp) ! 0eme
+            zhb1(ji,jj) = hi_max_typ(1,ntyp) ! 1er
+
+            zhbnew(ji,jj,klbnd-1) = 0._wp
+
+            IF( a_i(ji,jj,kubnd) > epsi10 ) THEN
+               zhbnew(ji,jj,kubnd) = 3._wp * ht_i(ji,jj,kubnd) - 2._wp * zhbnew(ji,jj,kubnd-1)
+            ELSE
+               zhbnew(ji,jj,kubnd) = hi_max(kubnd)
+            ENDIF
+
+            IF( zhbnew(ji,jj,kubnd) < hi_max(kubnd-1) )   zhbnew(ji,jj,kubnd) = hi_max(kubnd-1)
+
+         END DO !jj
+      END DO !jj
+
+      !-----------------------------------------------------------------------------------------------
+      !  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_o(:,:,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
+         zji = nind_i(ji) 
+         zjj = nind_j(ji) 
+
+         !ji
+         IF (a_i(zji,zjj,klbnd) .gt. epsi10) THEN
+            zdh0 = zdhice(zji,zjj,klbnd) !decrease of ice thickness in the lower category
+            ! ji, a_i > epsi10
+            IF (zdh0 .lt. 0.0) THEN !remove area from category 1
+               ! ji, a_i > epsi10; zdh0 < 0
+               zdh0 = MIN(-zdh0,hi_max(klbnd))
+
+               !Integrate g(1) from 0 to dh0 to estimate area melted
+               zetamax = MIN(zdh0,hR(zji,zjj,klbnd)) - hL(zji,zjj,klbnd)
+               IF (zetamax.gt.0.0) THEN
+                  zx1  = zetamax
+                  zx2  = 0.5 * zetamax*zetamax 
+                  zda0 = g1(zji,zjj,klbnd) * zx2 + g0(zji,zjj,klbnd) * zx1 !ice area removed
+                  ! Constrain new thickness <= ht_i
+                  zdamax = a_i(zji,zjj,klbnd) * & 
+                     (1.0 - ht_i(zji,zjj,klbnd)/zht_i_o(zji,zjj,klbnd)) ! zdamax > 0
+                  !ice area lost due to melting of thin ice
+                  zda0   = MIN(zda0, zdamax)
+
+                  ! Remove area, conserving volume
+                  ht_i(zji,zjj,klbnd) = ht_i(zji,zjj,klbnd) & 
+                     * a_i(zji,zjj,klbnd) / ( a_i(zji,zjj,klbnd) - zda0 )
+                  a_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd) - zda0
+                  v_i(zji,zjj,klbnd)  = a_i(zji,zjj,klbnd)*ht_i(zji,zjj,klbnd)
+               ENDIF     ! zetamax > 0
+               ! ji, a_i > epsi10
+
+            ELSE ! if ice accretion
+               ! ji, a_i > epsi10; zdh0 > 0
+               IF ( ntyp .EQ. 1 ) zhbnew(zji,zjj,klbnd-1) = MIN(zdh0,hi_max(klbnd)) 
+               ! zhbnew was 0, and is shifted to the right to account for thin ice
+               ! growth in openwater (F0 = f1)
+               IF ( ntyp .NE. 1 ) zhbnew(zji,zjj,0) = 0 
+               ! in other types there is
+               ! no open water growth (F0 = 0)
+            ENDIF ! zdh0 
+
+            ! a_i > epsi10
+         ENDIF ! a_i > epsi10
+
+      END DO ! ji
+
+      !- 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
+            zji = nind_i(ji)
+            zjj = nind_j(ji)
+
+            IF (zhbnew(zji,zjj,jl) .gt. 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(zji,zjj,jl)) - hL(zji,zjj,jl)
+               zvetamax(ji) = MIN(zhbnew(zji,zjj,jl), hR(zji,zjj,jl)) - hL(zji,zjj,jl)
+               zdonor(zji,zjj,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(zji,zjj,jl+1)) - hL(zji,zjj,jl+1)
+               zdonor(zji,zjj,jl) = jl + 1
+
+            ENDIF  ! zhbnew(jl) > hi_max(jl)
+
+            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(zji,zjj,jl)
+            zdaice(zji,zjj,jl) = g1(zji,zjj,nd)*zx2 + g0(zji,zjj,nd)*zx1
+            zdvice(zji,zjj,jl) = g1(zji,zjj,nd)*zx3 + g0(zji,zjj,nd)*zx2 + &
+               zdaice(zji,zjj,jl)*hL(zji,zjj,nd)
+
+         END DO ! ji
+      END DO ! jl klbnd -> kubnd - 1
+
+      !!----------------------------------------------------------------------------------------------
+      !! 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
+         zji = nind_i(ji)
+         zjj = nind_j(ji)
+         IF ( ( zhimin .GT. 0.0 ) .AND. & 
+            ( ( a_i(zji,zjj,1) .GT. epsi10 ) .AND. ( ht_i(zji,zjj,1) .LT. zhimin ) ) &
+            ) THEN
+            a_i(zji,zjj,1)  = a_i(zji,zjj,1) * ht_i(zji,zjj,1) / zhimin 
+            ht_i(zji,zjj,1) = zhimin
+            v_i(zji,zjj,1)  = a_i(zji,zjj,1)*ht_i(zji,zjj,1)
+         ENDIF
+      END DO !ji
+
+      !!----------------------------------------------------------------------------------------------
+      !! 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 )    ! integer
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdonor )   ! integer
+      CALL wrk_dealloc( jpi,jpj,jpl, zdhice, g0, g1, hL, hR, zht_i_o, dummy_es )
+      CALL wrk_dealloc( jpi,jpj,jpl-1, zdaice, zdvice )   
+      CALL wrk_dealloc( jpi,jpj,jpl+1, zhbnew, kkstart = 0 )   
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), zvetamin, zvetamax )   
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer 
+      CALL wrk_dealloc( jpi,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
+      REAL(wp) ::   zacrith      ! critical minimum concentration in an ice category
+      !!------------------------------------------------------------------
+      !
+      zacrith       = 1.0e-6
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !
+            IF( zremap_flag(ji,jj) == 1 .AND. a_i(ji,jj,num_cat) > zacrith   &
+               &                        .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                  ! a_i > epsi10
+            !
+         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 ::   zji, zjj          ! 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
+      REAL(wp) ::   zindsn             ! snow or not
+      REAL(wp) ::   zindb              ! ice or not
+
+      INTEGER, POINTER, DIMENSION(:) ::   nind_i, nind_j   ! compressed indices for i/j directions
+
+      INTEGER ::   nbrem             ! number of cells with ice to transfer
+
+      LOGICAL ::   zdaice_negative         ! true if daice < -puny
+      LOGICAL ::   zdvice_negative         ! true if dvice < -puny
+      LOGICAL ::   zdaice_greater_aicen    ! true if daice > aicen
+      LOGICAL ::   zdvice_greater_vicen    ! true if dvice > vicen
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpl, zaTsfn )
+      CALL wrk_alloc( jpi,jpj, zworka )
+      CALL wrk_alloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+
+      !----------------------------------------------------------------------------------------------
+      ! 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) Check for daice or dvice out of range, allowing for roundoff error
+      !----------------------------------------------------------------------------------------------
+      ! Note: zdaice < 0 or zdvice < 0 usually happens when category jl
+      ! has a small area, with h(n) very close to a boundary.  Then
+      ! the coefficients of g(h) are large, and the computed daice and
+      ! dvice can be in error. If this happens, it is best to transfer
+      ! either the entire category or nothing at all, depending on which
+      ! side of the boundary hice(n) lies.
+      !-----------------------------------------------------------------
+      DO jl = klbnd, kubnd-1
+
+         zdaice_negative = .false.
+         zdvice_negative = .false.
+         zdaice_greater_aicen = .false.
+         zdvice_greater_vicen = .false.
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               IF (zdonor(ji,jj,jl) .GT. 0) THEN
+                  jl1 = zdonor(ji,jj,jl)
+
+                  IF (zdaice(ji,jj,jl) .LT. 0.0) THEN
+                     IF (zdaice(ji,jj,jl) .GT. -epsi10) THEN
+                        IF ( ( jl1.EQ.jl   .AND. ht_i(ji,jj,jl1) .GT. hi_max(jl) )           &
+                           .OR.                                      &
+                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) )           &  
+                           ) THEN                                                             
+                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1)  ! shift entire category
+                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1)
+                        ELSE
+                           zdaice(ji,jj,jl) = 0.0 ! shift no ice
+                           zdvice(ji,jj,jl) = 0.0
+                        ENDIF
+                     ELSE
+                        zdaice_negative = .true.
+                     ENDIF
+                  ENDIF
+
+                  IF (zdvice(ji,jj,jl) .LT. 0.0) THEN
+                     IF (zdvice(ji,jj,jl) .GT. -epsi10 ) THEN
+                        IF ( ( jl1.EQ.jl .AND. ht_i(ji,jj,jl1).GT.hi_max(jl) )     &
+                           .OR.                                     &
+                           ( jl1.EQ.jl+1 .AND. ht_i(ji,jj,jl1) .LE. hi_max(jl) ) &
+                           ) THEN
+                           zdaice(ji,jj,jl) = a_i(ji,jj,jl1) ! shift entire category
+                           zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
+                        ELSE
+                           zdaice(ji,jj,jl) = 0.0    ! shift no ice
+                           zdvice(ji,jj,jl) = 0.0
+                        ENDIF
+                     ELSE
+                        zdvice_negative = .true.
+                     ENDIF
+                  ENDIF
+
+                  ! If daice is close to aicen, set daice = aicen.
+                  IF (zdaice(ji,jj,jl) .GT. a_i(ji,jj,jl1) - epsi10 ) THEN
+                     IF (zdaice(ji,jj,jl) .LT. a_i(ji,jj,jl1)+epsi10) THEN
+                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
+                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
+                     ELSE
+                        zdaice_greater_aicen = .true.
+                     ENDIF
+                  ENDIF
+
+                  IF (zdvice(ji,jj,jl) .GT. v_i(ji,jj,jl1)-epsi10) THEN
+                     IF (zdvice(ji,jj,jl) .LT. v_i(ji,jj,jl1)+epsi10) THEN
+                        zdaice(ji,jj,jl) = a_i(ji,jj,jl1)
+                        zdvice(ji,jj,jl) = v_i(ji,jj,jl1) 
+                     ELSE
+                        zdvice_greater_vicen = .true.
+                     ENDIF
+                  ENDIF
+
+               ENDIF               ! donor > 0
+            END DO                   ! i
+         END DO                 ! j
+
+      END DO !jl
+
+      !-------------------------------------------------------------------------------
+      ! 3) 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) .GT. 0.0 ) THEN ! daice(n) can be < puny
+                  nbrem = nbrem + 1
+                  nind_i(nbrem) = ji
+                  nind_j(nbrem) = jj
+               ENDIF ! tmask
+            END DO
+         END DO
+
+         DO ji = 1, nbrem 
+            zji = nind_i(ji)
+            zjj = nind_j(ji)
+
+            jl1 = zdonor(zji,zjj,jl)
+            zindb             = MAX( 0.0 , SIGN( 1.0 , v_i(zji,zjj,jl1) - epsi10 ) )
+            zworka(zji,zjj)   = zdvice(zji,zjj,jl) / MAX(v_i(zji,zjj,jl1),epsi10) * zindb
+            IF( jl1 == jl) THEN   ;   jl2 = jl1+1
+            ELSE                    ;   jl2 = jl 
+            ENDIF
+
+            !--------------
+            ! Ice areas
+            !--------------
+
+            a_i(zji,zjj,jl1) = a_i(zji,zjj,jl1) - zdaice(zji,zjj,jl)
+            a_i(zji,zjj,jl2) = a_i(zji,zjj,jl2) + zdaice(zji,zjj,jl)
+
+            !--------------
+            ! Ice volumes
+            !--------------
+
+            v_i(zji,zjj,jl1) = v_i(zji,zjj,jl1) - zdvice(zji,zjj,jl) 
+            v_i(zji,zjj,jl2) = v_i(zji,zjj,jl2) + zdvice(zji,zjj,jl)
+
+            !--------------
+            ! Snow volumes
+            !--------------
+
+            zdvsnow          = v_s(zji,zjj,jl1) * zworka(zji,zjj)
+            v_s(zji,zjj,jl1) = v_s(zji,zjj,jl1) - zdvsnow
+            v_s(zji,zjj,jl2) = v_s(zji,zjj,jl2) + zdvsnow 
+
+            !--------------------
+            ! Snow heat content  
+            !--------------------
+
+            zdesnow              = e_s(zji,zjj,1,jl1) * zworka(zji,zjj)
+            e_s(zji,zjj,1,jl1)   = e_s(zji,zjj,1,jl1) - zdesnow
+            e_s(zji,zjj,1,jl2)   = e_s(zji,zjj,1,jl2) + zdesnow
+
+            !--------------
+            ! Ice age 
+            !--------------
+
+            zdo_aice             = oa_i(zji,zjj,jl1) * zdaice(zji,zjj,jl)
+            oa_i(zji,zjj,jl1)    = oa_i(zji,zjj,jl1) - zdo_aice
+            oa_i(zji,zjj,jl2)    = oa_i(zji,zjj,jl2) + zdo_aice
+
+            !--------------
+            ! Ice salinity
+            !--------------
+
+            zdsm_vice            = smv_i(zji,zjj,jl1) * zworka(zji,zjj)
+            smv_i(zji,zjj,jl1)   = smv_i(zji,zjj,jl1) - zdsm_vice
+            smv_i(zji,zjj,jl2)   = smv_i(zji,zjj,jl2) + zdsm_vice
+
+            !---------------------
+            ! Surface temperature
+            !---------------------
+
+            zdaTsf               = t_su(zji,zjj,jl1) * zdaice(zji,zjj,jl)
+            zaTsfn(zji,zjj,jl1)  = zaTsfn(zji,zjj,jl1) - zdaTsf
+            zaTsfn(zji,zjj,jl2)  = zaTsfn(zji,zjj,jl2) + zdaTsf 
+
+         END DO                 ! ji
+
+         !------------------
+         ! Ice heat content
+         !------------------
+
+         DO jk = 1, nlay_i
+!CDIR NODEP
+            DO ji = 1, nbrem
+               zji = nind_i(ji)
+               zjj = nind_j(ji)
+
+               jl1 = zdonor(zji,zjj,jl)
+               IF (jl1 .EQ. jl) THEN
+                  jl2 = jl+1
+               ELSE             ! n1 = n+1
+                  jl2 = jl 
+               ENDIF
+
+               zdeice = e_i(zji,zjj,jk,jl1) * zworka(zji,zjj)
+               e_i(zji,zjj,jk,jl1) =  e_i(zji,zjj,jk,jl1) - zdeice
+               e_i(zji,zjj,jk,jl2) =  e_i(zji,zjj,jk,jl2) + zdeice 
+            END DO              ! ji
+         END DO                 ! jk
+
+      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) 
+                  zindsn          =  1.0 - MAX(0.0,SIGN(1.0,-v_s(ji,jj,jl))) !0 if no ice and 1 if yes
+               ELSE
+                  ht_i(ji,jj,jl)  = 0._wp
+                  t_su(ji,jj,jl)  = rtt
+               ENDIF
+            END DO                 ! ji
+         END DO                 ! jj
+      END DO                    ! jl
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl, zaTsfn )
+      CALL wrk_dealloc( jpi,jpj, zworka )
+      CALL wrk_dealloc( (jpi+1)*(jpj+1), nind_i, nind_j )   ! integer
+      !
+   END SUBROUTINE lim_itd_shiftice
+   
+
+   SUBROUTINE lim_itd_th_reb( klbnd, kubnd, ntyp )
+      !!------------------------------------------------------------------
+      !!                ***  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 , INTENT (in) ::   ntyp    ! number of the ice type involved in the rebinning process
+      !
+      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 
+               IF( a_i(ji,jj,jl) > epsi10 ) THEN 
+                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               ELSE
+                  ht_i(ji,jj,jl) = 0._wp
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------
+      ! 2) Make sure thickness of cat klbnd is at least hi_max_typ(klbnd)
+      !------------------------------------------------------------------------------
+      DO jj = 1, jpj 
+         DO ji = 1, jpi 
+            IF( a_i(ji,jj,klbnd) > epsi10 ) THEN
+               IF( ht_i(ji,jj,klbnd) <= hi_max_typ(0,ntyp) .AND. hi_max_typ(0,ntyp) > 0._wp ) THEN
+                  a_i(ji,jj,klbnd)  = v_i(ji,jj,klbnd) / hi_max_typ(0,ntyp) 
+                  ht_i(ji,jj,klbnd) = hi_max_typ(0,ntyp)
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------
+      ! 3) 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 
+                  zdaice(ji,jj,jl)  = a_i(ji,jj,jl)
+                  zdvice(ji,jj,jl)  = v_i(ji,jj,jl)
+               ENDIF
+            END DO                 ! ji
+         END DO                 ! jj
+         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                    ! jl
+
+      !----------------------------
+      ! 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                 ! ji
+         END DO                 ! jj
+
+         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                    ! jl
+
+      !------------------------------------------------------------------------------
+      ! 4) 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 )   ! interger
+      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           ! Empty routines
+   END SUBROUTINE lim_itd_th
+   SUBROUTINE lim_itd_th_ini
+   END SUBROUTINE lim_itd_th_ini
+   SUBROUTINE lim_itd_th_rem
+   END SUBROUTINE lim_itd_th_rem
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limmsh.F90	(revision 3437)
@@ -0,0 +1,130 @@
+MODULE limmsh
+   !!======================================================================
+   !!                     ***  MODULE  limmsh  ***
+   !! LIM ice model :   definition of the ice mesh parameters
+   !!======================================================================
+   !! History :  3.2  !  2008-01 (NEMO team)  LIM-3: adaptation from LIM-2
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_msh   : definition of the ice mesh
+   !!----------------------------------------------------------------------
+   USE phycst         ! physical constants
+   USE dom_oce        ! ocean domain
+   USE dom_ice        ! sea-ice domain
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! lateral boundary condition - MPP exchanges
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_msh   ! routine called by ice_ini.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lim_msh
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE lim_msh  ***
+      !!              
+      !! ** 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)
+      !! 
+      !! Reference  : Deleersnijder et al. Ocean Modelling 100, 7-10 
+      !!--------------------------------------------------------------------- 
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zusden   ! local scalar
+      !!---------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_msh : LIM-3 sea-ice model, mesh initialization'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+      IF( jphgr_msh == 2 .OR. jphgr_msh == 3 .OR. jphgr_msh == 5 )   &
+          &      CALL ctl_stop(' Coriolis parameter in LIM not set for f- or beta-plane')
+
+      !                           !==  coriolis factor & Equator position ==!
+      njeq   = INT( jpj / 2 ) 
+      njeqm1 = njeq - 1 
+      !
+      fcor(:,:) = 2. * omega * SIN( gphit(:,:) * rad )   ! coriolis factor
+      !
+      IF( fcor(1,1) * fcor(1,nlcj) < 0.e0 ) THEN   ! local domain include both hemisphere
+         l_jeq = .TRUE.
+         njeq  = 1
+         DO WHILE ( njeq <= jpj .AND. fcor(1,njeq) < 0.e0 )
+            njeq = njeq + 1
+         END DO
+         IF(lwp ) WRITE(numout,*) '          the equator is inside the domain at about njeq = ', njeq
+      ELSEIF( fcor(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
+
+
+      !                           !==  metric coefficients for sea ice dynamic  ==!
+      wght(:,:,:,:) = 0.e0
+!!gm  Optimisation :  wght to be defined at F-point, not I-point  and change in limrhg
+      DO jj = 2, jpj
+         DO ji = 2, jpi
+            zusden = 1.e0 / (  ( 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. )
+!!gm end
+
+      !                           !==  ice masks  ==!
+      tms(:,:) = tmask(:,:,1)             ! ice T-point  : use surface tmask
+      tmu(:,:) = umask(:,:,1)             ! ice U-point  : use surface umask  (C-grid EVP)
+      tmv(:,:) = vmask(:,:,1)             ! ice V-point  : use surface vmask  (C-grid EVP)
+      DO jj = 1, jpjm1                    ! ice F-point  : recompute fmask (due to nn_shlat)
+         DO ji = 1 , jpim1   ! NO vector opt.
+            tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * tms(ji+1,jj+1)
+         END DO
+      END DO
+      CALL lbc_lnk( tmf(:,:), 'F', 1. )           ! lateral boundary conditions
+
+      !                           !==  unmasked and masked area of T-grid cell
+      area(:,:) = e1t(:,:) * e2t(:,:)
+      !
+   END SUBROUTINE lim_msh
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy Module         NO LIM sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_msh           ! Dummy routine
+   END SUBROUTINE lim_msh
+#endif
+
+   !!======================================================================
+END MODULE limmsh
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90	(revision 3437)
@@ -0,0 +1,763 @@
+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
+   !!            4.0  !  2011-01  (A Porter)  dynamical allocation 
+   !!----------------------------------------------------------------------
+#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 par_oce          ! Ocean parameters
+   USE dom_oce          ! Ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE lbclnk           ! Lateral Boundary Condition / MPP link
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE in_out_manager   ! I/O manager
+   USE prtctl           ! Print control
+#if defined key_lim3
+   USE ice              ! LIM-3: ice variables
+   USE dom_ice          ! LIM-3: ice domain
+   USE limitd_me        ! LIM-3: 
+#else
+   USE ice_2            ! LIM2: ice variables
+   USE dom_ice_2        ! LIM2: ice domain
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_rhg        ! routine called by lim_dyn (or lim_dyn_2)
+
+   REAL(wp) ::   rzero   = 0._wp   ! constant values
+   REAL(wp) ::   rone    = 1._wp   ! constant values
+      
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! 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
+      !!                 nevp, telast and 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
+      !!              Vancoppenolle et al., Ocean Modelling 2008
+      !!-------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   k_j1    ! southern j-index for ice computation
+      INTEGER, INTENT(in) ::   k_jpj   ! northern j-index for ice computation
+      !!
+      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, zsang, zmask   ! local scalars
+
+      REAL(wp) ::   dtevp              ! time step for subcycling
+      REAL(wp) ::   dtotel, ecc2       ! square of yield ellipse eccenticity
+      REAL(wp) ::   z0, zr, zcca, zccb ! temporary scalars
+      REAL(wp) ::   zu_ice2, zv_ice1   !
+      REAL(wp) ::   zddc, zdtc, zdst   ! delta on corners and on centre
+      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) ::   zindb         ! ice (1) or not (0)      
+      REAL(wp) ::   zdummy        ! 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(:,:) ::   zc1              ! ice mass
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zusw             ! temporary weight for ice strength computation
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce1, v_oce1   ! ocean u/v component on U points                           
+      REAL(wp), POINTER, DIMENSION(:,:) ::   u_oce2, v_oce2   ! ocean u/v component on V points
+      REAL(wp), POINTER, DIMENSION(:,:) ::   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(:,:) ::   zdd   , zdt      ! Divergence and tension at centre of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zds              ! Shear on northeast corner of grid cells
+      REAL(wp), POINTER, DIMENSION(:,:) ::   deltat, deltac   ! Delta at centre and corners 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
+      
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, zpresh, zfrld1, zmass1, zcorl1, za1ct , zpreshc, zfrld2, zmass2, zcorl2, za2ct )
+      CALL wrk_alloc( jpi,jpj, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_alloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          )
+      CALL wrk_alloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
+
+#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
+      !
+      !------------------------------------------------------------------------------!
+      ! 1) Ice-Snow mass (zc1), ice strength (zpresh)                                !
+      !------------------------------------------------------------------------------!
+      !
+      ! Put every vector to 0
+      zpresh (:,:) = 0._wp   ;   zc1   (:,:) = 0._wp
+      zpreshc(:,:) = 0._wp
+      u_ice2 (:,:) = 0._wp   ;   v_ice1(:,:) = 0._wp
+      zdd    (:,:) = 0._wp   ;   zdt   (:,:) = 0._wp   ;   zds(:,:) = 0._wp
+
+#if defined key_lim3
+      CALL lim_itd_me_icestrength( ridge_scheme_swi )      ! LIM-3: Ice strength on T-points
+#endif
+
+!CDIR NOVERRCHK
+      DO jj = k_j1 , k_jpj       ! Ice mass and temp variables
+!CDIR NOVERRCHK
+         DO ji = 1 , jpi
+            zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) )
+#if defined key_lim3
+            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) * 0.5_wp
+#endif
+#if defined key_lim2
+            zpresh(ji,jj) = tms(ji,jj) *  pstar * vt_i(ji,jj) * EXP( -c_rhg * (1. - at_i(ji,jj) ) )
+#endif
+            ! tmi = 1 where there is ice or on land
+            tmi(ji,jj)    = 1._wp - ( 1._wp - MAX( 0._wp , SIGN ( 1._wp , vt_i(ji,jj) - epsd ) ) ) * tms(ji,jj)
+         END DO
+      END DO
+
+      ! Ice strength on grid cell corners (zpreshc)
+      ! needed for calculation of shear stress 
+!CDIR NOVERRCHK
+      DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+         DO ji = 2, jpim1 !RB caution no fs_ (ji+1,jj+1)
+            zstms          =  tms(ji+1,jj+1) * wght(ji+1,jj+1,2,2) + &
+               &              tms(ji,jj+1)   * wght(ji+1,jj+1,1,2) + &
+               &              tms(ji+1,jj)   * wght(ji+1,jj+1,2,1) + &
+               &              tms(ji,jj)     * wght(ji+1,jj+1,1,1)
+            zusw(ji,jj)    = 1.0 / MAX( zstms, epsd )
+            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)   &
+               &             ) * zusw(ji,jj)
+         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                       
+      !  u_oce1: ocean u component on u points                           
+      !  v_oce1: ocean v component on u points                          
+      !  u_oce2: ocean u component on v points                         
+      !  v_oce2: ocean v component on v points                        
+
+      DO jj = k_j1+1, k_jpj-1
+         DO ji = fs_2, fs_jpim1
+
+            zt11 = tms(ji  ,jj) * e1t(ji  ,jj)
+            zt12 = tms(ji+1,jj) * e1t(ji+1,jj)
+            zt21 = tms(ji,jj  ) * e2t(ji,jj  )
+            zt22 = tms(ji,jj+1) * e2t(ji,jj+1)
+
+            ! Leads area.
+            zfrld1(ji,jj) = ( zt12 * ( 1.0 - at_i(ji,jj) ) + zt11 * ( 1.0 - at_i(ji+1,jj) ) ) / ( zt11 + zt12 + epsd )
+            zfrld2(ji,jj) = ( zt22 * ( 1.0 - at_i(ji,jj) ) + zt21 * ( 1.0 - at_i(ji,jj+1) ) ) / ( zt21 + zt22 + epsd )
+
+            ! Mass, coriolis coeff. and currents
+            zmass1(ji,jj) = ( zt12*zc1(ji,jj) + zt11*zc1(ji+1,jj) ) / (zt11+zt12+epsd)
+            zmass2(ji,jj) = ( zt22*zc1(ji,jj) + zt21*zc1(ji,jj+1) ) / (zt21+zt22+epsd)
+            zcorl1(ji,jj) = zmass1(ji,jj) * ( e1t(ji+1,jj)*fcor(ji,jj) + e1t(ji,jj)*fcor(ji+1,jj) )   &
+               &                          / ( e1t(ji,jj) + e1t(ji+1,jj) + epsd )
+            zcorl2(ji,jj) = zmass2(ji,jj) * ( e2t(ji,jj+1)*fcor(ji,jj) + e2t(ji,jj)*fcor(ji,jj+1) )   &
+               &                          / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd )
+            !
+            u_oce1(ji,jj)  = u_oce(ji,jj)
+            v_oce2(ji,jj)  = v_oce(ji,jj)
+
+            ! Ocean has no slip boundary condition
+            v_oce1(ji,jj)  = 0.5*( (v_oce(ji,jj)+v_oce(ji,jj-1))*e1t(ji,jj)    &
+               &                 +(v_oce(ji+1,jj)+v_oce(ji+1,jj-1))*e1t(ji+1,jj)) &
+               &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)  
+
+            u_oce2(ji,jj)  = 0.5*((u_oce(ji,jj)+u_oce(ji-1,jj))*e2t(ji,jj)     &
+               &                 +(u_oce(ji,jj+1)+u_oce(ji-1,jj+1))*e2t(ji,jj+1)) &
+               &                / (e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+
+            ! 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 =  ( ssh_m(ji+1,jj) - ssh_m(ji,jj) ) / e1u(ji,jj)
+            zdsshy =  ( ssh_m(ji,jj+1) - ssh_m(ji,jj) ) / e2v(ji,jj)
+
+            za1ct(ji,jj) = ztagnx - zmass1(ji,jj) * grav * zdsshx
+            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 / nevp
+      dtotel = dtevp / ( 2._wp * telast )
+
+      !-ecc2: square of yield ellipse eccenticrity (reminder: must become a namelist parameter)
+      ecc2 = ecc * ecc
+
+      !-Initialise stress tensor 
+      zs1 (:,:) = stress1_i (:,:) 
+      zs2 (:,:) = stress2_i (:,:)
+      zs12(:,:) = stress12_i(:,:)
+
+      !                                               !----------------------!
+      DO jter = 1 , nevp                              !    loop over jter    !
+         !                                            !----------------------!        
+         DO jj = k_j1, k_jpj-1
+            zu_ice(:,jj) = u_ice(:,jj)    ! velocity at previous time step
+            zv_ice(:,jj) = v_ice(:,jj)
+         END DO
+
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+
+               !  
+               !- Divergence, tension and shear (Section a. Appendix B of Hunke & Dukowicz, 2002)
+               !- zdd(:,:), 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 zdd, 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.
+               !
+               !
+               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
+                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
+                  &          +e1v(ji,jj)*v_ice(ji,jj)                      &
+                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
+                  &          )                                             &
+                  &         / area(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
+                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
+                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
+                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
+                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
+                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
+                  &         )                                              &
+                  &        / area(ji,jj)
+
+               !
+               zds(ji,jj) = ( ( u_ice(ji,jj+1)/e1u(ji,jj+1)                &
+                  &            -u_ice(ji,jj)/e1u(ji,jj)                    &
+                  &           )*e1f(ji,jj)*e1f(ji,jj)                      &
+                  &          +( v_ice(ji+1,jj)/e2v(ji+1,jj)                &
+                  &            -v_ice(ji,jj)/e2v(ji,jj)                    &
+                  &           )*e2f(ji,jj)*e2f(ji,jj)                      &
+                  &         )                                              &
+                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
+                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
+                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
+
+
+               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
+                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
+                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj) 
+
+               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
+                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
+                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+
+            END DO
+         END DO
+         CALL lbc_lnk( v_ice1, 'U', -1. )   ;   CALL lbc_lnk( u_ice2, 'V', -1. )      ! lateral boundary cond.
+
+!CDIR NOVERRCHK
+         DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1
+
+               !- Calculate Delta at centre of grid cells
+               zdst       = (  e2u(ji  , jj) * v_ice1(ji  ,jj)          &
+                  &          - e2u(ji-1, jj) * v_ice1(ji-1,jj)          &
+                  &          + e1v(ji, jj  ) * u_ice2(ji,jj  )          &
+                  &          - e1v(ji, jj-1) * u_ice2(ji,jj-1)          &
+                  &          )                                          &
+                  &         / area(ji,jj)
+
+               delta = SQRT( zdd(ji,jj)*zdd(ji,jj) + ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 )  
+               deltat(ji,jj) = MAX( SQRT(zdd(ji,jj)**2 + (zdt(ji,jj)**2 + zdst**2)*usecc2), creepl )
+
+               !-Calculate stress tensor components zs1 and zs2 
+               !-at centre of grid cells (see section 3.5 of CICE user's guide).
+               zs1(ji,jj) = ( zs1(ji,jj) &
+                  &          - dtotel*( ( 1.0 - alphaevp) * zs1(ji,jj) +    &
+                  &            ( delta / deltat(ji,jj) - zdd(ji,jj) / deltat(ji,jj) ) &
+                  * zpresh(ji,jj) ) )                          &       
+                  &        / ( 1.0 + alphaevp * dtotel )
+
+               zs2(ji,jj) = ( zs2(ji,jj)   &
+                  &          - dtotel*((1.0-alphaevp)*ecc2*zs2(ji,jj) -  &
+                  zdt(ji,jj)/deltat(ji,jj)*zpresh(ji,jj)) ) &
+                  &        / ( 1.0 + alphaevp*ecc2*dtotel )
+
+            END DO
+         END DO
+
+         CALL lbc_lnk( zs1(:,:), 'T', 1. )
+         CALL lbc_lnk( zs2(:,:), 'T', 1. )
+
+!CDIR NOVERRCHK
+         DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1
+               !- Calculate Delta on corners
+               zddc  =      ( ( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
+                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
+                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
+                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
+                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
+                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
+                  &         )                                               &
+                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
+
+               zdtc  =      (-( v_ice1(ji,jj+1)/e1u(ji,jj+1)                &
+                  &            -v_ice1(ji,jj)/e1u(ji,jj)                    &
+                  &           )*e1f(ji,jj)*e1f(ji,jj)                       &
+                  &          +( u_ice2(ji+1,jj)/e2v(ji+1,jj)                &
+                  &            -u_ice2(ji,jj)/e2v(ji,jj)                    &
+                  &           )*e2f(ji,jj)*e2f(ji,jj)                       &
+                  &         )                                               &
+                  &        / ( e1f(ji,jj) * e2f(ji,jj) )
+
+               deltac(ji,jj) = SQRT(zddc**2+(zdtc**2+zds(ji,jj)**2)*usecc2) + creepl
+
+               !-Calculate stress tensor component zs12 at corners (see section 3.5 of CICE user's guide).
+               zs12(ji,jj) = ( zs12(ji,jj)      &
+                  &        - dtotel*( (1.0-alphaevp)*ecc2*zs12(ji,jj) - zds(ji,jj) / &
+                  &          ( 2.0*deltac(ji,jj) ) * zpreshc(ji,jj))) &
+                  &         / ( 1.0 + alphaevp*ecc2*dtotel ) 
+
+            END DO ! ji
+         END DO ! jj
+
+         CALL lbc_lnk( zs12(:,:), 'F', 1. )
+
+         ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002)
+         DO jj = k_j1+1, k_jpj-1
+            DO ji = fs_2, fs_jpim1
+               !- contribution of zs1, zs2 and zs12 to zf1
+               zf1(ji,jj) = 0.5*( (zs1(ji+1,jj)-zs1(ji,jj))*e2u(ji,jj) &
+                  &              +(zs2(ji+1,jj)*e2t(ji+1,jj)**2-zs2(ji,jj)*e2t(ji,jj)**2)/e2u(ji,jj) &
+                  &              +2.0*(zs12(ji,jj)*e1f(ji,jj)**2-zs12(ji,jj-1)*e1f(ji,jj-1)**2)/e1u(ji,jj) &
+                  &             ) / ( e1u(ji,jj)*e2u(ji,jj) )
+               ! contribution of zs1, zs2 and zs12 to zf2
+               zf2(ji,jj) = 0.5*( (zs1(ji,jj+1)-zs1(ji,jj))*e1v(ji,jj) &
+                  &              -(zs2(ji,jj+1)*e1t(ji,jj+1)**2 - zs2(ji,jj)*e1t(ji,jj)**2)/e1v(ji,jj) &
+                  &              + 2.0*(zs12(ji,jj)*e2f(ji,jj)**2 -    &
+                  zs12(ji-1,jj)*e2f(ji-1,jj)**2)/e2v(ji,jj) &
+                  &             ) / ( e1v(ji,jj)*e2v(ji,jj) )
+            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 
+
+!CDIR NOVERRCHK
+            DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)
+                  zsang        = SIGN ( 1.0 , fcor(ji,jj) ) * sangvg
+                  z0           = zmass1(ji,jj)/dtevp
+
+                  ! SB modif because ocean has no slip boundary condition
+                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)         &
+                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
+                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
+                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
+                     (zv_ice1-v_oce1(ji,jj))**2) * (1.0-zfrld1(ji,jj))
+                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
+                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj))
+                  zcca         = z0+za*cangvg
+                  zccb         = zcorl1(ji,jj)+za*zsang
+                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
+
+               END DO
+            END DO
+
+            CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+
+!CDIR NOVERRCHK
+            DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+
+                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)
+                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
+                  z0           = zmass2(ji,jj)/dtevp
+                  ! SB modif because ocean has no slip boundary condition
+                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)     &
+                     &                 + (u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
+                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + & 
+                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
+                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
+                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj))
+                  zcca         = z0+za*cangvg
+                  zccb         = zcorl2(ji,jj)+za*zsang
+                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
+
+               END DO
+            END DO
+
+            CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+
+         ELSE 
+!CDIR NOVERRCHK
+            DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass2(ji,jj))))*tmv(ji,jj)
+                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
+                  z0           = zmass2(ji,jj)/dtevp
+                  ! SB modif because ocean has no slip boundary condition
+                  zu_ice2       = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj)      &
+                     &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj+1))   &
+                     &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)   
+
+                  za           = rhoco*SQRT((zu_ice2-u_oce2(ji,jj))**2 + &
+                     (v_ice(ji,jj)-v_oce2(ji,jj))**2)*(1.0-zfrld2(ji,jj))
+                  zr           = z0*v_ice(ji,jj) + zf2(ji,jj) + &
+                     za2ct(ji,jj) + za*(cangvg*v_oce2(ji,jj)+zsang*u_oce2(ji,jj))
+                  zcca         = z0+za*cangvg
+                  zccb         = zcorl2(ji,jj)+za*zsang
+                  v_ice(ji,jj) = (zr-zccb*zu_ice2)/(zcca+epsd)*zmask
+
+               END DO
+            END DO
+
+            CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+
+!CDIR NOVERRCHK
+            DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1
+                  zmask        = (1.0-MAX(rzero,SIGN(rone,-zmass1(ji,jj))))*tmu(ji,jj)
+                  zsang        = SIGN(1.0,fcor(ji,jj))*sangvg
+                  z0           = zmass1(ji,jj)/dtevp
+                  ! SB modif because ocean has no slip boundary condition
+                  ! GG Bug
+                  !                   zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)      &
+                  !                      &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj))   &
+                  !                      &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
+                  zv_ice1       = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji,jj)      &
+                     &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji+1,jj))   &
+                     &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
+
+                  za           = rhoco*SQRT((u_ice(ji,jj)-u_oce1(ji,jj))**2 + &
+                     (zv_ice1-v_oce1(ji,jj))**2)*(1.0-zfrld1(ji,jj))
+                  zr           = z0*u_ice(ji,jj) + zf1(ji,jj) + za1ct(ji,jj) + &
+                     za*(cangvg*u_oce1(ji,jj)-zsang*v_oce1(ji,jj))
+                  zcca         = z0+za*cangvg
+                  zccb         = zcorl1(ji,jj)+za*zsang
+                  u_ice(ji,jj) = (zr+zccb*zv_ice1)/(zcca+epsd)*zmask 
+               END DO ! ji
+            END DO ! jj
+
+            CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+
+         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 thickness is below 1cm then ice velocity should equal the
+      ! ocean velocity, 
+      ! This prevents high velocity when ice is thin
+!CDIR NOVERRCHK
+      DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1
+            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 
+            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )
+            IF ( zdummy .LE. 5.0e-2 ) THEN
+               u_ice(ji,jj) = u_oce(ji,jj)
+               v_ice(ji,jj) = v_oce(ji,jj)
+            ENDIF ! zdummy
+         END DO
+      END DO
+
+      CALL lbc_lnk( u_ice(:,:), 'U', -1. ) 
+      CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 
+
+      DO jj = k_j1+1, k_jpj-1 
+         DO ji = fs_2, fs_jpim1
+            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 
+            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )
+            IF ( zdummy .LE. 5.0e-2 ) THEN
+               v_ice1(ji,jj)  = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj)   &
+                  &                 +(v_ice(ji+1,jj)+v_ice(ji+1,jj-1))*e1t(ji,jj)) &
+                  &               /(e1t(ji+1,jj)+e1t(ji,jj)) * tmu(ji,jj)
+
+               u_ice2(ji,jj)  = 0.5*( (u_ice(ji,jj)+u_ice(ji-1,jj))*e2t(ji,jj+1)   &
+                  &                 +(u_ice(ji,jj+1)+u_ice(ji-1,jj+1))*e2t(ji,jj)) &
+                  &               /(e2t(ji,jj+1)+e2t(ji,jj)) * tmv(ji,jj)
+            ENDIF ! zdummy
+         END DO
+      END DO
+
+      CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 
+      CALL lbc_lnk( v_ice1(:,:), 'U', -1. )
+
+      ! Recompute delta, shear and div, inputs for mechanical redistribution 
+!CDIR NOVERRCHK
+      DO jj = k_j1+1, k_jpj-1
+!CDIR NOVERRCHK
+         DO ji = fs_2, jpim1   !RB bug no vect opt due to tmi
+            !- zdd(:,:), zdt(:,:): divergence and tension at centre 
+            !- zds(:,:): shear on northeast corner of grid cells
+            zindb  = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 
+            zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )
+
+            IF ( zdummy .LE. 5.0e-2 ) THEN
+
+               zdd(ji,jj) = ( e2u(ji,jj)*u_ice(ji,jj)                      &
+                  &          -e2u(ji-1,jj)*u_ice(ji-1,jj)                  &
+                  &          +e1v(ji,jj)*v_ice(ji,jj)                      &
+                  &          -e1v(ji,jj-1)*v_ice(ji,jj-1)                  &
+                  &         )                                              &
+                  &         / area(ji,jj)
+
+               zdt(ji,jj) = ( ( u_ice(ji,jj)/e2u(ji,jj)                    &
+                  &            -u_ice(ji-1,jj)/e2u(ji-1,jj)                &
+                  &           )*e2t(ji,jj)*e2t(ji,jj)                      &
+                  &          -( v_ice(ji,jj)/e1v(ji,jj)                    &
+                  &            -v_ice(ji,jj-1)/e1v(ji,jj-1)                &
+                  &           )*e1t(ji,jj)*e1t(ji,jj)                      &
+                  &         )                                              &
+                  &        / area(ji,jj)
+               !
+               ! SB modif because ocean has no slip boundary condition 
+               zds(ji,jj) = ( ( u_ice(ji,jj+1) / e1u(ji,jj+1)              &
+                  &           - u_ice(ji,jj)   / e1u(ji,jj) )              &
+                  &           * e1f(ji,jj) * e1f(ji,jj)                    &
+                  &          + ( v_ice(ji+1,jj) / e2v(ji+1,jj)             &
+                  &            - v_ice(ji,jj)  / e2v(ji,jj) )              &
+                  &           * e2f(ji,jj) * e2f(ji,jj) )                  &
+                  &        / ( e1f(ji,jj) * e2f(ji,jj) ) * ( 2.0 - tmf(ji,jj) ) &
+                  &        * tmi(ji,jj) * tmi(ji,jj+1)                     &
+                  &        * tmi(ji+1,jj) * tmi(ji+1,jj+1)
+
+               zdst       = (  e2u( ji  , jj   ) * v_ice1(ji,jj)          &
+                  &          - e2u( ji-1, jj   ) * v_ice1(ji-1,jj)         &
+                  &          + e1v( ji  , jj   ) * u_ice2(ji,jj)           &
+                  &          - e1v( ji  , jj-1 ) * u_ice2(ji,jj-1)         & 
+                  &          )                                             &
+                  &         / area(ji,jj)
+
+               deltat(ji,jj) = SQRT( zdd(ji,jj)*zdd(ji,jj) + & 
+                  &                          ( zdt(ji,jj)*zdt(ji,jj) + zdst*zdst ) * usecc2 & 
+                  &                          ) + creepl
+
+            ENDIF ! zdummy
+
+         END DO !jj
+      END DO !ji
+      !
+      !------------------------------------------------------------------------------!
+      ! 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
+            divu_i (ji,jj) = zdd   (ji,jj)
+            delta_i(ji,jj) = deltat(ji,jj)
+            shear_i(ji,jj) = zds   (ji,jj)
+         END DO
+      END DO
+
+      ! Lateral boundary condition
+      CALL lbc_lnk( divu_i (:,:), 'T', 1. )
+      CALL lbc_lnk( delta_i(:,:), 'T', 1. )
+      CALL lbc_lnk( shear_i(:,:), 'F', 1. )
+
+      ! * 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) .GT. 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, zc1   , u_oce1, u_oce2, u_ice2, zusw  , v_oce1 , v_oce2, v_ice1                )
+      CALL wrk_dealloc( jpi,jpj, zf1   , deltat, zu_ice, zf2   , deltac, zv_ice , zdd   , zdt    , zds          )
+      CALL wrk_dealloc( jpi,jpj, zdd   , zdt   , zds   , zs1   , zs2   , zs12   , zresr                         )
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90	(revision 3437)
@@ -0,0 +1,583 @@
+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 par_ice          ! sea-ice parameters
+   USE dom_oce          ! ocean domain
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE in_out_manager   ! I/O manager
+   USE iom              ! I/O library
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   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 iceini.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/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
+      !!----------------------------------------------------------------------
+      !
+      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
+         ! 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)
+         IF(lwp) THEN
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ice restart binary file: '//clname
+            CASE DEFAULT         ;   WRITE(numout,*) '             open ice restart NetCDF file: '//clname
+            END SELECT
+            IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN   
+               WRITE(numout,*)         '             kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp
+            ELSE   ;   WRITE(numout,*) '             kt = '                         , kt,' date= ', ndastp
+            ENDIF
+         ENDIF
+         !
+         CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )
+         lrst_ice = .TRUE.
+      ENDIF
+      !
+   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=15) ::   znam
+      CHARACTER(len=1)  ::   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,'(I1)') 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 )
+      END DO
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') jl
+         znam = 'tempt_sl1'//'_htc'//zchar
+         z2d(:,:) = e_s(:,:,1,jl)
+         CALL iom_rstput( iter, nitrst, numriw, znam , z2d )
+      END DO
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') jl
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I1)') 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, 'fsbbq'     , fsbbq      )
+      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 )
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') 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,'(I1)') jl
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I1)') 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
+
+      IF( iter == nitrst ) THEN
+         CALL iom_close( numriw )                         ! close the restart file
+         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, indx
+      REAL(wp) ::   zfice, ziter
+      REAL(wp) ::   zs_inf, z_slope_s, zsmax, zsmin, zalpha, zindb   ! local scalars used for the salinity profile
+      REAL(wp), POINTER, DIMENSION(:)  ::   zs_zero 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z2d
+      CHARACTER(len=15) ::   znam
+      CHARACTER(len=1)  ::   zchar, zchar1
+      INTEGER           ::   jlibalt = jprstlib
+      LOGICAL           ::   llok
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( nlay_i, zs_zero )
+      CALL wrk_alloc( jpi, jpj, z2d )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_rst_read : read ice NetCDF restart file'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      IF ( jprstlib == jprstdimg ) THEN
+        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+        ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90
+        INQUIRE( FILE = TRIM(cn_icerst_in)//'.nc', EXIST = llok )
+        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+      ENDIF
+
+      CALL iom_open ( 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 - 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' )
+      IF( INT(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' )
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') 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(:,:)
+      END DO
+
+      DO jl = 1, jpl 
+         CALL lbc_lnk( smv_i(:,:,jl) , 'T' ,  1. )
+         CALL lbc_lnk( v_i  (:,:,jl) , 'T' ,  1. )
+         CALL lbc_lnk( a_i  (:,:,jl) , 'T' ,  1. )
+      END DO
+
+      ! we first with bulk ice salinity
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindb          = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - 1.0e-4 ) ) 
+               sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX(v_i(ji,jj,jl),1.0e-6) * zindb
+               ht_i(ji,jj,jl) = v_i(ji,jj,jl)   / MAX(a_i(ji,jj,jl),1.0e-6) * zindb
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, nlay_i
+         s_i(:,:,jk,:) = sm_i(:,:,:)
+      END DO
+
+      IF( num_sal == 2 ) THEN      ! Salinity profile
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zs_inf        = sm_i(ji,jj,jl)
+                     z_slope_s     = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01_wp , ht_i(ji,jj,jl) )
+                     !- slope of the salinity profile
+                     zs_zero(jk)   = z_slope_s * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) / REAL(nlay_i,wp)
+                     zsmax = 4.5_wp
+                     zsmin = 3.5_wp
+                     IF( sm_i(ji,jj,jl) .LT. zsmin ) THEN
+                        zalpha = 1._wp
+                     ELSEIF( sm_i(ji,jj,jl) .LT.zsmax ) THEN
+                        zalpha = sm_i(ji,jj,jl) / ( zsmin - zsmax ) + zsmax / ( zsmax - zsmin )
+                     ELSE
+                        zalpha = 0._wp
+                     ENDIF
+                     s_i(ji,jj,jk,jl) = zalpha * zs_zero(jk) + ( 1._wp - zalpha ) * zs_inf
+                  END DO
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') jl
+         znam = 'tempt_sl1'//'_htc'//zchar
+         CALL iom_get( numrir, jpdom_autoglo, znam , z2d )
+         e_s(:,:,1,jl) = z2d(:,:)
+      END DO
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') jl
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I1)') 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, 'fsbbq'     , fsbbq      )
+      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 )
+
+      DO jl = 1, jpl 
+         WRITE(zchar,'(I1)') 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,'(I1)') jl
+         DO jk = 1, nlay_i 
+            WRITE(zchar1,'(I1)') 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
+      !
+      CALL iom_close( numrir )
+      !
+      CALL wrk_dealloc( nlay_i, zs_zero )
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90	(revision 3437)
@@ -0,0 +1,417 @@
+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
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#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 par_ice          ! ice parameters
+   USE dom_oce          ! ocean domain
+   USE sbc_ice          ! Surface boundary condition: sea-ice fields
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE phycst           ! physical constants
+   USE albedo           ! albedo parameters
+   USE ice              ! LIM sea-ice variables
+   USE lbclnk           ! ocean lateral boundary condition
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+   USE prtctl           ! Print control
+   USE cpl_oasis3, ONLY : lk_cpl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_sbc_init   ! called by ice_init
+   PUBLIC   lim_sbc_flx    ! called by sbc_ice_lim
+   PUBLIC   lim_sbc_tau    ! called by sbc_ice_lim
+
+   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(:,:) ::   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 
+      !!              - emps    : freshwater budget: concentration/dillution 
+      !!              - fr_i    : ice fraction
+      !!              - tn_ice  : sea-ice surface temperature
+      !!              - alb_ice : sea-ice alberdo (lk_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  ::   ierr             ! local integer
+      INTEGER  ::   ifvt, i1mfr, idfr               ! some switches
+      INTEGER  ::   iflt, ial, iadv, ifral, ifrdv
+      REAL(wp) ::   zinda, zfons, zpme              ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zfcm1 , zfcm2    ! solar/non solar heat fluxes
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalb, zalbp   ! 2D/3D workspace
+      !!---------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi, jpj, zfcm1 , zfcm2 )
+      IF( lk_cpl )   CALL wrk_alloc( jpi, jpj, jpl, zalb, zalbp )
+
+      !------------------------------------------!
+      !      heat flux at the ocean surface      !
+      !------------------------------------------!
+      ! pfrld is the lead fraction at the previous time step (actually between TRP and THD)
+      ! changed to old_frld and old ht_i
+
+      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) ) )  !subscripts are bad here
+            i1mfr   = 1.0 - MAX( rzero , SIGN( rone ,  - ( at_i(ji,jj)       ) ) )
+            idfr    = 1.0 - MAX( rzero , SIGN( rone , ( 1.0 - at_i(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 
+
+            ! switch --- 1.0 ---------------- 0.0 --------------------
+            ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+            ! zinda   | if pfrld = 1       | if pfrld < 1            |
+            !  -> ifvt| if pfrld old_ht_i
+            ! i1mfr   | if frld = 1        | if frld  < 1            |
+            ! idfr    | if frld <= pfrld    | if frld > pfrld        |
+            ! iflt    | 
+            ! ial     |
+            ! iadv    |
+            ! ifral
+            ! ifrdv
+
+            !   computation the solar flux at ocean surface
+            zfcm1(ji,jj)   = pfrld(ji,jj) * qsr(ji,jj)  + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
+            ! fstric     Solar flux transmitted trough the ice
+            ! qsr        Net short wave heat flux on free ocean
+            ! new line
+            fscmbq(ji,jj) = ( 1.0 - pfrld(ji,jj) ) * fstric(ji,jj)
+
+            !  computation the non solar heat flux at ocean surface
+            zfcm2(ji,jj) = - zfcm1(ji,jj)                  &
+               &           + iflt    * ( fscmbq(ji,jj) )   & ! total abl -> fscmbq is given to the ocean
+               ! fscmbq and ffltbif are obsolete
+               !              &           + iflt * ffltbif(ji,jj) !!! only if one category is used
+               &           + ifral   * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice   &
+               &           + ifrdv   * ( qfvbq(ji,jj) + qdtcn(ji,jj) )                   * r1_rdtice   &
+               &           + fhmec(ji,jj)     & ! new contribution due to snow melt in ridging!!
+               &           + fheat_rpo(ji,jj) & ! contribution from ridge formation
+               &           + fheat_res(ji,jj)
+            ! fscmbq  Part of the solar radiation transmitted through the ice and going to the ocean
+            !         computed in limthd_zdf.F90
+            ! ffltbif Total heat content of the ice (brine pockets+ice) / delta_t
+            ! qcmif   Energy needed to bring the ocean surface layer until its freezing (ok)
+            ! qldif   heat balance of the lead (or of the open ocean)
+            ! qfvbq   i think this is wrong!
+            ! ---> Array used to store energy in case of total lateral ablation
+            ! qfvbq latent heat uptake/release after accretion/ablation
+            ! qdtcn Energy from the turbulent oceanic heat flux heat flux coming in the lead
+
+            IF ( num_sal == 2 ) zfcm2(ji,jj) = zfcm2(ji,jj) + &
+               fhbri(ji,jj) ! new contribution due to brine drainage 
+
+            ! bottom radiative component is sent to the computation of the
+            ! oceanic heat flux
+            fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj)     
+
+            ! used to compute the oceanic heat flux at the next time step
+            qsr(ji,jj) = zfcm1(ji,jj)                                       ! solar heat flux 
+            qns(ji,jj) = zfcm2(ji,jj) - fdtcn(ji,jj)                        ! non solar heat flux
+            !                           ! fdtcn : turbulent oceanic heat flux
+
+            !!gm   this IF prevents the vertorisation of the whole loop
+            IF ( ( ji == jiindx ) .AND. ( jj == jjindx) ) THEN
+               WRITE(numout,*) ' lim_sbc : heat fluxes '
+               WRITE(numout,*) ' qsr       : ', qsr(jiindx,jjindx)
+               WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx)
+               WRITE(numout,*) ' pfrld     : ', pfrld(jiindx,jjindx)
+               WRITE(numout,*) ' fstric    : ', fstric (jiindx,jjindx)
+               WRITE(numout,*)
+               WRITE(numout,*) ' qns       : ', qns(jiindx,jjindx)
+               WRITE(numout,*) ' zfcm2     : ', zfcm2(jiindx,jjindx)
+               WRITE(numout,*) ' zfcm1     : ', zfcm1(jiindx,jjindx)
+               WRITE(numout,*) ' ifral     : ', ifral
+               WRITE(numout,*) ' ial       : ', ial  
+               WRITE(numout,*) ' qcmif     : ', qcmif(jiindx,jjindx)
+               WRITE(numout,*) ' qldif     : ', qldif(jiindx,jjindx)
+               WRITE(numout,*) ' qcmif / dt: ', qcmif(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' qldif / dt: ', qldif(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' ifrdv     : ', ifrdv
+               WRITE(numout,*) ' qfvbq     : ', qfvbq(jiindx,jjindx)
+               WRITE(numout,*) ' qdtcn     : ', qdtcn(jiindx,jjindx)
+               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(jiindx,jjindx) * r1_rdtice
+               WRITE(numout,*) ' '
+               WRITE(numout,*) ' fdtcn     : ', fdtcn(jiindx,jjindx)
+               WRITE(numout,*) ' fhmec     : ', fhmec(jiindx,jjindx)
+               WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(jiindx,jjindx)
+               WRITE(numout,*) ' fhbri     : ', fhbri(jiindx,jjindx)
+               WRITE(numout,*) ' fheat_res : ', fheat_res(jiindx,jjindx)
+            ENDIF
+            !!gm   end
+         END DO
+      END DO
+
+      !------------------------------------------!
+      !      mass flux at the ocean surface      !
+      !------------------------------------------!
+
+!!gm   optimisation: this loop have to be merged with the previous one
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !  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
+            !        
+
+            !  computing freshwater exchanges at the ice/ocean interface
+            zpme = - emp(ji,jj)     * ( 1.0 - at_i(ji,jj)          )  &   ! evaporation over oceanic fraction
+               &   + tprecip(ji,jj) *         at_i(ji,jj)             &   ! all precipitation reach the ocean
+               &   - sprecip(ji,jj) * ( 1. - (pfrld(ji,jj)**betas) )  &   ! except solid precip intercepted by sea-ice
+               &   - rdmsnif(ji,jj) * r1_rdtice                       &   ! freshwaterflux due to snow melting 
+               &   + fmmec(ji,jj)                                         ! snow falling when ridging
+
+
+            !  computing salt exchanges at the ice/ocean interface
+            !  sice should be the same as computed with the ice model
+            zfons =  ( soce_0(ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice 
+            ! SOCE
+            zfons =  ( sss_m (ji,jj) - sice_0(ji,jj) ) * rdmicif(ji,jj) * r1_rdtice
+
+            !CT useless            !  salt flux for constant salinity
+            !CT useless            fsalt(ji,jj)      =  zfons / ( sss_m(ji,jj) + epsi16 ) + fsalt_res(ji,jj)
+            !  salt flux for variable salinity
+            zinda             = 1.0 - MAX( rzero , SIGN( rone , - ( 1.0 - pfrld(ji,jj) ) ) )
+            !  correcting brine and salt fluxes
+            fsbri(ji,jj)      =  zinda*fsbri(ji,jj)
+            !  converting the salt fluxes from ice to a freshwater flux from ocean
+            fsalt_res(ji,jj)  =  fsalt_res(ji,jj) / ( sss_m(ji,jj) + epsi16 )
+            fseqv(ji,jj)      =  fseqv(ji,jj)     / ( sss_m(ji,jj) + epsi16 )
+            fsbri(ji,jj)      =  fsbri(ji,jj)     / ( sss_m(ji,jj) + epsi16 )
+            fsalt_rpo(ji,jj)  =  fsalt_rpo(ji,jj) / ( sss_m(ji,jj) + epsi16 )
+
+            !  freshwater mass exchange (positive to the ice, negative for the ocean ?)
+            !  actually it's a salt flux (so it's minus freshwater flux)
+            !  if sea ice grows, zfons is positive, fsalt also
+            !  POSITIVE SALT FLUX FROM THE ICE TO THE OCEAN
+            !  POSITIVE FRESHWATER FLUX FROM THE OCEAN TO THE ICE [kg.m-2.s-1]
+
+            emp(ji,jj) = - zpme 
+         END DO
+      END DO
+
+      IF( num_sal == 2 ) THEN      ! variable ice salinity: brine drainage included in the salt flux
+         emps(:,:) = fsbri(:,:) + fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:)
+      ELSE                         ! constant ice salinity:
+         emps(:,:) =              fseqv(:,:) + fsalt_res(:,:) + fsalt_rpo(:,:) + emp(:,:)
+      ENDIF
+
+      !-----------------------------------------------!
+      !   Storing the transmitted variables           !
+      !-----------------------------------------------!
+      fr_i  (:,:)   = at_i(:,:)             ! Sea-ice fraction            
+      tn_ice(:,:,:) = t_su(:,:,:)           ! Ice surface temperature                      
+
+      !------------------------------------------------!
+      !    Computation of snow/ice and ocean albedo    !
+      !------------------------------------------------!
+      IF( lk_cpl ) THEN          ! coupled case
+         CALL albedo_ice( t_su, ht_i, ht_s, zalbp, zalb )                  ! snow/ice albedo
+         !
+         alb_ice(:,:,:) =  0.5_wp * zalbp(:,:,:) + 0.5_wp * zalb (:,:,:)   ! Ice albedo (mean clear and overcast skys)
+      ENDIF
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab2d_1=qsr   , clinfo1=' lim_sbc: qsr    : ', tab2d_2=qns , clinfo2=' qns     : ' )
+         CALL prt_ctl( tab2d_1=emp   , clinfo1=' lim_sbc: emp    : ', tab2d_2=emps, clinfo2=' emps    : ' )
+         CALL prt_ctl( tab2d_1=fr_i  , clinfo1=' lim_sbc: fr_i   : ' )
+         CALL prt_ctl( tab3d_1=tn_ice, clinfo1=' lim_sbc: tn_ice : ', kdim=jpl )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zfcm1 , zfcm2 )
+      IF( lk_cpl )   CALL wrk_dealloc( jpi, jpj, jpl, zalb, zalbp )
+      ! 
+   END SUBROUTINE lim_sbc_flx
+
+
+   SUBROUTINE lim_sbc_tau( kt , pu_oce, pv_oce )
+      !!-------------------------------------------------------------------
+      !!                ***  ROUTINE lim_sbc_tau ***
+      !!  
+      !! ** Purpose : Update the ocean surface stresses due to the ice
+      !!         
+      !! ** Action  : * at each ice time step (every nn_fsbc time step):
+      !!                - compute the modulus of ice-ocean relative velocity 
+      !!                  (*rho*Cd) at T-point (C-grid) or I-point (B-grid)
+      !!                      tmod_io = rhoco * | U_ice-U_oce |
+      !!                - update the modulus of stress at ocean surface
+      !!                      taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce |
+      !!              * at each ocean time step (every kt): 
+      !!                  compute linearized ice-ocean stresses as
+      !!                      Utau = tmod_io * | U_ice - pU_oce |
+      !!                using instantaneous current ocean velocity (usually before)
+      !!
+      !!    NB: - ice-ocean rotation angle no more allowed
+      !!        - here we make an approximation: taum is only computed every ice time step
+      !!          This avoids mutiple average to pass from T -> U,V grids and next from U,V grids 
+      !!          to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximaton...
+      !!
+      !! ** Outputs : - utau, vtau   : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
+      !!              - taum         : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
+      !!---------------------------------------------------------------------
+      INTEGER ,                     INTENT(in) ::   kt               ! ocean time-step index
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pu_oce, pv_oce   ! surface ocean currents
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zat_u, zutau_ice, zu_t, zmodt   ! local scalar
+      REAL(wp) ::   zat_v, zvtau_ice, zv_t          !   -      -
+      !!---------------------------------------------------------------------
+      !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !==  Ice time-step only  ==!   (i.e. surface module time-step)
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1                             !* update the modulus of stress at ocean surface (T-point)
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1
+               !                                               ! 2*(U_ice-U_oce) at T-point
+               zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj)   
+               zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1) 
+               !                                              ! |U_ice-U_oce|^2
+               zmodt =  0.25_wp * (  zu_t * zu_t + zv_t * zv_t  )
+               !                                               ! update the ocean stress modulus
+               taum(ji,jj) = ( 1._wp - at_i(ji,jj) ) * taum(ji,jj) + at_i(ji,jj) * rhoco * zmodt
+               tmod_io(ji,jj) = rhoco * SQRT( zmodt )          ! rhoco * |U_ice-U_oce| at T-point
+            END DO
+         END DO
+         CALL lbc_lnk( taum, 'T', 1. )   ;   CALL lbc_lnk( tmod_io, 'T', 1. )
+         !
+         utau_oce(:,:) = utau(:,:)                    !* save the air-ocean stresses at ice time-step
+         vtau_oce(:,:) = vtau(:,:)
+         !
+      ENDIF
+      !
+      !                                      !==  every ocean time-step  ==!
+      !
+      DO jj = 2, jpjm1                                !* update the stress WITHOUT a ice-ocean rotation angle
+         DO ji = fs_2, fs_jpim1   ! Vect. Opt.
+            zat_u  = ( at_i(ji,jj) + at_i(ji+1,jj) ) * 0.5_wp   ! ice area at u and V-points
+            zat_v  = ( at_i(ji,jj) + at_i(ji,jj+1) ) * 0.5_wp
+            !                                                   ! linearized quadratic drag formulation
+            zutau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
+            zvtau_ice   = 0.5_wp * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
+            !                                                   ! stresses at the ocean surface
+            utau(ji,jj) = ( 1._wp - zat_u ) * utau_oce(ji,jj) + zat_u * zutau_ice
+            vtau(ji,jj) = ( 1._wp - zat_v ) * vtau_oce(ji,jj) + zat_v * zvtau_ice
+         END DO
+      END DO
+      CALL lbc_lnk( utau, 'U', -1. )   ;   CALL lbc_lnk( vtau, 'V', -1. )   ! lateral boundary condition
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau   : ', mask1=umask,   &
+         &                       tab2d_2=vtau, clinfo2=' vtau    : '        , mask2=vmask )
+      !  
+   END SUBROUTINE lim_sbc_tau
+
+
+   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
+      !!-------------------------------------------------------------------
+      !
+      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' )
+      !
+      r1_rdtice = 1. / rdt_ice
+      !
+      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case
+      sice_0(:,:) = sice
+      !
+      IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea 
+         WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   &
+            &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         ) 
+            soce_0(:,:) = 4._wp
+            sice_0(:,:) = 2._wp
+         END WHERE
+      ENDIF
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtab.F90	(revision 3437)
@@ -0,0 +1,71 @@
+MODULE limtab
+   !!======================================================================
+   !!                       ***  MODULE limtab   ***
+   !!   LIM : 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90	(revision 3437)
@@ -0,0 +1,858 @@
+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 rdmsnif
+   !!            3.3  ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#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             ! LIM: sea-ice variables
+   USE par_ice         ! LIM: sea-ice parameters
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE thd_ice         ! LIM thermodynamic sea-ice variables
+   USE dom_ice         ! LIM sea-ice domain
+   USE domvvl          ! domain: variable volume level
+   USE limthd_dif      ! LIM: thermodynamics, vertical diffusion
+   USE limthd_dh       ! LIM: thermodynamics, ice and snow thickness variation
+   USE limthd_sal      ! LIM: thermodynamics, ice salinity
+   USE limthd_ent      ! LIM: thermodynamics, ice enthalpy redistribution
+   USE limtab          ! LIM: 1D <==> 2D transformation
+   USE limvar          ! LIM: sea-ice variables
+   USE lbclnk          ! lateral boundary condition - MPP links
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd        ! called by limstp module
+   PUBLIC   lim_thd_init   ! called by iceini module
+
+   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values
+   REAL(wp) ::   epsi16 = 1e-16_wp   !
+   REAL(wp) ::   epsi10 = 1e-10_wp   !
+   REAL(wp) ::   epsi06 = 1e-06_wp   !
+   REAL(wp) ::   epsi04 = 1e-04_wp   !
+   REAL(wp) ::   zzero  = 0._wp      !
+   REAL(wp) ::   zone   = 1._wp      !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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 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 : H. Goosse et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! number of iteration
+      !!
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   nbpb             ! nb of icy pts for thermo. cal.
+      REAL(wp) ::   zfric_umin = 5e-03_wp    ! lower bound for the friction velocity
+      REAL(wp) ::   zfric_umax = 2e-02_wp    ! upper bound for the friction velocity
+      REAL(wp) ::   zinda, zindb, zthsnice, zfric_u     ! local scalar
+      REAL(wp) ::   zfntlat, zpareff, zareamin, zcoef   !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlbsbq   ! link with lead energy budget qldif
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zqlbsbq )
+   
+      !------------------------------------------------------------------------------!
+      ! 1) Initialization of diagnostic variables                                    !
+      !------------------------------------------------------------------------------!
+
+      !--------------------
+      ! 1.2) Heat content    
+      !--------------------
+      ! Change the units of heat content; from global units to J.m3
+      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]
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_i(ji,jj,jl) , epsi06 ) ) * nlay_i
+                  !0 if no ice and 1 if yes
+                  zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i(ji,jj,jl) ) ) 
+                  !convert units ! very important that this line is here
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * unit_fac * zindb 
+               END DO
+            END DO
+         END DO
+         DO jk = 1, nlay_s
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  !Energy of melting q(S,T) [J.m-3]
+                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi06 ) ) * nlay_s
+                  !0 if no ice and 1 if yes
+                  zindb = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s(ji,jj,jl) ) ) 
+                  !convert units ! very important that this line is here
+                  e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * unit_fac * zindb 
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-----------------------------
+      ! 1.3) Set some dummies to 0
+      !-----------------------------
+      rdvosif(:,:) = 0.e0   ! variation of ice volume at surface
+      rdvobif(:,:) = 0.e0   ! variation of ice volume at bottom
+      fdvolif(:,:) = 0.e0   ! total variation of ice volume
+      rdvonif(:,:) = 0.e0   ! lateral variation of ice volume
+      fstric (:,:) = 0.e0   ! part of solar radiation transmitted through the ice
+      ffltbif(:,:) = 0.e0   ! linked with fstric
+      qfvbq  (:,:) = 0.e0   ! linked with fstric
+      rdmsnif(:,:) = 0.e0   ! variation of snow mass per unit area
+      rdmicif(:,:) = 0.e0   ! variation of ice mass per unit area
+      hicifp (:,:) = 0.e0   ! daily thermodynamic ice production. 
+      fsbri  (:,:) = 0.e0   ! brine flux contribution to salt flux to the ocean
+      fhbri  (:,:) = 0.e0   ! brine flux contribution to heat flux to the ocean
+      fseqv  (:,:) = 0.e0   ! equivalent salt flux to the ocean due to ice/growth decay
+
+      !-----------------------------------
+      ! 1.4) Compute global heat content
+      !-----------------------------------
+      qt_i_in  (:,:) = 0.e0
+      qt_s_in  (:,:) = 0.e0
+      qt_i_fin (:,:) = 0.e0
+      qt_s_fin (:,:) = 0.e0
+      sum_fluxq(:,:) = 0.e0
+      fatm     (:,:) = 0.e0
+
+      ! 2) Partial computation of forcing for the thermodynamic sea ice model.      !
+      !-----------------------------------------------------------------------------!
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            zthsnice       = SUM( ht_s(ji,jj,1:jpl) ) + SUM( ht_i(ji,jj,1:jpl) )
+            zindb          = tms(ji,jj) * ( 1.0 - MAX( zzero , SIGN( zone , - zthsnice ) ) ) 
+            phicif(ji,jj)  = vt_i(ji,jj)
+            pfrld(ji,jj)   = 1.0 - at_i(ji,jj)
+            zinda          = 1.0 - MAX( zzero , SIGN( zone , - ( 1.0 - pfrld(ji,jj) ) ) )
+            !
+            !           !  solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
+            !           !  practically no "direct lateral ablation"
+            !           
+            !           !  net downward heat flux from the ice to the ocean, expressed as a function of ocean 
+            !           !  temperature and turbulent mixing (McPhee, 1992)
+            ! friction velocity
+            zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
+
+            ! here the drag will depend on ice thickness and type (0.006)
+            fdtcn(ji,jj)  = zindb * rau0 * rcp * 0.006  * zfric_u * ( (sst_m(ji,jj) + rt0) - t_bo(ji,jj) ) 
+            ! also category dependent
+            !           !-- Energy from the turbulent oceanic heat flux heat flux coming in the lead 
+            qdtcn(ji,jj)  = zindb * fdtcn(ji,jj) * (1.0 - at_i(ji,jj)) * rdt_ice
+            !                       
+            !           !-- Lead heat budget, qldif (part 1, next one is in limthd_dh) 
+            !           !   caution: exponent betas used as more snow can fallinto leads
+            qldif(ji,jj) =  tms(ji,jj) * rdt_ice  * (                             &
+               &   pfrld(ji,jj)        * (  qsr(ji,jj)                            &   ! solar heat
+               &                            + qns(ji,jj)                          &   ! non solar heat
+               &                            + fdtcn(ji,jj)                        &   ! turbulent ice-ocean heat
+               &                            + fsbbq(ji,jj) * ( 1.0 - zindb )  )   &   ! residual heat from previous step
+               & - pfrld(ji,jj)**betas * sprecip(ji,jj) * lfus                    )   ! latent heat of sprecip melting
+            !
+            ! Positive heat budget is used for bottom ablation
+            zfntlat        = 1.0 - MAX( zzero , SIGN( zone ,  - qldif(ji,jj) ) )
+            != 1 if positive heat budget
+            zpareff        = 1.0 - zinda * zfntlat
+            != 0 if ice and positive heat budget and 1 if one of those two is false
+            zqlbsbq(ji,jj) = qldif(ji,jj) * ( 1.0 - zpareff ) / MAX( at_i(ji,jj) * rdt_ice , epsi16 )
+            !
+            ! Heat budget of the lead, energy transferred from ice to ocean
+            qldif  (ji,jj) = zpareff * qldif(ji,jj)
+            qdtcn  (ji,jj) = zpareff * qdtcn(ji,jj)
+            !
+            ! Energy needed to bring ocean surface layer until its freezing (qcmif, limflx)
+            qcmif  (ji,jj) =  rau0 * rcp * fse3t(ji,jj,1) * ( t_bo(ji,jj) - (sst_m(ji,jj) + rt0) ) * ( 1. - zinda )
+            !
+            ! oceanic heat flux (limthd_dh)
+            fbif   (ji,jj) = zindb * (  fsbbq(ji,jj) / MAX( at_i(ji,jj) , epsi20 ) + fdtcn(ji,jj) )
+            !
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 3) Select icy points and fulfill arrays for the vectorial grid.            
+      !------------------------------------------------------------------------------!
+
+      DO jl = 1, jpl      !loop over ice categories
+
+         IF( kt == nit000 .AND. lwp ) THEN
+            WRITE(numout,*) ' lim_thd : transfer to 1D vectors. Category no : ', jl 
+            WRITE(numout,*) ' ~~~~~~~~'
+         ENDIF
+
+         zareamin = 1.e-10
+         nbpb = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( a_i(ji,jj,jl) .gt. zareamin ) THEN     
+                  nbpb      = nbpb  + 1
+                  npb(nbpb) = (jj - 1) * jpi + ji
+               ENDIF
+               ! debug point to follow
+               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN
+                  jiindex_1d = nbpb
+               ENDIF
+            END DO
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 4) Thermodynamic computation
+         !------------------------------------------------------------------------------!
+
+         IF( lk_mpp )   CALL mpp_ini_ice( nbpb , numout )
+
+         IF( nbpb > 0 ) THEN  ! If there is no ice, do nothing.
+
+            !-------------------------
+            ! 4.1 Move to 1D arrays
+            !-------------------------
+
+            CALL tab_2d_1d( nbpb, at_i_b     (1:nbpb), at_i            , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, a_i_b      (1:nbpb), a_i(:,:,jl)     , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, ht_i_b     (1:nbpb), ht_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, ht_s_b     (1:nbpb), ht_s(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+
+            CALL tab_2d_1d( nbpb, t_su_b     (1:nbpb), t_su(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, sm_i_b     (1:nbpb), sm_i(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            DO jk = 1, nlay_s
+               CALL tab_2d_1d( nbpb, t_s_b(1:nbpb,jk), t_s(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, q_s_b(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_b(1:nbpb,jk), t_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, q_i_b(1:nbpb,jk), e_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+               CALL tab_2d_1d( nbpb, s_i_b(1:nbpb,jk), s_i(:,:,jk,jl)  , jpi, jpj, npb(1:nbpb) )
+            END DO
+
+            CALL tab_2d_1d( nbpb, tatm_ice_1d(1:nbpb), tatm_ice(:,:)   , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, qsr_ice_1d (1:nbpb), qsr_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, fr1_i0_1d  (1:nbpb), fr1_i0          , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, fr2_i0_1d  (1:nbpb), fr2_i0          , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, qnsr_ice_1d(1:nbpb), qns_ice(:,:,jl) , jpi, jpj, npb(1:nbpb) )
+
+#if ! defined key_coupled
+            CALL tab_2d_1d( nbpb, qla_ice_1d (1:nbpb), qla_ice(:,:,jl)    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, dqla_ice_1d(1:nbpb), dqla_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) )
+#endif
+
+            CALL tab_2d_1d( nbpb, dqns_ice_1d(1:nbpb), dqns_ice(:,:,jl)   , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, t_bo_b     (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, fbif_1d    (1:nbpb), fbif       , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, qldif_1d   (1:nbpb), qldif      , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, rdmicif_1d (1:nbpb), rdmicif    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, rdmsnif_1d (1:nbpb), rdmsnif    , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, dmgwi_1d   (1:nbpb), dmgwi      , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, qlbbq_1d   (1:nbpb), zqlbsbq    , jpi, jpj, npb(1:nbpb) )
+
+            CALL tab_2d_1d( nbpb, fseqv_1d   (1:nbpb), fseqv      , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, fsbri_1d   (1:nbpb), fsbri      , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, fhbri_1d   (1:nbpb), fhbri      , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, fstbif_1d  (1:nbpb), fstric     , jpi, jpj, npb(1:nbpb) )
+            CALL tab_2d_1d( nbpb, qfvbq_1d   (1:nbpb), qfvbq      , jpi, jpj, npb(1:nbpb) )
+
+            !--------------------------------
+            ! 4.3) Thermodynamic processes
+            !--------------------------------
+
+            IF( con_i )   CALL lim_thd_enmelt( 1, nbpb )   ! computes sea ice energy of melting
+            IF( con_i )   CALL lim_thd_glohec( qt_i_in, qt_s_in, q_i_layer_in, 1, nbpb, jl )
+
+            !                                 !---------------------------------!
+            CALL lim_thd_dif( 1, nbpb, jl )   ! Ice/Snow Temperature profile    !
+            !                                 !---------------------------------!
+
+            CALL lim_thd_enmelt( 1, nbpb )    ! computes sea ice energy of melting compulsory for limthd_dh
+
+            IF( con_i )   CALL lim_thd_glohec ( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 
+            IF( con_i )   CALL lim_thd_con_dif( 1 , nbpb , jl )
+
+            !                                 !---------------------------------!
+            CALL lim_thd_dh( 1, nbpb, jl )    ! Ice/Snow thickness              ! 
+            !                                 !---------------------------------!
+
+            !                                 !---------------------------------!
+            CALL lim_thd_ent( 1, nbpb, jl )   ! Ice/Snow enthalpy remapping     !
+            !                                 !---------------------------------!
+
+            !                                 !---------------------------------!
+            CALL lim_thd_sal( 1, nbpb )       ! Ice salinity computation        !
+            !                                 !---------------------------------!
+
+            !           CALL lim_thd_enmelt(1,nbpb)   ! computes sea ice energy of melting
+            IF( con_i )   CALL lim_thd_glohec( qt_i_fin, qt_s_fin, q_i_layer_fin, 1, nbpb, jl ) 
+            IF( con_i )   CALL lim_thd_con_dh ( 1 , nbpb , jl )
+
+            !--------------------------------
+            ! 4.4) Move 1D to 2D vectors
+            !--------------------------------
+
+            CALL tab_1d_2d( nbpb, at_i        , npb, at_i_b(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, ht_i(:,:,jl), npb, ht_i_b(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, ht_s(:,:,jl), npb, ht_s_b(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, a_i (:,:,jl), npb, a_i_b(1:nbpb) , jpi, jpj )
+            CALL tab_1d_2d( nbpb, t_su(:,:,jl), npb, t_su_b(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, sm_i(:,:,jl), npb, sm_i_b(1:nbpb), jpi, jpj )
+
+            DO jk = 1, nlay_s
+               CALL tab_1d_2d( nbpb, t_s(:,:,jk,jl), npb, t_s_b(1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, e_s(:,:,jk,jl), npb, q_s_b(1:nbpb,jk), jpi, jpj)
+            END DO
+
+            DO jk = 1, nlay_i
+               CALL tab_1d_2d( nbpb, t_i(:,:,jk,jl), npb, t_i_b(1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, e_i(:,:,jk,jl), npb, q_i_b(1:nbpb,jk), jpi, jpj)
+               CALL tab_1d_2d( nbpb, s_i(:,:,jk,jl), npb, s_i_b(1:nbpb,jk), jpi, jpj)
+            END DO
+
+            CALL tab_1d_2d( nbpb, fstric , npb, fstbif_1d (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, qldif  , npb, qldif_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, qfvbq  , npb, qfvbq_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, rdmicif, npb, rdmicif_1d(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, rdmsnif, npb, rdmsnif_1d(1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, dmgwi  , npb, dmgwi_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, rdvosif, npb, dvsbq_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, rdvobif, npb, dvbbq_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, fdvolif, npb, dvlbq_1d  (1:nbpb), jpi, jpj )
+            CALL tab_1d_2d( nbpb, rdvonif, npb, dvnbq_1d  (1:nbpb), jpi, jpj ) 
+            CALL tab_1d_2d( nbpb, fseqv  , npb, fseqv_1d  (1:nbpb), jpi, jpj )
+            !
+            IF( num_sal == 2 ) THEN
+               CALL tab_1d_2d( nbpb, fsbri, npb, fsbri_1d(1:nbpb), jpi, jpj )
+               CALL tab_1d_2d( nbpb, fhbri, npb, fhbri_1d(1:nbpb), jpi, jpj )
+            ENDIF
+            !
+            !+++++
+            !temporary stuff for a dummy version
+            CALL tab_1d_2d( nbpb, dh_i_surf2D, npb, dh_i_surf(1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, dh_i_bott2D, npb, dh_i_bott(1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, fsup2D     , npb, fsup     (1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, focea2D    , npb, focea    (1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, s_i_newice , npb, s_i_new  (1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, izero(:,:,jl) , npb, i0    (1:nbpb)      , jpi, jpj )
+            CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qnsr_ice_1d(1:nbpb), jpi, jpj)
+            !+++++
+            !
+            IF( lk_mpp )   CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
+         ENDIF
+         !
+      END DO
+
+      !------------------------------------------------------------------------------!
+      ! 5) Global variables, diagnostics
+      !------------------------------------------------------------------------------!
+
+      !------------------------
+      ! 5.1) Ice heat content              
+      !------------------------
+      ! Enthalpies are global variables we have to readjust the units
+      zcoef = 1._wp / ( unit_fac * REAL( nlay_i ) )
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            ! Multiply by volume, divide by nlayers so that heat content in 10^9 Joules
+            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_i(:,:,jl) * zcoef
+         END DO
+      END DO
+
+      !------------------------
+      ! 5.2) Snow heat content              
+      !------------------------
+      ! Enthalpies are global variables we have to readjust the units
+      zcoef = 1._wp / ( unit_fac * REAL( nlay_s ) )
+      DO jl = 1, jpl
+         DO jk = 1, nlay_s
+            ! Multiply by volume, so that heat content in 10^9 Joules
+            e_s(:,:,jk,jl) = e_s(:,:,jk,jl) * area(:,:) * a_i(:,:,jl) * ht_s(:,:,jl) * zcoef
+         END DO
+      END DO
+
+      !----------------------------------
+      ! 5.3) Change thickness to volume
+      !----------------------------------
+      CALL lim_var_eqv2glo
+
+      !--------------------------------------------
+      ! 5.4) Diagnostic thermodynamic growth rates
+      !--------------------------------------------
+      d_v_i_thd(:,:,:) = v_i      (:,:,:) - old_v_i(:,:,:)    ! ice volumes 
+      dv_dt_thd(:,:,:) = d_v_i_thd(:,:,:) / rdt_ice * 86400.0
+
+      IF( con_i )   fbif(:,:) = fbif(:,:) + zqlbsbq(:,:)
+
+      IF(ln_ctl) THEN            ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_thd  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_thd  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_thd  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_thd  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_thd  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_thd  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_thd  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_thd  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_thd  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_thd  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_thd  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_thd  : smv_i    : ')
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_thd  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_thd  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zqlbsbq )
+      !
+   END SUBROUTINE lim_thd
+
+
+   SUBROUTINE lim_thd_glohec( eti, ets, etilayer, kideb, kiut, jl )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_glohec *** 
+      !!                 
+      !! ** Purpose :  Compute total heat content for each category
+      !!               Works with 1d vectors only
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   )                         ::   kideb, kiut   ! bounds for the spatial loop
+      INTEGER , INTENT(in   )                         ::   jl            ! category number
+      REAL(wp), INTENT(  out), DIMENSION (jpij,jpl  ) ::   eti, ets      ! vertically-summed heat content for ice & snow
+      REAL(wp), INTENT(  out), DIMENSION (jpij,jkmax) ::   etilayer      ! heat content for ice layers
+      !!
+      INTEGER  ::   ji,jk   ! loop indices
+      !!-----------------------------------------------------------------------
+      eti(:,:) = 0._wp
+      ets(:,:) = 0._wp
+      !
+      DO jk = 1, nlay_i                ! total q over all layers, ice [J.m-2]
+         DO ji = kideb, kiut
+            etilayer(ji,jk) = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i
+            eti     (ji,jl) = eti(ji,jl) + etilayer(ji,jk) 
+         END DO
+      END DO
+      DO ji = kideb, kiut              ! total q over all layers, snow [J.m-2]
+         ets(ji,jl) = ets(ji,jl) + q_s_b(ji,1) * ht_s_b(ji) / nlay_s
+      END DO
+      !
+      IF(lwp) WRITE(numout,*) ' lim_thd_glohec '
+      IF(lwp) WRITE(numout,*) ' qt_i_in : ', eti(jiindex_1d,jl) / rdt_ice
+      IF(lwp) WRITE(numout,*) ' qt_s_in : ', ets(jiindex_1d,jl) / rdt_ice
+      IF(lwp) WRITE(numout,*) ' qt_in   : ', ( eti(jiindex_1d,jl) + ets(jiindex_1d,jl) ) / rdt_ice
+      !
+   END SUBROUTINE lim_thd_glohec
+
+
+   SUBROUTINE lim_thd_con_dif( kideb, kiut, jl )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_con_dif *** 
+      !!                 
+      !! ** Purpose :   Test energy conservation after heat diffusion
+      !!-------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   kideb, kiut   ! bounds for the spatial loop
+      INTEGER , INTENT(in   ) ::   jl            ! category number
+
+      INTEGER  ::   ji, jk         ! loop indices
+      INTEGER  ::   zji, zjj
+      INTEGER  ::   numce          ! number of points for which conservation is violated
+      REAL(wp) ::   meance         ! mean conservation error
+      REAL(wp) ::   max_cons_err, max_surf_err
+      !!---------------------------------------------------------------------
+
+      max_cons_err =  1.0_wp          ! maximum tolerated conservation error
+      max_surf_err =  0.001_wp        ! maximum tolerated surface error
+
+      !--------------------------
+      ! Increment of energy
+      !--------------------------
+      ! global
+      DO ji = kideb, kiut
+         dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl)
+      END DO
+      ! layer by layer
+      dq_i_layer(:,:) = q_i_layer_fin(:,:) - q_i_layer_in(:,:)
+
+      !----------------------------------------
+      ! Atmospheric heat flux, ice heat budget
+      !----------------------------------------
+      DO ji = kideb, kiut
+         zji = MOD( npb(ji) - 1 , jpi ) + 1
+         zjj =    ( npb(ji) - 1 ) / jpi + 1
+         fatm     (ji,jl) = qnsr_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji)
+         sum_fluxq(ji,jl) = fc_su(ji) - fc_bo_i(ji) + qsr_ice_1d(ji) * i0(ji) - fstroc(zji,zjj,jl)
+      END DO
+
+      !--------------------
+      ! Conservation error
+      !--------------------
+      DO ji = kideb, kiut
+         cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )
+      END DO
+
+      numce  = 0
+      meance = 0._wp
+      DO ji = kideb, kiut
+         IF ( cons_error(ji,jl) .GT. max_cons_err ) THEN
+            numce = numce + 1
+            meance = meance + cons_error(ji,jl)
+         ENDIF
+      END DO
+      IF( numce > 0 )   meance = meance / numce
+
+      WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err
+      WRITE(numout,*) ' After lim_thd_dif, category : ', jl
+      WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit
+      WRITE(numout,*) ' Number of points where there is a cons err gt than c.e. : ', numce, numit
+
+      !-------------------------------------------------------
+      ! Surface error due to imbalance between Fatm and Fcsu
+      !-------------------------------------------------------
+      numce  = 0
+      meance = 0._wp
+
+      DO ji = kideb, kiut
+         surf_error(ji,jl) = ABS ( fatm(ji,jl) - fc_su(ji) )
+         IF( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) THEN
+            numce = numce + 1 
+            meance = meance + surf_error(ji,jl)
+         ENDIF
+      ENDDO
+      IF( numce > 0 )   meance = meance / numce
+
+      WRITE(numout,*) ' Maximum tolerated surface error : ', max_surf_err
+      WRITE(numout,*) ' After lim_thd_dif, category : ', jl
+      WRITE(numout,*) ' Mean surface error on big error points ', meance, numit
+      WRITE(numout,*) ' Number of points where there is a surf err gt than surf_err : ', numce, numit
+
+      IF (jiindex_1D.GT.0) WRITE(numout,*) ' fc_su      : ', fc_su(jiindex_1d)
+      IF (jiindex_1D.GT.0) WRITE(numout,*) ' fatm       : ', fatm(jiindex_1d,jl)
+      IF (jiindex_1D.GT.0) WRITE(numout,*) ' t_su       : ', t_su_b(jiindex_1d)
+
+      !---------------------------------------
+      ! Write ice state in case of big errors
+      !---------------------------------------
+      DO ji = kideb, kiut
+         IF ( ( ( t_su_b(ji) .LT. rtt ) .AND. ( surf_error(ji,jl) .GT. max_surf_err ) ) .OR. &
+            ( cons_error(ji,jl) .GT. max_cons_err  ) ) THEN
+            zji                 = MOD( npb(ji) - 1, jpi ) + 1
+            zjj                 = ( npb(ji) - 1 ) / jpi + 1
+            !
+            WRITE(numout,*) ' alerte 1     '
+            WRITE(numout,*) ' Untolerated conservation / surface error after '
+            WRITE(numout,*) ' heat diffusion in the ice '
+            WRITE(numout,*) ' Category   : ', jl
+            WRITE(numout,*) ' zji , zjj  : ', zji, zjj
+            WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj)
+            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl)
+            WRITE(numout,*) ' surf_error : ', surf_error(ji,jl)
+            WRITE(numout,*) ' dq_i       : ', - dq_i(ji,jl) / rdt_ice
+            WRITE(numout,*) ' Fdt        : ', sum_fluxq(ji,jl)
+            WRITE(numout,*)
+            !        WRITE(numout,*) ' qt_i_in   : ', qt_i_in(ji,jl)
+            !        WRITE(numout,*) ' qt_s_in   : ', qt_s_in(ji,jl)
+            !        WRITE(numout,*) ' qt_i_fin  : ', qt_i_fin(ji,jl)
+            !        WRITE(numout,*) ' qt_s_fin  : ', qt_s_fin(ji,jl)
+            !        WRITE(numout,*) ' qt        : ', qt_i_fin(ji,jl) + qt_s_fin(ji,jl)
+            WRITE(numout,*) ' ht_i       : ', ht_i_b(ji)
+            WRITE(numout,*) ' ht_s       : ', ht_s_b(ji)
+            WRITE(numout,*) ' t_su       : ', t_su_b(ji)
+            WRITE(numout,*) ' t_s        : ', t_s_b(ji,1)
+            WRITE(numout,*) ' t_i        : ', t_i_b(ji,1:nlay_i)
+            WRITE(numout,*) ' t_bo       : ', t_bo_b(ji)
+            WRITE(numout,*) ' q_i        : ', q_i_b(ji,1:nlay_i)
+            WRITE(numout,*) ' s_i        : ', s_i_b(ji,1:nlay_i)
+            WRITE(numout,*) ' tmelts     : ', rtt - tmut*s_i_b(ji,1:nlay_i)
+            WRITE(numout,*)
+            WRITE(numout,*) ' Fluxes '
+            WRITE(numout,*) ' ~~~~~~ '
+            WRITE(numout,*) ' fatm       : ', fatm(ji,jl)
+            WRITE(numout,*) ' fc_su      : ', fc_su    (ji)
+            WRITE(numout,*) ' fstr_inice : ', qsr_ice_1d(ji)*i0(ji)
+            WRITE(numout,*) ' fc_bo      : ', - fc_bo_i  (ji)
+            WRITE(numout,*) ' foc        : ', fbif_1d(ji)
+            WRITE(numout,*) ' fstroc     : ', fstroc   (zji,zjj,jl)
+            WRITE(numout,*) ' i0         : ', i0(ji)
+            WRITE(numout,*) ' qsr_ice    : ', (1.0-i0(ji))*qsr_ice_1d(ji)
+            WRITE(numout,*) ' qns_ice    : ', qnsr_ice_1d(ji)
+            WRITE(numout,*) ' Conduction fluxes : '
+            WRITE(numout,*) ' fc_s      : ', fc_s(ji,0:nlay_s)
+            WRITE(numout,*) ' fc_i      : ', fc_i(ji,0:nlay_i)
+            WRITE(numout,*)
+            WRITE(numout,*) ' Layer by layer ... '
+            WRITE(numout,*) ' dq_snow : ', ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' dfc_snow  : ', fc_s(ji,1) - fc_s(ji,0)
+            DO jk = 1, nlay_i
+               WRITE(numout,*) ' layer  : ', jk
+               WRITE(numout,*) ' dq_ice : ', dq_i_layer(ji,jk) / rdt_ice  
+               WRITE(numout,*) ' radab  : ', radab(ji,jk)
+               WRITE(numout,*) ' dfc_i  : ', fc_i(ji,jk) - fc_i(ji,jk-1)
+               WRITE(numout,*) ' tot f  : ', fc_i(ji,jk) - fc_i(ji,jk-1) - radab(ji,jk)
+            END DO
+
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE lim_thd_con_dif
+
+
+   SUBROUTINE lim_thd_con_dh( kideb, kiut, jl )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_con_dh  *** 
+      !!                 
+      !! ** Purpose :   Test energy conservation after enthalpy redistr.
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kideb, kiut   ! bounds for the spatial loop
+      INTEGER, INTENT(in) ::   jl            ! category number
+      !
+      INTEGER  ::   ji                ! loop indices
+      INTEGER  ::   zji, zjj, numce         ! local integers
+      REAL(wp) ::   meance, max_cons_err    !local scalar
+      !!---------------------------------------------------------------------
+
+      max_cons_err = 1._wp
+
+      !--------------------------
+      ! Increment of energy
+      !--------------------------
+      DO ji = kideb, kiut
+         dq_i(ji,jl) = qt_i_fin(ji,jl) - qt_i_in(ji,jl) + qt_s_fin(ji,jl) - qt_s_in(ji,jl)   ! global
+      END DO
+      dq_i_layer(:,:)    = q_i_layer_fin(:,:) - q_i_layer_in(:,:)                            ! layer by layer
+
+      !----------------------------------------
+      ! Atmospheric heat flux, ice heat budget
+      !----------------------------------------
+      DO ji = kideb, kiut
+         zji = MOD( npb(ji) - 1 , jpi ) + 1
+         zjj =    ( npb(ji) - 1 ) / jpi + 1
+
+         fatm      (ji,jl) = qnsr_ice_1d(ji) + qsr_ice_1d(ji)                       ! total heat flux
+         sum_fluxq (ji,jl) = fatm(ji,jl) + fbif_1d(ji) - ftotal_fin(ji) - fstroc(zji,zjj,jl) 
+         cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )
+      END DO
+
+      !--------------------
+      ! Conservation error
+      !--------------------
+      DO ji = kideb, kiut
+         cons_error(ji,jl) = ABS( dq_i(ji,jl) / rdt_ice + sum_fluxq(ji,jl) )
+      END DO
+
+      numce = 0
+      meance = 0._wp
+      DO ji = kideb, kiut
+         IF( cons_error(ji,jl) .GT. max_cons_err ) THEN
+            numce = numce + 1
+            meance = meance + cons_error(ji,jl)
+         ENDIF
+      ENDDO
+      IF(numce > 0 ) meance = meance / numce
+
+      WRITE(numout,*) ' Error report - Category : ', jl
+      WRITE(numout,*) ' ~~~~~~~~~~~~ '
+      WRITE(numout,*) ' Maximum tolerated conservation error : ', max_cons_err
+      WRITE(numout,*) ' After lim_thd_ent, category : ', jl
+      WRITE(numout,*) ' Mean conservation error on big error points ', meance, numit
+      WRITE(numout,*) ' Number of points where there is a cons err gt than 0.1 W/m2 : ', numce, numit
+
+      !---------------------------------------
+      ! Write ice state in case of big errors
+      !---------------------------------------
+      DO ji = kideb, kiut
+         IF ( cons_error(ji,jl) .GT. max_cons_err  ) THEN
+            zji = MOD( npb(ji) - 1, jpi ) + 1
+            zjj =    ( npb(ji) - 1 ) / jpi + 1
+            !
+            WRITE(numout,*) ' alerte 1 - category : ', jl
+            WRITE(numout,*) ' Untolerated conservation error after limthd_ent '
+            WRITE(numout,*) ' zji , zjj  : ', zji, zjj
+            WRITE(numout,*) ' lat, lon   : ', gphit(zji,zjj), glamt(zji,zjj)
+            WRITE(numout,*) ' * '
+            WRITE(numout,*) ' Ftotal     : ', sum_fluxq(ji,jl)
+            WRITE(numout,*) ' dq_t       : ', - dq_i(ji,jl) / rdt_ice
+            WRITE(numout,*) ' dq_i       : ', - ( qt_i_fin(ji,jl) - qt_i_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' dq_s       : ', - ( qt_s_fin(ji,jl) - qt_s_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' cons_error : ', cons_error(ji,jl)
+            WRITE(numout,*) ' * '
+            WRITE(numout,*) ' Fluxes        --- : '
+            WRITE(numout,*) ' fatm       : ', fatm(ji,jl)
+            WRITE(numout,*) ' foce       : ', fbif_1d(ji)
+            WRITE(numout,*) ' fres       : ', ftotal_fin(ji)
+            WRITE(numout,*) ' fhbri      : ', fhbricat(zji,zjj,jl)
+            WRITE(numout,*) ' * '
+            WRITE(numout,*) ' Heat contents --- : '
+            WRITE(numout,*) ' qt_s_in    : ', qt_s_in(ji,jl) / rdt_ice
+            WRITE(numout,*) ' qt_i_in    : ', qt_i_in(ji,jl) / rdt_ice
+            WRITE(numout,*) ' qt_in      : ', ( qt_i_in(ji,jl) + qt_s_in(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' qt_s_fin   : ', qt_s_fin(ji,jl) / rdt_ice
+            WRITE(numout,*) ' qt_i_fin   : ', qt_i_fin(ji,jl) / rdt_ice
+            WRITE(numout,*) ' qt_fin     : ', ( qt_i_fin(ji,jl) + qt_s_fin(ji,jl) ) / rdt_ice
+            WRITE(numout,*) ' * '
+            WRITE(numout,*) ' Ice variables --- : '
+            WRITE(numout,*) ' ht_i       : ', ht_i_b(ji)
+            WRITE(numout,*) ' ht_s       : ', ht_s_b(ji)
+            WRITE(numout,*) ' dh_s_tot  : ', dh_s_tot(ji)
+            WRITE(numout,*) ' dh_snowice: ', dh_snowice(ji)
+            WRITE(numout,*) ' dh_i_surf : ', dh_i_surf(ji)
+            WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji)
+         ENDIF
+         !
+      END DO
+      !
+   END SUBROUTINE lim_thd_con_dh
+
+
+   SUBROUTINE lim_thd_enmelt( kideb, kiut )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_thd_enmelt *** 
+      !!                 
+      !! ** Purpose :   Computes sea ice energy of melting q_i (J.m-3)
+      !!
+      !! ** 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_b(ji,jk) + rtt 
+            q_i_b(ji,jk) =    rhoic * ( cpic * ( ztmelts - t_i_b(ji,jk) )                                 &
+               &                      + lfus * ( 1.0 - (ztmelts-rtt) / MIN( t_i_b(ji,jk)-rtt, -epsi10 ) )   &
+               &                      - rcp  * ( ztmelts-rtt  )  ) 
+         END DO
+      END DO
+      DO jk = 1, nlay_s             ! Snow energy of melting
+         DO ji = kideb, kiut
+            q_s_b(ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus )
+         END DO
+      END DO
+      !
+   END SUBROUTINE lim_thd_enmelt
+
+
+   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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicethd/ hmelt , hiccrit, fraz_swi, maxfrazb, vfrazb, Cfrazb,   &
+         &                hicmin, hiclim, amax  ,                                &
+         &                sbeta  , parlat, hakspl, hibspl, exld,                 &
+         &                hakdif, hnzst  , thth  , parsub, alphs, betas,         & 
+         &                kappa_i, nconv_i_thd, maxer_i_thd, thcon_i_swi
+      !!-------------------------------------------------------------------
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_thd : Ice Thermodynamics'
+         WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      !
+      REWIND( numnam_ice )                  ! read Namelist numnam_ice
+      READ  ( numnam_ice , namicethd )
+      !
+      IF(lwp) THEN                          ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'   Namelist of ice parameters for ice thermodynamic computation '
+         WRITE(numout,*)'      maximum melting at the bottom                           hmelt        = ', hmelt
+         WRITE(numout,*)'      ice thick. for lateral accretion in NH (SH)             hiccrit(1/2) = ', hiccrit
+         WRITE(numout,*)'      Frazil ice thickness as a function of wind or not       fraz_swi     = ', fraz_swi
+         WRITE(numout,*)'      Maximum proportion of frazil ice collecting at bottom   maxfrazb     = ', maxfrazb
+         WRITE(numout,*)'      Thresold relative drift speed for collection of frazil  vfrazb       = ', vfrazb
+         WRITE(numout,*)'      Squeezing coefficient for collection of frazil          Cfrazb       = ', Cfrazb
+         WRITE(numout,*)'      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,*)'      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
+         WRITE(numout,*)'      coefficient for ice-lead partition of snowfall          betas        = ', betas
+         WRITE(numout,*)'      extinction radiation parameter in sea ice (1.0)         kappa_i      = ', kappa_i
+         WRITE(numout,*)'      maximal n. of iter. for heat diffusion computation      nconv_i_thd  = ', nconv_i_thd
+         WRITE(numout,*)'      maximal err. on T for heat diffusion computation        maxer_i_thd  = ', maxer_i_thd
+         WRITE(numout,*)'      switch for comp. of thermal conductivity in the ice     thcon_i_swi  = ', thcon_i_swi
+      ENDIF
+      !
+      rcdsn = hakdif * rcdsn 
+      rcdic = hakdif * rcdic
+      !
+   END SUBROUTINE lim_thd_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Dummy module          NO  LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE limthd
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90	(revision 3437)
@@ -0,0 +1,715 @@
+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 rdmsnif & rdmicif
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#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 par_ice          ! LIM parameters
+   USE thd_ice          ! LIM thermodynamics
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_dh   ! called by lim_thd
+
+   REAL(wp) ::   epsi20 = 1e-20   ! constant values
+   REAL(wp) ::   epsi13 = 1e-13   !
+   REAL(wp) ::   epsi16 = 1e-16   !
+   REAL(wp) ::   zzero  = 0.e0    !
+   REAL(wp) ::   zone   = 1.e0    !
+
+   !!----------------------------------------------------------------------
+   !! 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, jl )
+      !!------------------------------------------------------------------
+      !!                ***  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 , INTENT(in) ::   jl            ! Thickness cateogry number
+      !! 
+      INTEGER  ::   ji , jk        ! dummy loop indices
+      INTEGER  ::   zji, zjj       ! 2D corresponding indices to ji
+      INTEGER  ::   isnow          ! switch for presence (1) or absence (0) of snow
+      INTEGER  ::   isnowic        ! snow ice formation not
+      INTEGER  ::   i_ice_switch   ! ice thickness above a certain treshold or not
+      INTEGER  ::   iter
+
+      REAL(wp) ::   zzfmass_i, zihgnew                     ! local scalar
+      REAL(wp) ::   zzfmass_s, zhsnew, ztmelts             ! local scalar
+      REAL(wp) ::   zhn, zdhcf, zdhbf, zhni, zhnfi, zihg   !
+      REAL(wp) ::   zdhnm, zhnnew, zhisn, zihic, zzc       !
+      REAL(wp) ::   zfracs       ! fractionation coefficient for bottom salt entrapment
+      REAL(wp) ::   zds          ! increment of bottom ice salinity
+      REAL(wp) ::   zcoeff       ! dummy argument for snowfall partitioning over ice and leads
+      REAL(wp) ::   zsm_snowice  ! snow-ice salinity
+      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) ::   ztform       ! bottom formation temperature
+      !
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_i        ! ice layer thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_s        ! snow layer thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   ztfs        ! melting point
+      REAL(wp), POINTER, DIMENSION(:) ::   zhsold      ! old snow thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zqprec      ! energy of fallen snow
+      REAL(wp), POINTER, DIMENSION(:) ::   zqfont_su   ! incoming, remaining surface energy
+      REAL(wp), POINTER, DIMENSION(:) ::   zqfont_bo   ! incoming, bottom energy
+      REAL(wp), POINTER, DIMENSION(:) ::   z_f_surf    ! surface heat for ablation
+      REAL(wp), POINTER, DIMENSION(:) ::   zhgnew      ! new ice thickness
+      REAL(wp), POINTER, DIMENSION(:) ::   zfmass_i    ! 
+
+      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(:) ::   zfsalt_melt   ! salt flux due to ice melt
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdeltah
+
+      ! Pathological cases
+      REAL(wp), POINTER, DIMENSION(:) ::   zfdt_init   ! total incoming heat for ice melt
+      REAL(wp), POINTER, DIMENSION(:) ::   zfdt_final  ! total remaing heat for ice melt
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_i       ! total ice heat content
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_s       ! total snow heat content
+      REAL(wp), POINTER, DIMENSION(:) ::   zqt_dummy   ! dummy heat content
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqt_i_lay   ! total ice heat content
+
+      ! Heat conservation 
+      INTEGER  ::   num_iter_max, numce_dh
+      REAL(wp) ::   meance_dh
+      REAL(wp), POINTER, DIMENSION(:) ::   zinnermelt
+      REAL(wp), POINTER, DIMENSION(:) ::   zfbase, zdq_i
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i )
+      CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )
+      CALL wrk_alloc( jpij, zinnermelt, zfbase, zdq_i )
+      CALL wrk_alloc( jpij, jkmax, zdeltah, zqt_i_lay )
+
+      zfsalt_melt(:)  = 0._wp
+      ftotal_fin(:)   = 0._wp
+      zfdt_init(:)    = 0._wp
+      zfdt_final(:)   = 0._wp
+
+      DO ji = kideb, kiut
+         old_ht_i_b(ji) = ht_i_b(ji)
+         old_ht_s_b(ji) = ht_s_b(ji)
+      END DO
+      !
+      !------------------------------------------------------------------------------!
+      !  1) Calculate available heat for surface ablation                            !
+      !------------------------------------------------------------------------------!
+      !
+      DO ji = kideb, kiut
+         isnow         = INT( 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_s_b(ji) ) ) )
+         ztfs(ji)      = isnow * rtt + ( 1.0 - isnow ) * rtt
+         z_f_surf(ji)  = qnsr_ice_1d(ji) + ( 1.0 - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji)
+         z_f_surf(ji)  = MAX( zzero , z_f_surf(ji) ) * MAX( zzero , SIGN( zone , t_su_b(ji) - ztfs(ji) ) )
+         zfdt_init(ji) = ( z_f_surf(ji) + MAX( fbif_1d(ji) + qlbbq_1d(ji) + fc_bo_i(ji),0.0 ) ) * rdt_ice
+      END DO ! ji
+
+      zqfont_su  (:) = 0._wp
+      zqfont_bo  (:) = 0._wp
+      dsm_i_se_1d(:) = 0._wp     
+      dsm_i_si_1d(:) = 0._wp   
+      !
+      !------------------------------------------------------------------------------!
+      !  2) Computing layer thicknesses and  snow and sea-ice enthalpies.            !
+      !------------------------------------------------------------------------------!
+      !
+      DO ji = kideb, kiut     ! Layer thickness
+         zh_i(ji) = ht_i_b(ji) / nlay_i
+         zh_s(ji) = ht_s_b(ji) / nlay_s
+      END DO
+      !
+      zqt_s(:) = 0._wp        ! Total enthalpy of the snow
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            zqt_s(ji) =  zqt_s(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s
+         END DO
+      END DO
+      !
+      zqt_i(:) = 0._wp        ! Total enthalpy of the ice
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            zzc = q_i_b(ji,jk) * ht_i_b(ji) / nlay_i
+            zqt_i(ji)        =  zqt_i(ji) + zzc
+            zqt_i_lay(ji,jk) =              zzc
+         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
+
+      ! Snow fall
+      DO ji = kideb, kiut
+         zcoeff = ( 1.0 - ( 1.0 - at_i_b(ji) )**betas ) / at_i_b(ji) 
+         zdh_s_pre(ji) = zcoeff * sprecip_1d(ji) * rdt_ice / rhosn
+      END DO
+      zdh_s_mel(:) =  0._wp
+
+      ! Melt of fallen snow
+      DO ji = kideb, kiut
+         ! tatm_ice is now in K
+         zqprec   (ji)   =  rhosn * ( cpic * ( rtt - tatm_ice_1d(ji) ) + lfus )  
+         zqfont_su(ji)   =  z_f_surf(ji) * rdt_ice
+         zdeltah  (ji,1) =  MIN( 0.e0 , - zqfont_su(ji) / MAX( zqprec(ji) , epsi13 ) )
+         zqfont_su(ji)   =  MAX( 0.e0 , - zdh_s_pre(ji) - zdeltah(ji,1)              ) * zqprec(ji)
+         zdeltah  (ji,1) =  MAX( - zdh_s_pre(ji) , zdeltah(ji,1) )
+         zdh_s_mel(ji)   =  zdh_s_mel(ji) + zdeltah(ji,1)
+         ! heat conservation
+         qt_s_in(ji,jl)  =  qt_s_in(ji,jl) + zqprec(ji) * zdh_s_pre(ji)
+         zqt_s  (ji)     =  zqt_s  (ji)    + zqprec(ji) * zdh_s_pre(ji)
+         zqt_s  (ji)     =  MAX( zqt_s(ji) - zqfont_su(ji) , 0.e0 ) 
+      END DO
+
+
+      ! Snow melt due to surface heat imbalance
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            zdeltah  (ji,jk) = - zqfont_su(ji) / q_s_b(ji,jk)
+            zqfont_su(ji)    =  MAX( 0.0 , - zh_s(ji) - zdeltah(ji,jk) ) * q_s_b(ji,jk) 
+            zdeltah  (ji,jk) =  MAX( zdeltah(ji,jk) , - zh_s(ji) )
+            zdh_s_mel(ji)    =  zdh_s_mel(ji) + zdeltah(ji,jk)        ! resulting melt of snow    
+         END DO
+      END DO
+
+      ! Apply snow melt to snow depth
+      DO ji = kideb, kiut
+         dh_s_tot(ji)   =  zdh_s_mel(ji) + zdh_s_pre(ji)
+         ! Old and new snow depths
+         zhsold(ji)     =  ht_s_b(ji)
+         zhsnew         =  ht_s_b(ji) + dh_s_tot(ji)
+         ! If snow is still present zhn = 1, else zhn = 0
+         zhn            =  1.0 - MAX( zzero , SIGN( zone , - zhsnew ) )
+         ht_s_b(ji)     =  MAX( zzero , zhsnew )
+         ! Volume and mass variations of snow
+         dvsbq_1d  (ji) =  a_i_b(ji) * ( ht_s_b(ji) - zhsold(ji) - zdh_s_mel(ji) )
+         dvsbq_1d  (ji) =  MIN( zzero, dvsbq_1d(ji) )
+         rdmsnif_1d(ji) =  rdmsnif_1d(ji) + rhosn * dvsbq_1d(ji)
+      END DO ! ji
+
+      !--------------------------
+      ! 3.2 Surface ice ablation 
+      !--------------------------
+      DO ji = kideb, kiut 
+         dh_i_surf(ji) =  0._wp
+         z_f_surf (ji) =  zqfont_su(ji) / rdt_ice ! heat conservation test
+         zdq_i    (ji) =  0._wp
+      END DO ! ji
+
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut 
+            !                                                    ! melt of layer jk
+            zdeltah  (ji,jk) = - zqfont_su(ji) / q_i_b(ji,jk)
+            !                                                    ! recompute heat available
+            zqfont_su(ji)    = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk) 
+            !                                                    ! melt of layer jk cannot be higher than its thickness
+            zdeltah  (ji,jk) = MAX( zdeltah(ji,jk) , - zh_i(ji) )
+            !                                                    ! update surface melt
+            dh_i_surf(ji)    = dh_i_surf(ji) + zdeltah(ji,jk) 
+            !                                                    ! for energy conservation
+            zdq_i    (ji)    = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice
+            !
+            ! contribution to ice-ocean salt flux 
+            zji = MOD( npb(ji) - 1 , jpi ) + 1
+            zjj =    ( npb(ji) - 1 ) / jpi + 1
+            zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji) ) * a_i_b(ji)    &
+               &                              * MIN( zdeltah(ji,jk) , 0.e0 ) * rhoic / rdt_ice 
+         END DO
+      END DO
+
+      !                     !-------------------
+      IF( con_i ) THEN      ! Conservation test
+         !                  !-------------------
+         numce_dh  = 0
+         meance_dh = 0._wp
+         DO ji = kideb, kiut
+            IF ( ( z_f_surf(ji) + zdq_i(ji) ) .GE. 1.0e-3 ) THEN
+               numce_dh  = numce_dh + 1
+               meance_dh = meance_dh + z_f_surf(ji) + zdq_i(ji)
+            ENDIF
+            IF( z_f_surf(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN!
+               WRITE(numout,*) ' ALERTE heat loss for surface melt '
+               WRITE(numout,*) ' zji, zjj, jl :', zji, zjj, jl
+               WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji)
+               WRITE(numout,*) ' z_f_surf     : ', z_f_surf(ji)
+               WRITE(numout,*) ' zdq_i        : ', zdq_i(ji)
+               WRITE(numout,*) ' ht_i_b       : ', ht_i_b(ji)
+               WRITE(numout,*) ' fc_bo_i      : ', fc_bo_i(ji)
+               WRITE(numout,*) ' fbif_1d      : ', fbif_1d(ji)
+               WRITE(numout,*) ' qlbbq_1d     : ', qlbbq_1d(ji)
+               WRITE(numout,*) ' s_i_new      : ', s_i_new(ji)
+               WRITE(numout,*) ' sss_m        : ', sss_m(zji,zjj)
+            ENDIF
+         END DO
+         !
+         IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh
+         WRITE(numout,*) ' Error report - Category : ', jl
+         WRITE(numout,*) ' ~~~~~~~~~~~~ '
+         WRITE(numout,*) ' Number of points where there is sur. me. error : ', numce_dh
+         WRITE(numout,*) ' Mean basal growth error on error points : ', meance_dh
+         !
+      ENDIF
+
+      !----------------------
+      ! 3.3 Snow sublimation
+      !----------------------
+
+      DO ji = kideb, kiut
+         ! if qla is positive (upwards), heat goes to the atmosphere, therefore
+         ! snow sublimates, if qla is negative (downwards), snow condensates
+         zdh_s_sub(ji)    =  - parsub * qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice
+         dh_s_tot (ji)    =  dh_s_tot(ji) + zdh_s_sub(ji)
+         zdhcf            =  ht_s_b(ji) + zdh_s_sub(ji) 
+         ht_s_b   (ji)    =  MAX( zzero , zdhcf )
+         ! we recompute dh_s_tot 
+         dh_s_tot (ji)    =  ht_s_b(ji) - zhsold(ji)
+         qt_s_in  (ji,jl) =  qt_s_in(ji,jl) + zdh_s_sub(ji)*q_s_b(ji,1)
+      END DO
+
+      zqt_dummy(:) = 0.e0
+      DO jk = 1, nlay_s
+         DO ji = kideb,kiut
+            q_s_b    (ji,jk) = rhosn * ( cpic * ( rtt - t_s_b(ji,jk) ) + lfus )
+            zqt_dummy(ji)    =  zqt_dummy(ji) + q_s_b(ji,jk) * ht_s_b(ji) / nlay_s            ! heat conservation
+         END DO
+      END DO
+
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            ! In case of disparition of the snow, we have to update the snow temperatures
+            zhisn  =  MAX( zzero , SIGN( zone, - ht_s_b(ji) ) )
+            t_s_b(ji,jk) = ( 1.0 - zhisn ) * t_s_b(ji,jk) + zhisn * rtt
+            q_s_b(ji,jk) = ( 1.0 - zhisn ) * q_s_b(ji,jk)
+         END DO
+      END DO
+
+      !
+      !------------------------------------------------------------------------------!
+      ! 4) Basal growth / melt                                                       !
+      !------------------------------------------------------------------------------!
+      !
+      ! Ice basal growth / melt is given by the ratio of heat budget over basal
+      ! ice heat content.  Basal heat budget is given by the difference between
+      ! the inner conductive flux  (fc_bo_i), from the open water heat flux 
+      ! (qlbbqb) and the turbulent ocean flux (fbif). 
+      ! fc_bo_i is positive downwards. fbif and qlbbq are positive to the ice 
+
+      !-----------------------------------------------------
+      ! 4.1 Basal growth - (a) salinity not varying in time 
+      !-----------------------------------------------------
+      IF(  num_sal /= 2  .AND.  num_sal /= 4  ) THEN
+         DO ji = kideb, kiut
+            IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) < 0.0  ) THEN
+               s_i_new(ji)         =  sm_i_b(ji)
+               ! Melting point in K
+               ztmelts             =  - tmut * s_i_new(ji) + rtt 
+               ! New ice heat content (Bitz and Lipscomb, 1999)
+               ztform              =  t_i_b(ji,nlay_i)  ! t_bo_b crashes in the
+               ! Baltic
+               q_i_b(ji,nlay_i+1)  = rhoic * (  cpic * ( ztmelts - ztform )                                &
+                  &                           + lfus * (  1.0 - ( ztmelts - rtt ) / ( ztform - rtt )  )    &
+                  &                           - rcp  * ( ztmelts - rtt )                                 )
+               ! Basal growth rate = - F*dt / q
+               dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
+            ENDIF
+         END DO
+      ENDIF
+
+      !-------------------------------------------------
+      ! 4.1 Basal growth - (b) salinity varying in time 
+      !-------------------------------------------------
+      IF(  num_sal == 2 .OR.  num_sal == 4  ) THEN
+         ! the growth rate (dh_i_bott) is function of the new ice
+         ! heat content (q_i_b(nlay_i+1)). q_i_b depends on the new ice 
+         ! salinity (snewice). snewice depends on dh_i_bott
+         ! it converges quickly, so, no problem
+         ! See Vancoppenolle et al., OM08 for more info on this
+
+         ! Initial value (tested 1D, can be anything between 1 and 20)
+         num_iter_max = 4
+         s_i_new(:)   = 4.0
+
+         ! Iterative procedure
+         DO iter = 1, num_iter_max
+            DO ji = kideb, kiut
+               IF(  fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) < 0.e0  ) THEN
+                  zji = MOD( npb(ji) - 1, jpi ) + 1
+                  zjj = ( npb(ji) - 1 ) / jpi + 1
+                  ! Melting point in K
+                  ztmelts             =   - tmut * s_i_new(ji) + rtt 
+                  ! New ice heat content (Bitz and Lipscomb, 1999)
+                  q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                             &
+                     &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )   &
+                     &                            - rcp * ( ztmelts-rtt )                                     )
+                  ! Bottom growth rate = - F*dt / q
+                  dh_i_bott(ji) =  - rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1)
+                  ! New ice salinity ( Cox and Weeks, JGR, 1988 )
+                  ! zswi2  (1) if dh_i_bott/rdt .GT. 3.6e-7
+                  ! zswi12 (1) if dh_i_bott/rdt .LT. 3.6e-7 and .GT. 2.0e-8
+                  ! zswi1  (1) if dh_i_bott/rdt .LT. 2.0e-8
+                  zgrr   = MIN( 1.0e-3, MAX ( dh_i_bott(ji) / rdt_ice , epsi13 ) )
+                  zswi2  = MAX( zzero , SIGN( zone , zgrr - 3.6e-7 ) ) 
+                  zswi12 = MAX( zzero , SIGN( zone , zgrr - 2.0e-8 ) ) * ( 1.0 - zswi2 )
+                  zswi1  = 1. - zswi2 * zswi12 
+                  zfracs = zswi1  * 0.12 + zswi12 * ( 0.8925 + 0.0568 * LOG( 100.0 * zgrr ) )   &
+                     &                   + zswi2  * 0.26 / ( 0.26 + 0.74 * EXP ( - 724300.0 * zgrr ) ) 
+                  zds         = zfracs * sss_m(zji,zjj) - s_i_new(ji)
+                  s_i_new(ji) = zfracs * sss_m(zji,zjj)
+               ENDIF ! fc_bo_i
+            END DO ! ji
+         END DO ! iter
+
+         ! Final values
+         DO ji = kideb, kiut
+            IF( ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .LT. 0.0  ) THEN
+               ! New ice salinity must not exceed 15 psu
+               s_i_new(ji) = MIN( s_i_new(ji), s_i_max )
+               ! Metling point in K
+               ztmelts     =   - tmut * s_i_new(ji) + rtt 
+               ! New ice heat content (Bitz and Lipscomb, 1999)
+               q_i_b(ji,nlay_i+1)  =  rhoic * (  cpic * ( ztmelts - t_bo_b(ji) )                              &
+                  &                            + lfus * ( 1.0 - ( ztmelts - rtt ) / ( t_bo_b(ji) - rtt ) )    &
+                  &                            - rcp * ( ztmelts - rtt )                                    )
+               ! Basal growth rate = - F*dt / q
+               dh_i_bott(ji)       =  - rdt_ice*( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) / q_i_b(ji,nlay_i+1) 
+               ! Salinity update
+               ! entrapment during bottom growth
+               dsm_i_se_1d(ji) = ( s_i_new(ji) * dh_i_bott(ji) + sm_i_b(ji) * ht_i_b(ji) )    &
+                  &            / MAX( ht_i_b(ji) + dh_i_bott(ji) ,epsi13 ) - sm_i_b(ji)
+            ENDIF ! heat budget
+         END DO
+      ENDIF
+
+      !----------------
+      ! 4.2 Basal melt
+      !----------------
+      meance_dh = 0._wp
+      numce_dh  = 0
+      zinnermelt(:) = 0._wp
+
+      DO ji = kideb, kiut
+         ! heat convergence at the surface > 0
+         IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0._wp  ) THEN
+            s_i_new(ji)   =  s_i_b(ji,nlay_i)
+            zqfont_bo(ji) =  rdt_ice * ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) )
+            zfbase(ji)    =  zqfont_bo(ji) / rdt_ice     ! heat conservation test
+            zdq_i(ji)     =  0._wp
+            dh_i_bott(ji) =  0._wp
+         ENDIF
+      END DO
+
+      DO jk = nlay_i, 1, -1
+         DO ji = kideb, kiut
+            IF (  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) .GE. 0.0  ) THEN
+               ztmelts            =   - tmut * s_i_b(ji,jk) + rtt 
+               IF( t_i_b(ji,jk) >= ztmelts ) THEN
+                  zdeltah(ji,jk)  = - zh_i(ji)
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)
+                  zinnermelt(ji)   = 1._wp
+               ELSE  ! normal ablation
+                  zdeltah(ji,jk)  = - zqfont_bo(ji) / q_i_b(ji,jk)
+                  zqfont_bo(ji)   = MAX( 0.0 , - zh_i(ji) - zdeltah(ji,jk) ) * q_i_b(ji,jk)
+                  zdeltah(ji,jk)  = MAX(zdeltah(ji,jk), - zh_i(ji) )
+                  dh_i_bott(ji)   = dh_i_bott(ji) + zdeltah(ji,jk)
+                  zdq_i(ji)       = zdq_i(ji) + zdeltah(ji,jk) * q_i_b(ji,jk) / rdt_ice
+                  ! contribution to salt flux
+                  zji             = MOD( npb(ji) - 1, jpi ) + 1
+                  zjj             = ( npb(ji) - 1 ) / jpi + 1
+                  zfsalt_melt(ji) = zfsalt_melt(ji) + ( sss_m(zji,zjj) - sm_i_b(ji)   ) * a_i_b(ji)   &
+                     &                              * MIN( zdeltah(ji,jk) , 0.0 ) * rhoic / rdt_ice 
+               ENDIF
+            ENDIF
+         END DO ! ji
+      END DO ! jk
+
+      !                     !-------------------
+      IF( con_i ) THEN      ! Conservation test
+      !                     !-------------------
+         DO ji = kideb, kiut
+            IF(  ( fc_bo_i(ji) + fbif_1d(ji) + qlbbq_1d(ji) ) >= 0.e0  ) THEN
+               IF( ( zfbase(ji) + zdq_i(ji) ) >= 1.e-3 ) THEN
+                  numce_dh  = numce_dh + 1
+                  meance_dh = meance_dh + zfbase(ji) + zdq_i(ji)
+               ENDIF
+               IF ( zfbase(ji) + zdq_i(ji) .GE. 1.0e-3  ) THEN
+                  WRITE(numout,*) ' ALERTE heat loss for basal melt : zji, zjj, jl :', zji, zjj, jl
+                  WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji)
+                  WRITE(numout,*) ' zfbase    : ', zfbase(ji)
+                  WRITE(numout,*) ' zdq_i     : ', zdq_i(ji)
+                  WRITE(numout,*) ' ht_i_b    : ', ht_i_b(ji)
+                  WRITE(numout,*) ' fc_bo_i   : ', fc_bo_i(ji)
+                  WRITE(numout,*) ' fbif_1d   : ', fbif_1d(ji)
+                  WRITE(numout,*) ' qlbbq_1d  : ', qlbbq_1d(ji)
+                  WRITE(numout,*) ' s_i_new   : ', s_i_new(ji)
+                  WRITE(numout,*) ' sss_m     : ', sss_m(zji,zjj)
+                  WRITE(numout,*) ' dh_i_bott : ', dh_i_bott(ji)
+                  WRITE(numout,*) ' innermelt : ', INT( zinnermelt(ji) )
+               ENDIF
+            ENDIF
+         END DO
+         IF( numce_dh > 0 )   meance_dh = meance_dh / numce_dh
+         WRITE(numout,*) ' Number of points where there is bas. me. error : ', numce_dh
+         WRITE(numout,*) ' Mean basal melt error on error points : ', meance_dh
+         WRITE(numout,*) ' Remaining bottom heat : ', zqfont_bo(jiindex_1d)
+         !
+      ENDIF
+
+      !
+      !------------------------------------------------------------------------------!
+      !  5) Pathological cases                                                       !
+      !------------------------------------------------------------------------------!
+      !
+      !----------------------------------------------
+      ! 5.1 Excessive ablation in a 1-category model
+      !----------------------------------------------
+
+      DO ji = kideb, kiut
+         !                     ! in a 1-category sea ice model, bottom ablation must not exceed hmelt (-0.15)
+         IF( jpl == 1 ) THEN   ;   zdhbf = MAX( hmelt , dh_i_bott(ji) )
+         ELSE                  ;   zdhbf =              dh_i_bott(ji) 
+         ENDIF
+         !                     ! excessive energy is sent to lateral ablation
+         fsup     (ji) =  rhoic * lfus * at_i_b(ji) / MAX( 1.0 - at_i_b(ji) , epsi13 )   &
+            &                          * ( zdhbf - dh_i_bott(ji) ) / rdt_ice
+         dh_i_bott(ji)  = zdhbf
+         !                     !since ice volume is only used for outputs, we keep it global for all categories
+         dvbbq_1d (ji) = a_i_b(ji) * dh_i_bott(ji)
+         !                     !new ice thickness
+         zhgnew   (ji) = ht_i_b(ji) + dh_i_surf(ji) + dh_i_bott(ji)
+         !                     ! diagnostic ( bottom ice growth )
+         zji = MOD( npb(ji) - 1, jpi ) + 1
+         zjj = ( npb(ji) - 1 ) / jpi + 1
+         diag_bot_gr(zji,zjj) = diag_bot_gr(zji,zjj) + MAX(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice
+         diag_sur_me(zji,zjj) = diag_sur_me(zji,zjj) + MIN(dh_i_surf(ji),0.0)*a_i_b(ji) / rdt_ice
+         diag_bot_me(zji,zjj) = diag_bot_me(zji,zjj) + MIN(dh_i_bott(ji),0.0)*a_i_b(ji) / rdt_ice
+      END DO
+
+      !-----------------------------------
+      ! 5.2 More than available ice melts
+      !-----------------------------------
+      ! then heat applied minus heat content at previous time step
+      ! should equal heat remaining 
+      !
+      DO ji = kideb, kiut
+         ! Adapt the remaining energy if too much ice melts
+         !--------------------------------------------------
+         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) !1 if ice
+         ! 0 if no more ice
+         zhgnew    (ji) =         zihgnew   * zhgnew(ji)      ! ice thickness is put to 0
+         ! remaining heat
+         zfdt_final(ji) = ( 1.0 - zihgnew ) * ( zqfont_su(ji) +  zqfont_bo(ji) ) 
+
+         ! If snow remains, energy is used to melt snow
+         zhni =  ht_s_b(ji)      ! snow depth at previous time step
+         zihg =  MAX( zzero , SIGN ( zone , - ht_s_b(ji) ) ) ! 0 if snow 
+
+         ! energy of melting of remaining snow
+         zqt_s(ji) =    ( 1. - zihg ) * zqt_s(ji) / MAX( zhni, epsi13 )
+         zdhnm     =  - ( 1. - zihg ) * ( 1. - zihgnew ) * zfdt_final(ji) / MAX( zqt_s(ji) , epsi13 )
+         zhnfi          =  zhni + zdhnm
+         zfdt_final(ji) =  MAX( zfdt_final(ji) + zqt_s(ji) * zdhnm , 0.0 )
+         ht_s_b(ji)     =  MAX( zzero , zhnfi )
+         zqt_s(ji)      =  zqt_s(ji) * ht_s_b(ji)
+
+         ! Mass variations of ice and snow
+         !---------------------------------
+         !                                              ! mass variation of the jl category
+         zzfmass_s = - a_i_b(ji) * ( zhni       - ht_s_b(ji) ) * rhosn   ! snow
+         zzfmass_i =   a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic   ! ice  
+         !
+         zfmass_i(ji) = zzfmass_i                       ! ice variation saved to compute salt flux (see below)
+         !
+         !                                              ! mass variation cumulated over category
+         rdmsnif_1d(ji) = rdmsnif_1d(ji) + zzfmass_s                     ! snow 
+         rdmicif_1d(ji) = rdmicif_1d(ji) + zzfmass_i                     ! ice 
+
+         ! Remaining heat to the ocean 
+         !---------------------------------
+         focea(ji)  = - zfdt_final(ji) / rdt_ice         ! focea is in W.m-2 * dt
+
+      END DO
+
+      ftotal_fin (:) = zfdt_final(:)  / rdt_ice
+
+      !---------------------------
+      ! Salt flux and heat fluxes                    
+      !---------------------------
+      DO ji = kideb, kiut
+         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) )   !1 if ice
+
+         ! Salt flux
+         zji = MOD( npb(ji) - 1, jpi ) + 1
+         zjj = ( npb(ji) - 1 ) / jpi + 1
+         ! new lines
+         IF( num_sal == 4 ) THEN
+            fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                &
+               &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - bulk_sal   ) / rdt_ice
+         ELSE
+            fseqv_1d(ji) = fseqv_1d(ji) +        zihgnew  * zfsalt_melt(ji)                                &
+               &                        + (1.0 - zihgnew) * zfmass_i(ji) * ( sss_m(zji,zjj) - sm_i_b(ji) ) / rdt_ice
+         ENDIF
+         ! Heat flux
+         ! excessive bottom ablation energy (fsup) - 0 except if jpl = 1
+         ! excessive total ablation energy (focea) sent to the ocean
+         qfvbq_1d(ji)  = qfvbq_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji) * a_i_b(ji) * rdt_ice
+
+         zihic   = 1.0 - MAX( zzero , SIGN( zone , -ht_i_b(ji) ) )
+         ! equals 0 if ht_i = 0, 1 if ht_i gt 0
+         fscbq_1d(ji) =  a_i_b(ji) * fstbif_1d(ji)
+         qldif_1d(ji)  = qldif_1d(ji) + fsup(ji) + ( 1.0 - zihgnew ) * focea(ji)    * a_i_b(ji) * rdt_ice   &
+            &                                    + ( 1.0 - zihic   ) * fscbq_1d(ji)             * rdt_ice
+      END DO  ! ji
+
+      !-------------------------------------------
+      ! Correct temperature, energy and thickness
+      !-------------------------------------------
+      DO ji = kideb, kiut
+         zihgnew    =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 
+         t_su_b(ji) =  zihgnew * t_su_b(ji) + ( 1.0 - zihgnew ) * rtt
+      END DO  ! ji
+
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            zihgnew      =  1.0 - MAX( zzero , SIGN( zone , - zhgnew(ji) ) ) 
+            t_i_b(ji,jk) =  zihgnew * t_i_b(ji,jk) + ( 1.0 - zihgnew ) * rtt
+            q_i_b(ji,jk) =  zihgnew * q_i_b(ji,jk)
+         END DO
+      END DO  ! ji
+
+      DO ji = kideb, kiut
+         ht_i_b(ji) = zhgnew(ji)
+      END DO  ! ji
+      !
+      !------------------------------------------------------------------------------|
+      !  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(  zzero , ( rhosn * ht_s_b(ji) + (rhoic-rau0) * ht_i_b(ji) ) / ( rhosn+rau0-rhoic )  )
+         zhgnew(ji)     = MAX(  zhgnew(ji) , zhgnew(ji) + dh_snowice(ji)  )
+         zhnnew         = MIN(  ht_s_b(ji) , ht_s_b(ji) - dh_snowice(ji)  )
+
+         !  Changes in ice volume and ice mass.
+         dvnbq_1d  (ji) =                a_i_b(ji) * ( zhgnew(ji)-ht_i_b(ji) )
+         dmgwi_1d  (ji) = dmgwi_1d(ji) + a_i_b(ji) * ( ht_s_b(ji) - zhnnew ) * rhosn
+
+         rdmicif_1d(ji) = rdmicif_1d(ji) + a_i_b(ji) * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic 
+         rdmsnif_1d(ji) = rdmsnif_1d(ji) + a_i_b(ji) * ( zhnnew     - ht_s_b(ji) ) * rhosn
+
+         !        Equivalent salt flux (1) Snow-ice formation component
+         !        -----------------------------------------------------
+         zji = MOD( npb(ji) - 1, jpi ) + 1
+         zjj =    ( npb(ji) - 1 ) / jpi + 1
+
+         IF( num_sal /= 2 ) THEN   ;   zsm_snowice = sm_i_b(ji)
+         ELSE                      ;   zsm_snowice = ( rhoic - rhosn ) / rhoic * sss_m(zji,zjj) 
+         ENDIF
+         IF( num_sal == 4 ) THEN
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    ) * a_i_b(ji)   &
+               &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice
+         ELSE
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - zsm_snowice ) * a_i_b(ji)   &
+               &                        * ( zhgnew(ji) - ht_i_b(ji) ) * rhoic / rdt_ice
+         ENDIF
+         ! entrapment during snow ice formation
+         i_ice_switch = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - ht_i_b(ji) + 1.0e-6 ) )
+         isnowic      = 1.0 - MAX( 0.e0 , SIGN( 1.0 , - dh_snowice(ji)      ) ) * i_ice_switch
+         IF(  num_sal == 2  .OR.  num_sal == 4  )   &
+            dsm_i_si_1d(ji) = ( zsm_snowice*dh_snowice(ji) &
+            &               + sm_i_b(ji) * ht_i_b(ji) / MAX( ht_i_b(ji) + dh_snowice(ji), epsi13)   &
+            &               - sm_i_b(ji) ) * isnowic     
+
+         !  Actualize new snow and ice thickness.
+         ht_s_b(ji)  = zhnnew
+         ht_i_b(ji)  = zhgnew(ji)
+
+         ! Total ablation ! new lines added to debug
+         IF( ht_i_b(ji) <= 0._wp )   a_i_b(ji) = 0._wp
+
+         ! diagnostic ( snow ice growth )
+         zji = MOD( npb(ji) - 1, jpi ) + 1
+         zjj =    ( npb(ji) - 1 ) / jpi + 1
+         diag_sni_gr(zji,zjj)  = diag_sni_gr(zji,zjj) + dh_snowice(ji)*a_i_b(ji) / rdt_ice
+         !
+      END DO !ji
+      !
+      CALL wrk_dealloc( jpij, zh_i, zh_s, ztfs, zhsold, zqprec, zqfont_su, zqfont_bo, z_f_surf, zhgnew, zfmass_i )
+      CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zfsalt_melt, zfdt_init, zfdt_final, zqt_i, zqt_s, zqt_dummy )
+      CALL wrk_dealloc( jpij, zinnermelt, zfbase, zdq_i )
+      CALL wrk_dealloc( jpij, jkmax, zdeltah, zqt_i_lay )
+      !
+   END SUBROUTINE lim_thd_dh
+   
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90	(revision 3437)
@@ -0,0 +1,768 @@
+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
+   !!----------------------------------------------------------------------
+#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 par_ice          ! LIM-3 parameters
+   USE thd_ice          ! LIM-3: thermodynamics
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_dif   ! called by lim_thd
+
+   REAL(wp) ::   epsi20 = 1e-20     ! constant values
+   REAL(wp) ::   epsi13 = 1e-13     ! constant values
+
+   !!----------------------------------------------------------------------
+   !! 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 , jl )
+      !!------------------------------------------------------------------
+      !!                ***  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_b
+      !!           ice/snow temperatures   : t_i_b, t_s_b
+      !!           ice salinities          : s_i_b
+      !!           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_b, ht_s_b
+      !!
+      !! ** 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   ! Start point on which the  the computation is applied
+      INTEGER , INTENT (in) ::   kiut    ! End point on which the  the computation is applied
+      INTEGER , INTENT (in) ::   jl      ! Category number
+
+      !! * Local variables
+      INTEGER ::   ji          ! spatial loop index
+      INTEGER ::   ii, ij      ! temporary dummy loop index
+      INTEGER ::   numeq       ! current reference number of equation
+      INTEGER ::   layer       ! vertical dummy loop index 
+      INTEGER ::   nconv       ! number of iterations in iterative procedure
+      INTEGER ::   minnumeqmin, maxnumeqmax
+      INTEGER, DIMENSION(kiut) ::   numeqmin   ! reference number of top equation
+      INTEGER, DIMENSION(kiut) ::   numeqmax   ! reference number of bottom equation
+      INTEGER, DIMENSION(kiut) ::   isnow      ! switch for presence (1) or absence (0) of snow
+      REAL(wp) ::   zeps      =  1.e-10_wp    !
+      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  =  1.e+8_wp     ! extinction coefficient of radiation in the snow
+      REAL(wp) ::   zkimin    =  0.10_wp      ! minimum ice thermal conductivity
+      REAL(wp) ::   zht_smin  =  1.e-4_wp     ! minimum snow depth
+      REAL(wp) ::   ztmelt_i    ! ice melting temperature
+      REAL(wp) ::   zerritmax   ! current maximal error on temperature 
+      REAL(wp), DIMENSION(kiut) ::   ztfs        ! ice melting point
+      REAL(wp), DIMENSION(kiut) ::   ztsuold     ! old surface temperature (before the iterative procedure )
+      REAL(wp), DIMENSION(kiut) ::   ztsuoldit   ! surface temperature at previous iteration
+      REAL(wp), DIMENSION(kiut) ::   zh_i        ! ice layer thickness
+      REAL(wp), DIMENSION(kiut) ::   zh_s        ! snow layer thickness
+      REAL(wp), DIMENSION(kiut) ::   zfsw        ! solar radiation absorbed at the surface
+      REAL(wp), DIMENSION(kiut) ::   zf          ! surface flux function
+      REAL(wp), DIMENSION(kiut) ::   dzf         ! derivative of the surface flux function
+      REAL(wp), DIMENSION(kiut) ::   zerrit      ! current error on temperature
+      REAL(wp), DIMENSION(kiut) ::   zdifcase    ! case of the equation resolution (1->4)
+      REAL(wp), DIMENSION(kiut) ::   zftrice     ! solar radiation transmitted through the ice
+      REAL(wp), DIMENSION(kiut) ::   zihic, zhsu
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztcond_i    ! Ice thermal conductivity
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradtr_i    ! Radiation transmitted through the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zradab_i    ! Radiation absorbed in the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zkappa_i    ! Kappa factor in the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztiold      ! Old temperature in the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zeta_i      ! Eta factor in the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   ztitemp     ! Temporary temperature in the ice to check the convergence
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   zspeche_i   ! Ice specific heat
+      REAL(wp), DIMENSION(kiut,0:nlay_i) ::   z_i         ! Vertical cotes of the layers in the ice
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradtr_s    ! Radiation transmited through the snow
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zradab_s    ! Radiation absorbed in the snow
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zkappa_s    ! Kappa factor in the snow
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   zeta_s       ! Eta factor in the snow
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztstemp      ! Temporary temperature in the snow to check the convergence
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   ztsold       ! Temporary temperature in the snow
+      REAL(wp), DIMENSION(kiut,0:nlay_s) ::   z_s          ! Vertical cotes of the layers in the snow
+      REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindterm   ! Independent term
+      REAL(wp), DIMENSION(kiut,jkmax+2) ::   zindtbis   ! temporary independent term
+      REAL(wp), DIMENSION(kiut,jkmax+2) ::   zdiagbis
+      REAL(wp), DIMENSION(kiut,jkmax+2,3) ::   ztrid   ! tridiagonal system terms
+      !!------------------------------------------------------------------
+      
+      ! 
+      !------------------------------------------------------------------------------!
+      ! 1) Initialization                                                            !
+      !------------------------------------------------------------------------------!
+      !
+      DO ji = kideb , kiut
+         ! is there snow or not
+         isnow(ji)= INT(  1._wp - MAX( 0._wp , SIGN(1._wp, - ht_s_b(ji) ) )  )
+         ! surface temperature of fusion
+!!gm ???  ztfs(ji) = rtt !!!????
+         ztfs(ji) = isnow(ji) * rtt + (1.0-isnow(ji)) * rtt
+         ! layer thickness
+         zh_i(ji) = ht_i_b(ji) / nlay_i
+         zh_s(ji) = ht_s_b(ji) / 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 layer = 1, nlay_s            ! vert. coord of the up. lim. of the layer-th snow layer
+         DO ji = kideb , kiut
+            z_s(ji,layer) = z_s(ji,layer-1) + ht_s_b(ji) / nlay_s
+         END DO
+      END DO
+
+      DO layer = 1, nlay_i            ! vert. coord of the up. lim. of the layer-th ice layer
+         DO ji = kideb , kiut
+            z_i(ji,layer) = z_i(ji,layer-1) + ht_i_b(ji) / nlay_i
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------|
+      ! 2) Radiations                                                                |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------------
+      ! 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 
+      ! fstbif  = io.qsr_ice.exp(-k(h_i)) transmitted below the ice 
+
+      DO ji = kideb , kiut
+         ! switches
+         isnow(ji) = INT(  1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_b(ji) ) )  ) 
+         ! hs > 0, isnow = 1
+         zhsu (ji) = hnzst  ! threshold for the computation of i0
+         zihic(ji) = MAX( 0._wp , 1._wp - ( ht_i_b(ji) / zhsu(ji) ) )     
+
+         i0(ji)    = ( 1._wp - isnow(ji) ) * ( fr1_i0_1d(ji) + zihic(ji) * fr2_i0_1d(ji) )
+         !fr1_i0_1d = i0 for a thin ice surface
+         !fr1_i0_2d = i0 for a thick ice surface
+         !            a function of the cloud cover
+         !
+         !i0(ji)     =  (1.0-FLOAT(isnow(ji)))*3.0/(100*ht_s_b(ji)+10.0)
+         !formula used in Cice
+      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 
+      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 layer = 1, nlay_s          ! Radiation through snow
+         DO ji = kideb, kiut
+            !                             ! radiation transmitted below the layer-th snow layer
+            zradtr_s(ji,layer) = zradtr_s(ji,0) * EXP( - zraext_s * ( MAX ( 0._wp , z_s(ji,layer) ) ) )
+            !                             ! radiation absorbed by the layer-th snow layer
+            zradab_s(ji,layer) = zradtr_s(ji,layer-1) - zradtr_s(ji,layer)
+         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 layer = 1, nlay_i          ! Radiation through ice
+         DO ji = kideb, kiut
+            !                             ! radiation transmitted below the layer-th ice layer
+            zradtr_i(ji,layer) = zradtr_i(ji,0) * EXP( - kappa_i * ( MAX ( 0._wp , z_i(ji,layer) ) ) )
+            !                             ! radiation absorbed by the layer-th ice layer
+            zradab_i(ji,layer) = zradtr_i(ji,layer-1) - zradtr_i(ji,layer)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut           ! Radiation transmitted below the ice
+         fstbif_1d(ji) = fstbif_1d(ji) + zradtr_i(ji,nlay_i) * a_i_b(ji) / at_i_b(ji)
+      END DO
+
+      ! +++++
+      ! just to check energy conservation
+      DO ji = kideb, kiut
+         ii                = MOD( npb(ji) - 1, jpi ) + 1
+         ij                = ( npb(ji) - 1 ) / jpi + 1
+         fstroc(ii,ij,jl) = zradtr_i(ji,nlay_i)
+      END DO
+      ! +++++
+
+      DO layer = 1, nlay_i
+         DO ji = kideb, kiut
+            radab(ji,layer) = zradab_i(ji,layer)
+         END DO
+      END DO
+
+
+      !
+      !------------------------------------------------------------------------------|
+      !  3) Iterative procedure begins                                               |
+      !------------------------------------------------------------------------------|
+      !
+      DO ji = kideb, kiut        ! Old surface temperature
+         ztsuold  (ji) =  t_su_b(ji)                              ! temperature at the beg of iter pr.
+         ztsuoldit(ji) =  t_su_b(ji)                              ! temperature at the previous iter
+         t_su_b   (ji) =  MIN( t_su_b(ji), ztfs(ji)-0.00001 )     ! necessary
+         zerrit   (ji) =  1000._wp                                ! initial value of error
+      END DO
+
+      DO layer = 1, nlay_s       ! Old snow temperature
+         DO ji = kideb , kiut
+            ztsold(ji,layer) =  t_s_b(ji,layer)
+         END DO
+      END DO
+
+      DO layer = 1, nlay_i       ! Old ice temperature
+         DO ji = kideb , kiut
+            ztiold(ji,layer) =  t_i_b(ji,layer)
+         END DO
+      END DO
+
+      nconv     =  0           ! number of iterations
+      zerritmax =  1000._wp    ! maximal value of error on all points
+
+      DO WHILE ( zerritmax > maxer_i_thd .AND. nconv < nconv_i_thd )
+         !
+         nconv = nconv + 1
+         !
+         !------------------------------------------------------------------------------|
+         ! 4) Sea ice thermal conductivity                                              |
+         !------------------------------------------------------------------------------|
+         !
+         IF( thcon_i_swi == 0 ) THEN      ! Untersteiner (1964) formula
+            DO ji = kideb , kiut
+               ztcond_i(ji,0)        = rcdic + zbeta*s_i_b(ji,1) / MIN(-zeps,t_i_b(ji,1)-rtt)
+               ztcond_i(ji,0)        = MAX(ztcond_i(ji,0),zkimin)
+            END DO
+            DO layer = 1, nlay_i-1
+               DO ji = kideb , kiut
+                  ztcond_i(ji,layer) = rcdic + zbeta*( s_i_b(ji,layer) + s_i_b(ji,layer+1) ) /  &
+                     MIN(-2.0_wp * zeps, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)
+                  ztcond_i(ji,layer) = MAX(ztcond_i(ji,layer),zkimin)
+               END DO
+            END DO
+         ENDIF
+
+         IF( thcon_i_swi == 1 ) THEN      ! Pringle et al formula included: 2.11 + 0.09 S/T - 0.011.T
+            DO ji = kideb , kiut
+               ztcond_i(ji,0) = rcdic + 0.090_wp * s_i_b(ji,1) / MIN( -zeps, t_i_b(ji,1)-rtt )   &
+                  &                   - 0.011_wp * ( t_i_b(ji,1) - rtt )  
+               ztcond_i(ji,0) = MAX( ztcond_i(ji,0), zkimin )
+            END DO
+            DO layer = 1, nlay_i-1
+               DO ji = kideb , kiut
+                  ztcond_i(ji,layer) = rcdic + 0.090_wp * ( s_i_b(ji,layer) + s_i_b(ji,layer+1) )   &
+                     &                                  / MIN(-2.0_wp * zeps, t_i_b(ji,layer)+t_i_b(ji,layer+1) - 2.0_wp * rtt)   &
+                     &                       - 0.0055_wp* ( t_i_b(ji,layer) + t_i_b(ji,layer+1) - 2.0*rtt )  
+                  ztcond_i(ji,layer) = MAX( ztcond_i(ji,layer), zkimin )
+               END DO
+            END DO
+            DO ji = kideb , kiut
+               ztcond_i(ji,nlay_i) = rcdic + 0.090_wp * s_i_b(ji,nlay_i) / MIN(-zeps,t_bo_b(ji)-rtt)   &
+                  &                        - 0.011_wp * ( t_bo_b(ji) - rtt )  
+               ztcond_i(ji,nlay_i) = MAX( ztcond_i(ji,nlay_i), zkimin )
+            END DO
+         ENDIF
+         !
+         !------------------------------------------------------------------------------|
+         !  5) kappa factors                                                            |
+         !------------------------------------------------------------------------------|
+         !
+         DO ji = kideb, kiut
+
+            !-- Snow kappa factors
+            zkappa_s(ji,0)         = rcdsn / MAX(zeps,zh_s(ji))
+            zkappa_s(ji,nlay_s)    = rcdsn / MAX(zeps,zh_s(ji))
+         END DO
+
+         DO layer = 1, nlay_s-1
+            DO ji = kideb , kiut
+               zkappa_s(ji,layer)  = 2.0 * rcdsn / &
+                  MAX(zeps,2.0*zh_s(ji))
+            END DO
+         END DO
+
+         DO layer = 1, nlay_i-1
+            DO ji = kideb , kiut
+               !-- Ice kappa factors
+               zkappa_i(ji,layer)  = 2.0*ztcond_i(ji,layer)/ &
+                  MAX(zeps,2.0*zh_i(ji)) 
+            END DO
+         END DO
+
+         DO ji = kideb , kiut
+            zkappa_i(ji,0)        = ztcond_i(ji,0)/MAX(zeps,zh_i(ji))
+            zkappa_i(ji,nlay_i)   = ztcond_i(ji,nlay_i) / MAX(zeps,zh_i(ji))
+            !-- Interface
+            zkappa_s(ji,nlay_s)   = 2.0*rcdsn*ztcond_i(ji,0)/MAX(zeps, &
+               (ztcond_i(ji,0)*zh_s(ji) + rcdsn*zh_i(ji)))
+            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s)*isnow(ji) &
+               + zkappa_i(ji,0)*(1.0-isnow(ji))
+         END DO
+         !
+         !------------------------------------------------------------------------------|
+         ! 6) Sea ice specific heat, eta factors                                        |
+         !------------------------------------------------------------------------------|
+         !
+         DO layer = 1, nlay_i
+            DO ji = kideb , kiut
+               ztitemp(ji,layer)   = t_i_b(ji,layer)
+               zspeche_i(ji,layer) = cpic + zgamma*s_i_b(ji,layer)/ &
+                  MAX((t_i_b(ji,layer)-rtt)*(ztiold(ji,layer)-rtt),zeps)
+               zeta_i(ji,layer)    = rdt_ice / MAX(rhoic*zspeche_i(ji,layer)*zh_i(ji), &
+                  zeps)
+            END DO
+         END DO
+
+         DO layer = 1, nlay_s
+            DO ji = kideb , kiut
+               ztstemp(ji,layer) = t_s_b(ji,layer)
+               zeta_s(ji,layer)  = rdt_ice / MAX(rhosn*cpic*zh_s(ji),zeps)
+            END DO
+         END DO
+         !
+         !------------------------------------------------------------------------------|
+         ! 7) surface flux computation                                                  |
+         !------------------------------------------------------------------------------|
+         !
+         DO ji = kideb , kiut
+
+            ! update of the non solar flux according to the update in T_su
+            qnsr_ice_1d(ji) = qnsr_ice_1d(ji) + dqns_ice_1d(ji) * & 
+               ( t_su_b(ji) - ztsuoldit(ji) )
+
+            ! update incoming flux
+            zf(ji)    =   zfsw(ji)              & ! net absorbed solar radiation
+               + qnsr_ice_1d(ji)           ! non solar total flux 
+            ! (LWup, LWdw, SH, LH)
+
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 8) 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,jkmax+2
+            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
+               layer              = numeq - nlay_s - 1
+               ztrid(ji,numeq,1)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer-1)
+               ztrid(ji,numeq,2)  =  1.0 + zeta_i(ji,layer)*(zkappa_i(ji,layer-1) + &
+                  zkappa_i(ji,layer))
+               ztrid(ji,numeq,3)  =  - zeta_i(ji,layer)*zkappa_i(ji,layer)
+               zindterm(ji,numeq) =  ztiold(ji,layer) + zeta_i(ji,layer)* &
+                  zradab_i(ji,layer)
+            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) =  ztiold(ji,nlay_i) + zeta_i(ji,nlay_i)* &
+               ( zradab_i(ji,nlay_i) + zkappa_i(ji,nlay_i)*zg1 &
+               *  t_bo_b(ji) ) 
+         ENDDO
+
+
+         DO ji = kideb , kiut
+            IF ( ht_s_b(ji).gt.0.0 ) THEN
+               !
+               !------------------------------------------------------------------------------|
+               !  snow-covered cells                                                          |
+               !------------------------------------------------------------------------------|
+               !
+               !!snow interior terms (bottom equation has the same form as the others)
+               DO numeq = 3, nlay_s + 1
+                  layer =  numeq - 1
+                  ztrid(ji,numeq,1)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer-1)
+                  ztrid(ji,numeq,2)   =  1.0 + zeta_s(ji,layer)*( zkappa_s(ji,layer-1) + &
+                     zkappa_s(ji,layer) )
+                  ztrid(ji,numeq,3)   =  - zeta_s(ji,layer)*zkappa_s(ji,layer)
+                  zindterm(ji,numeq)  =  ztsold(ji,layer) + zeta_s(ji,layer)* &
+                     zradab_s(ji,layer)
+               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_b(ji) 
+               ENDIF
+
+               IF ( t_su_b(ji) .LT. rtt ) 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_b(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) =  ztsold(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) = ztsold(ji,1) + zeta_s(ji,1) *            &
+                     ( zradab_s(ji,1) +                         &
+                     zkappa_s(ji,0) * zg1s * t_su_b(ji) ) 
+               ENDIF
+            ELSE
+               !
+               !------------------------------------------------------------------------------|
+               !  cells without snow                                                          |
+               !------------------------------------------------------------------------------|
+               !
+               IF (t_su_b(ji) .LT. rtt) 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_b(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)=  ztiold(ji,1) + zeta_i(ji,1)*zradab_i(ji,1)  
+
+                  !!case of only one layer in the ice (surface & ice equations are altered)
+
+                  IF (nlay_i.eq.1) THEN
+                     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) =  ztiold(ji,1) + zeta_i(ji,1)* &
+                        ( zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(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))     =  ztiold(ji,1) + zeta_i(ji,1)*( zradab_i(ji,1) + &
+                     zkappa_i(ji,0) * zg1 * t_su_b(ji) ) 
+
+                  !!case of only one layer in the ice (surface & ice equations are altered)
+                  IF (nlay_i.eq.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)) =  ztiold(ji,1) + zeta_i(ji,1)* &
+                        (zradab_i(ji,1) + zkappa_i(ji,1)*t_bo_b(ji)) &
+                        + t_su_b(ji)*zeta_i(ji,1)*zkappa_i(ji,0)*2.0
+                  ENDIF
+
+               ENDIF
+            ENDIF
+
+         END DO
+
+         !
+         !------------------------------------------------------------------------------|
+         ! 9) 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 = jkmax+4
+
+         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 layer = minnumeqmin+1, maxnumeqmax
+            DO ji = kideb , kiut
+               numeq               =  min(max(numeqmin(ji)+1,layer),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_b(ji,nlay_i)    =  zindtbis(ji,numeqmax(ji))/zdiagbis(ji,numeqmax(ji))
+         END DO
+
+         DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1
+            DO ji = kideb , kiut
+               layer    =  numeq - nlay_s - 1
+               t_i_b(ji,layer)  =  (zindtbis(ji,numeq) - ztrid(ji,numeq,3)* &
+                  t_i_b(ji,layer+1))/zdiagbis(ji,numeq)
+            END DO
+         END DO
+
+         DO ji = kideb , kiut
+            ! snow temperatures      
+            IF (ht_s_b(ji).GT.0) &
+               t_s_b(ji,nlay_s)     =  (zindtbis(ji,nlay_s+1) - ztrid(ji,nlay_s+1,3) &
+               *  t_i_b(ji,1))/zdiagbis(ji,nlay_s+1) &
+               *        MAX(0.0,SIGN(1.0,ht_s_b(ji)-zeps)) 
+
+            ! surface temperature
+            isnow(ji)     = INT(1.0-max(0.0,sign(1.0,-ht_s_b(ji))))
+            ztsuoldit(ji) = t_su_b(ji)
+            IF (t_su_b(ji) .LT. ztfs(ji)) &
+               t_su_b(ji) = ( zindtbis(ji,numeqmin(ji)) - ztrid(ji,numeqmin(ji),3)* ( isnow(ji)*t_s_b(ji,1)   &
+               &          + (1.0-isnow(ji))*t_i_b(ji,1) ) ) / zdiagbis(ji,numeqmin(ji))  
+         END DO
+         !
+         !--------------------------------------------------------------------------
+         !  10) Has the scheme converged ?, end of the iterative procedure         |
+         !--------------------------------------------------------------------------
+         !
+         ! check that nowhere it has started to melt
+         ! zerrit(ji) is a measure of error, it has to be under maxer_i_thd
+         DO ji = kideb , kiut
+            t_su_b(ji) =  MAX(  MIN( t_su_b(ji) , ztfs(ji) ) , 190._wp  )
+            zerrit(ji) =  ABS( t_su_b(ji) - ztsuoldit(ji) )     
+         END DO
+
+         DO layer  =  1, nlay_s
+            DO ji = kideb , kiut
+               ii = MOD( npb(ji) - 1, jpi ) + 1
+               ij = ( npb(ji) - 1 ) / jpi + 1
+               t_s_b(ji,layer) = MAX(  MIN( t_s_b(ji,layer), rtt ), 190._wp  )
+               zerrit(ji)      = MAX(zerrit(ji),ABS(t_s_b(ji,layer) - ztstemp(ji,layer)))
+            END DO
+         END DO
+
+         DO layer  =  1, nlay_i
+            DO ji = kideb , kiut
+               ztmelt_i        = -tmut * s_i_b(ji,layer) + rtt 
+               t_i_b(ji,layer) =  MAX(MIN(t_i_b(ji,layer),ztmelt_i),190.0)
+               zerrit(ji)      =  MAX(zerrit(ji),ABS(t_i_b(ji,layer) - ztitemp(ji,layer)))
+            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_nicep ) THEN
+         WRITE(numout,*) ' zerritmax : ', zerritmax
+         WRITE(numout,*) ' nconv     : ', nconv
+      ENDIF
+
+      !
+      !-------------------------------------------------------------------------!
+      !   11) Fluxes at the interfaces                                          !
+      !-------------------------------------------------------------------------!
+      DO ji = kideb, kiut
+         !                                ! update of latent heat fluxes
+         qla_ice_1d (ji) = qla_ice_1d (ji) + dqla_ice_1d(ji) * ( t_su_b(ji) - ztsuold(ji) )
+         !                                ! surface ice conduction flux
+         isnow(ji)       = INT(  1._wp - MAX( 0._wp, SIGN( 1._wp, -ht_s_b(ji) ) )  )
+         fc_su(ji)       =  -           isnow(ji)   * zkappa_s(ji,0) * zg1s * (t_s_b(ji,1) - t_su_b(ji))   &
+            &               - ( 1._wp - isnow(ji) ) * zkappa_i(ji,0) * zg1  * (t_i_b(ji,1) - t_su_b(ji))
+         !                                ! bottom ice conduction flux
+         fc_bo_i(ji)     =  - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) )
+      END DO
+
+      !-------------------------!
+      ! Heat conservation       !
+      !-------------------------!
+      IF( con_i ) THEN
+         DO ji = kideb, kiut
+            ! Upper snow value
+            fc_s(ji,0) = - isnow(ji) * zkappa_s(ji,0) * zg1s * ( t_s_b(ji,1) - t_su_b(ji) ) 
+            ! Bott. snow value
+            fc_s(ji,1) = - isnow(ji)* zkappa_s(ji,1) * ( t_i_b(ji,1) - t_s_b(ji,1) ) 
+         END DO
+         DO ji = kideb, kiut         ! Upper ice layer
+            fc_i(ji,0) = - isnow(ji) * &  ! interface flux if there is snow
+               ( zkappa_i(ji,0)  * ( t_i_b(ji,1) - t_s_b(ji,nlay_s ) ) ) &
+               - ( 1.0 - isnow(ji) ) * ( zkappa_i(ji,0) * & 
+               zg1 * ( t_i_b(ji,1) - t_su_b(ji) ) ) ! upper flux if not
+         END DO
+         DO layer = 1, nlay_i - 1         ! Internal ice layers
+            DO ji = kideb, kiut
+               fc_i(ji,layer) = - zkappa_i(ji,layer) * ( t_i_b(ji,layer+1) - t_i_b(ji,layer) )
+               ii = MOD( npb(ji) - 1, jpi ) + 1
+               ij = ( npb(ji) - 1 ) / jpi + 1
+            END DO
+         END DO
+         DO ji = kideb, kiut         ! Bottom ice layers
+            fc_i(ji,nlay_i) = - zkappa_i(ji,nlay_i) * ( zg1*(t_bo_b(ji) - t_i_b(ji,nlay_i)) )
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE lim_thd_dif
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_ent.F90	(revision 3437)
@@ -0,0 +1,699 @@
+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
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#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 ice              ! LIM variables
+   USE par_ice          ! LIM parameters
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_ent         ! called by lim_thd
+
+   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values
+   REAL(wp) ::   epsi13 = 1e-13_wp   !
+   REAL(wp) ::   epsi10 = 1e-10_wp   !
+   REAL(wp) ::   epsi06 = 1e-06_wp   !
+   REAL(wp) ::   zzero  = 0._wp      !
+   REAL(wp) ::   zone   = 1._wp      !
+
+   !!----------------------------------------------------------------------
+   !! 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, jl )
+      !!-------------------------------------------------------------------
+      !!               ***   ROUTINE lim_thd_ent  ***
+      !!
+      !! ** Purpose :
+      !!           This routine computes new vertical grids 
+      !!           in the ice and in the snow, and consistently redistributes 
+      !!           temperatures in the snow / ice. 
+      !!           Redistribution is made so as to ensure to energy conservation
+      !!
+      !!
+      !! ** Method  : linear conservative remapping
+      !!           
+      !! ** Steps : 1) Grid
+      !!            2) Switches
+      !!            3) Snow redistribution
+      !!            4) Ice enthalpy redistribution
+      !!            5) Ice salinity, recover temperature
+      !!
+      !! 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
+      INTEGER , INTENT(in) ::   jl            ! Thickness cateogry number
+
+      INTEGER ::   ji,jk   !  dummy loop indices
+      INTEGER ::   zji, zjj       ,   &  !  dummy indices
+         ntop0          ,   &  !  old layer top index
+         nbot1          ,   &  !  new layer bottom index
+         ntop1          ,   &  !  new layer top index
+         limsum         ,   &  !  temporary loop index
+         nlayi0,nlays0  ,   &  !  old number of layers
+         maxnbot0       ,   &  !  old layer bottom index
+         layer0, layer1        !  old/new layer indexes
+
+
+      REAL(wp) :: &
+         ztmelts        ,   &  ! ice melting point
+         zqsnic         ,   &  ! enthalpy of snow ice layer
+         zhsnow         ,   &  ! temporary snow thickness variable
+         zswitch        ,   &  ! dummy switch argument
+         zfac1          ,   &  ! dummy factor
+         zfac2          ,   &  ! dummy factor
+         ztform         ,   &  !: bottom formation temperature
+         zaaa           ,   &  !: dummy factor
+         zbbb           ,   &  !: dummy factor
+         zccc           ,   &  !: dummy factor
+         zdiscrim              !: dummy factor
+
+      INTEGER, POINTER, DIMENSION(:) ::   snswi     !  snow switch
+      INTEGER, POINTER, DIMENSION(:) ::   nbot0     !  old layer bottom index
+      INTEGER, POINTER, DIMENSION(:) ::   icsuind   !  ice surface index
+      INTEGER, POINTER, DIMENSION(:) ::   icsuswi   !  ice surface switch
+      INTEGER, POINTER, DIMENSION(:) ::   icboind   !  ice bottom index
+      INTEGER, POINTER, DIMENSION(:) ::   icboswi   !  ice bottom switch
+      INTEGER, POINTER, DIMENSION(:) ::   snicind   !  snow ice index
+      INTEGER, POINTER, DIMENSION(:) ::   snicswi   !  snow ice switch
+      INTEGER, POINTER, DIMENSION(:) ::   snind     !  snow index
+      !
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_i   ! thickness of an ice layer
+      REAL(wp), POINTER, DIMENSION(:) ::   zh_s          ! thickness of a snow layer
+      REAL(wp), POINTER, DIMENSION(:) ::   zqsnow        ! enthalpy of the snow put in snow ice 	
+      REAL(wp), POINTER, DIMENSION(:) ::   zdeltah       ! temporary variable
+      REAL(wp), POINTER, DIMENSION(:) ::   zqti_in, zqts_in
+      REAL(wp), POINTER, DIMENSION(:) ::   zqti_fin, zqts_fin
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zm0       !  old layer-system vertical cotes 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   qm0       !  old layer-system heat content 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_s       !  new snow system vertical cotes 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_i       !  new ice system vertical cotes 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zthick0   !  old ice thickness 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zhl0      ! old and new layer thicknesses 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zrl01
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer
+      CALL wrk_alloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real
+      CALL wrk_alloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 )
+      CALL wrk_alloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 )
+
+      zthick0(:,:) = 0._wp
+      zm0    (:,:) = 0._wp
+      qm0    (:,:) = 0._wp
+      zrl01  (:,:) = 0._wp
+      zhl0   (:,:) = 0._wp
+      z_i    (:,:) = 0._wp
+      z_s    (:,:) = 0._wp
+
+      !
+      !------------------------------------------------------------------------------|
+      !  1) Grid                                                                     |
+      !------------------------------------------------------------------------------|
+      nlays0 = nlay_s
+      nlayi0 = nlay_i
+
+      DO ji = kideb, kiut
+         zh_i(ji) = old_ht_i_b(ji) / nlay_i 
+         zh_s(ji) = old_ht_s_b(ji) / nlay_s
+      END DO
+
+      !
+      !------------------------------------------------------------------------------|
+      !  2) Switches                                                                 |
+      !------------------------------------------------------------------------------|
+      ! 2.1 snind(ji), snswi(ji)
+      ! snow surface behaviour : computation of snind(ji)-snswi(ji)
+      ! snind(ji) : index which equals 
+      ! 	 0 if snow is accumulating
+      ! 	 1 if 1st layer is melting
+      ! 	 2 if 2nd layer is melting ...
+      DO ji = kideb, kiut
+         snind  (ji) = 0
+         zdeltah(ji) = 0._wp
+      ENDDO !ji
+
+      DO jk = 1, nlays0
+         DO ji = kideb, kiut
+            snind(ji)  = jk        *      INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20))) &
+               + snind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_s_tot(ji)-zdeltah(ji)-epsi20))))
+            zdeltah(ji)= zdeltah(ji) + zh_s(ji)
+         END DO ! ji
+      END DO ! jk
+
+      ! snswi(ji) : switch which value equals 1 if snow melts
+      !				   0 if not
+      DO ji = kideb, kiut
+         snswi(ji)     = MAX(0,INT(-dh_s_tot(ji)/MAX(epsi20,ABS(dh_s_tot(ji)))))
+      END DO ! ji
+
+      ! 2.2 icsuind(ji), icsuswi(ji)
+      ! ice surface behaviour : computation of icsuind(ji)-icsuswi(ji)
+      ! icsuind(ji) : index which equals
+      !	   0 if nothing happens at the surface
+      !	   1 if first layer is melting
+      !	   2 if 2nd layer is reached by melt ...
+      DO ji = kideb, kiut
+         icsuind(ji) = 0
+         zdeltah(ji) = 0._wp
+      END DO !ji
+      DO jk = 1, nlayi0
+         DO ji = kideb, kiut
+            icsuind(ji) = jk          *      INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20))) &
+               + icsuind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_surf(ji)-zdeltah(ji)-epsi20))))
+            zdeltah(ji) = zdeltah(ji) + zh_i(ji)
+         END DO ! ji
+      ENDDO !jk
+
+      ! icsuswi(ji) : switch which equals 
+      ! 	   1 if ice melts at the surface
+      ! 	   0 if not
+      DO ji = kideb, kiut
+         icsuswi(ji)  = MAX(0,INT(-dh_i_surf(ji)/MAX(epsi20 , ABS(dh_i_surf(ji)) ) ) )
+      ENDDO
+
+      ! 2.3 icboind(ji), icboswi(ji)
+      ! ice bottom behaviour : computation of icboind(ji)-icboswi(ji)
+      ! icboind(ji) : index which equals
+      ! 	   0 if accretion is on the way
+      ! 	   1 if last layer has started to melt
+      ! 	   2 if penultiem layer is melting ... and so on
+      !            N+1 if all layers melt and that snow transforms into ice
+      DO ji = kideb, kiut 
+         icboind(ji) = 0
+         zdeltah(ji) = 0._wp
+      END DO
+      DO jk = nlayi0, 1, -1
+         DO ji = kideb, kiut
+            icboind(ji) = (nlayi0+1-jk) *      INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20))) &
+               &          + icboind(ji) * (1 - INT(MAX(0.0,SIGN(1.0,-dh_i_bott(ji)-zdeltah(ji)-epsi20)))) 
+            zdeltah(ji) = zdeltah(ji) + zh_i(ji)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut
+         ! case of total ablation with remaining snow
+         IF ( ( ht_i_b(ji) .GT. epsi20 ) .AND. &
+            ( ht_i_b(ji) - dh_snowice(ji) .LT. epsi20 ) ) icboind(ji) = nlay_i + 1
+      END DO
+
+      ! icboswi(ji) : switch which equals 
+      ! 	   1 if ice accretion is on the way
+      ! 	   0 if ablation is on the way
+      DO ji = kideb, kiut 
+         icboswi(ji) = MAX(0,INT(dh_i_bott(ji) / MAX(epsi20,ABS(dh_i_bott(ji)))))
+      END DO
+
+      ! 2.4 snicind(ji), snicswi(ji)
+      ! snow ice formation : calcul de snicind(ji)-snicswi(ji)
+      ! snicind(ji) : index which equals 
+      ! 	   0 if no snow-ice forms
+      ! 	   1 if last layer of snow has started to melt
+      ! 	   2 if penultiem layer ...
+      DO ji = kideb, kiut
+         snicind(ji) = 0
+         zdeltah(ji) = 0._wp
+      END DO
+      DO jk = nlays0, 1, -1
+         DO ji = kideb, kiut
+            snicind(ji) = (nlays0+1-jk) &
+               *      INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20))) + snicind(ji)   &
+               * (1 - INT(MAX(0.0,SIGN(1.0,dh_snowice(ji)-zdeltah(ji)-epsi20))))
+            zdeltah(ji) = zdeltah(ji) + zh_s(ji)
+         END DO
+      END DO
+
+      ! snicswi(ji) : switch which equals 
+      ! 	   1 if snow-ice forms
+      ! 	   0 if not
+      DO ji = kideb, kiut
+         snicswi(ji)   = MAX(0,INT(dh_snowice(ji)/MAX(epsi20,ABS(dh_snowice(ji)))))
+      ENDDO
+
+      !
+      !------------------------------------------------------------------------------|
+      !  3) Snow redistribution                                                      |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------
+      ! Old profile
+      !-------------
+
+      ! by 'old', it is meant that layers coming from accretion are included, 
+      ! and that interfacial layers which were partly melted are reduced 
+
+      ! indexes of the vectors
+      !------------------------
+      ntop0    =  1
+      maxnbot0 =  0
+
+      DO ji = kideb, kiut
+         nbot0(ji) =  nlays0  + 1 - snind(ji) + ( 1. - snicind(ji) ) * snicswi(ji)
+         ! cotes of the top of the layers
+         zm0(ji,0) =  0._wp
+         maxnbot0 =  MAX ( maxnbot0 , nbot0(ji) )
+      END DO
+      IF( lk_mpp )   CALL mpp_max( maxnbot0, kcom=ncomm_ice )
+
+      DO jk = 1, maxnbot0
+         DO ji = kideb, kiut
+            !change
+            limsum = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 )
+            limsum = MIN( limsum , nlay_s )
+            zm0(ji,jk) =  dh_s_tot(ji) + zh_s(ji) * limsum
+         END DO
+      END DO
+
+      DO ji = kideb, kiut
+         zm0(ji,nbot0(ji)) =  dh_s_tot(ji) - snicswi(ji) * dh_snowice(ji) + zh_s(ji) * nlays0
+         zm0(ji,1)         =  dh_s_tot(ji) * (1 -snswi(ji) ) + snswi(ji) * zm0(ji,1)
+      END DO
+
+      DO jk = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            zthick0(ji,jk)  =  zm0(ji,jk) - zm0(ji,jk-1)            ! layer thickness
+         END DO
+      END DO
+
+      zqts_in(:) = 0._wp
+
+      DO ji = kideb, kiut         ! layer heat content
+         qm0    (ji,1) =  rhosn * (  cpic * ( rtt - ( 1. - snswi(ji) ) * tatm_ice_1d(ji)        &
+            &                                            - snswi(ji)   * t_s_b      (ji,1)  )   &
+            &                      + lfus  ) * zthick0(ji,1)
+         zqts_in(ji)   =  zqts_in(ji) + qm0(ji,1) 
+      END DO
+
+      DO jk = 2, maxnbot0
+         DO ji = kideb, kiut
+            limsum      = ( 1 - snswi(ji) ) * ( jk - 1 ) + snswi(ji) * ( jk + snind(ji) - 1 )
+            limsum      = MIN( limsum , nlay_s )
+            qm0(ji,jk)  = rhosn * ( cpic * ( rtt - t_s_b(ji,limsum) ) + lfus ) * zthick0(ji,jk)
+            zswitch = 1.0 - MAX (0.0, SIGN ( 1.0, epsi20 - ht_s_b(ji) ) )
+            zqts_in(ji) = zqts_in(ji) + ( 1. - snswi(ji) ) * qm0(ji,jk) * zswitch
+         END DO ! jk
+      END DO ! ji
+
+      !------------------------------------------------
+      ! Energy given by the snow in snow-ice formation
+      !------------------------------------------------
+      ! zqsnow, enthalpy of the flooded snow
+      DO ji = kideb, kiut
+         zqsnow (ji) =  rhosn * lfus
+         zdeltah(ji) =  0._wp
+      END DO
+
+      DO jk =  nlays0, 1, -1
+         DO ji = kideb, kiut
+            zhsnow =  MAX( 0._wp , dh_snowice(ji)-zdeltah(ji) )
+            zqsnow (ji) =  zqsnow (ji) + rhosn*cpic*(rtt-t_s_b(ji,jk))
+            zdeltah(ji) =  zdeltah(ji) + zh_s(ji)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut
+         zqsnow(ji) = zqsnow(ji) * dh_snowice(ji)
+      END DO
+
+      !------------------
+      ! new snow profile
+      !------------------
+
+      !--------------
+      ! Vector index   
+      !--------------
+      ntop1 =  1
+      nbot1 =  nlay_s
+
+      !-------------------
+      ! Layer coordinates 
+      !-------------------
+      DO ji = kideb, kiut
+         zh_s(ji)  = ht_s_b(ji) / nlay_s
+         z_s(ji,0) =  0._wp
+      ENDDO
+
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            z_s(ji,jk) =  zh_s(ji) * jk
+         END DO
+      END DO
+
+      !-----------------
+      ! Layer thickness
+      !-----------------
+      DO layer0 = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1)
+         END DO
+      END DO
+
+      DO layer1 = ntop1, nbot1
+         DO ji = kideb, kiut
+            q_s_b(ji,layer1) = 0._wp
+         END DO
+      END DO
+
+      !----------------
+      ! Weight factors
+      !----------------
+      DO layer0 = ntop0, maxnbot0
+         DO layer1 = ntop1, nbot1
+            DO ji = kideb, kiut
+               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_s(ji,layer1))   &
+                  &                 - MAX(zm0(ji,layer0-1), z_s(ji,layer1-1))) / MAX(zhl0(ji,layer0),epsi10)) 
+               q_s_b(ji,layer1) = q_s_b(ji,layer1) + zrl01(layer1,layer0)*qm0(ji,layer0)   &
+                  &                                * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20))
+            END DO
+         END DO
+      END DO
+
+      ! Heat conservation
+      zqts_fin(:) = 0._wp
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            zqts_fin(ji) = zqts_fin(ji) + q_s_b(ji,jk)
+         END DO
+      END DO
+
+      IF ( con_i ) THEN
+         DO ji = kideb, kiut
+            IF ( ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN
+               zji                 = MOD( npb(ji) - 1, jpi ) + 1
+               zjj                 = ( npb(ji) - 1 ) / jpi + 1
+               WRITE(numout,*) ' violation of heat conservation : ',             &
+                  ABS ( zqts_in(ji) - zqts_fin(ji) ) / rdt_ice
+               WRITE(numout,*) ' ji, jj   : ', zji, zjj
+               WRITE(numout,*) ' ht_s_b   : ', ht_s_b(ji)
+               WRITE(numout,*) ' zqts_in  : ', zqts_in(ji) / rdt_ice
+               WRITE(numout,*) ' zqts_fin : ', zqts_fin(ji) / rdt_ice
+               WRITE(numout,*) ' dh_snowice : ', dh_snowice(ji)
+               WRITE(numout,*) ' dh_s_tot : ', dh_s_tot(ji)
+               WRITE(numout,*) ' snswi    : ', snswi(ji)
+            ENDIF
+         END DO
+      ENDIF
+
+      !---------------------
+      ! Recover heat content
+      !---------------------
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            q_s_b(ji,jk) = q_s_b(ji,jk) / MAX( zh_s(ji) , epsi20 )
+         END DO !ji
+      END DO !jk  
+
+      !---------------------
+      ! Recover temperature
+      !---------------------
+      zfac1 = 1. / ( rhosn * cpic )
+      zfac2 = lfus / cpic  
+      DO jk = 1, nlay_s
+         DO ji = kideb, kiut
+            zswitch = MAX ( 0.0 , SIGN ( 1.0, epsi20 - ht_s_b(ji) ) )
+            t_s_b(ji,jk) = rtt + ( 1.0 - zswitch ) * ( - zfac1 * q_s_b(ji,jk) + zfac2 )
+         END DO
+      END DO
+      !
+      !------------------------------------------------------------------------------|
+      !  4) Ice redistribution                                                       |
+      !------------------------------------------------------------------------------|
+      !
+      !-------------
+      ! OLD PROFILE 
+      !-------------
+
+      !----------------
+      ! Vector indexes
+      !----------------
+      ntop0    =  1
+      maxnbot0 =  0
+
+      DO ji = kideb, kiut
+         ! reference number of the bottommost layer
+         nbot0(ji) =  MAX( 1 ,  MIN( nlayi0 + ( 1 - icboind(ji) ) +        &
+            &                           ( 1 - icsuind(ji) ) * icsuswi(ji) + snicswi(ji) , nlay_i + 2 ) )
+         ! maximum reference number of the bottommost layer over all domain
+         maxnbot0 =  MAX( maxnbot0 , nbot0(ji) )
+      END DO
+
+      !-------------------------
+      ! Cotes of old ice layers
+      !-------------------------
+      zm0(:,0) =  0._wp
+
+      DO jk = 1, maxnbot0
+         DO ji = kideb, kiut
+            ! jk goes from 1 to nbot0
+            ! the ice layer number goes from 1 to nlay_i
+            ! limsum is the real ice layer number corresponding to present jk
+            limsum    =  ( (icsuswi(ji)*(icsuind(ji)+jk-1) + & 
+               (1-icsuswi(ji))*jk))*(1-snicswi(ji)) + (jk-1)*snicswi(ji)
+            zm0(ji,jk)=  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) &
+               +  limsum * zh_i(ji)
+         END DO
+      END DO
+
+      DO ji = kideb, kiut
+         zm0(ji,nbot0(ji)) =  icsuswi(ji)*dh_i_surf(ji) + snicswi(ji)*dh_snowice(ji) + dh_i_bott(ji) &
+            +  zh_i(ji) * nlayi0
+         zm0(ji,1)         =  snicswi(ji)*dh_snowice(ji) + (1-snicswi(ji))*zm0(ji,1)
+      END DO
+
+      !-----------------------------
+      ! Thickness of old ice layers
+      !-----------------------------
+      DO jk = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            zthick0(ji,jk) =  zm0(ji,jk) - zm0(ji,jk-1)
+         END DO
+      END DO
+
+      !---------------------------
+      ! Inner layers heat content
+      !---------------------------
+      qm0(:,:) =  0.0
+      zqti_in(:) = 0.0
+
+      DO jk = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            limsum =  MAX(1,MIN(snicswi(ji)*(jk-1) + icsuswi(ji)*(jk-1+icsuind(ji)) + &
+               (1-icsuswi(ji))*(1-snicswi(ji))*jk,nlay_i))
+            ztmelts = -tmut * s_i_b(ji,limsum) + rtt
+            qm0(ji,jk) = rhoic * ( cpic * (ztmelts-t_i_b(ji,limsum)) + lfus * ( 1.0-(ztmelts-rtt)/ &
+               MIN((t_i_b(ji,limsum)-rtt),-epsi20) ) - rcp*(ztmelts-rtt) ) &
+               * zthick0(ji,jk)
+         END DO
+      END DO
+
+      !----------------------------
+      ! Bottom layers heat content
+      !----------------------------
+      DO ji = kideb, kiut        
+         ztmelts    = ( 1.0 - icboswi(ji) ) * (-tmut * s_i_b  (ji,nlayi0) )   &   ! case of melting ice
+            &       +         icboswi(ji)   * (-tmut * s_i_new(ji)        )   &   ! case of forming ice
+            &       + rtt                                                         ! in Kelvin
+
+         ! bottom formation temperature
+         ztform = t_i_b(ji,nlay_i)
+         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) ztform = t_bo_b(ji)
+         qm0(ji,nbot0(ji)) = ( 1.0 - icboswi(ji) )*qm0(ji,nbot0(ji))             &   ! case of melting ice
+            &              + icboswi(ji) * rhoic * ( cpic*(ztmelts-ztform)       &   ! case of forming ice
+            + lfus *( 1.0-(ztmelts-rtt) / MIN ( (ztform-rtt) , - epsi10 ) )      & 
+            - rcp*(ztmelts-rtt) ) * zthick0(ji,nbot0(ji)  )
+      END DO
+
+      !-----------------------------
+      ! Snow ice layer heat content
+      !-----------------------------
+      DO ji = kideb, kiut
+         ! energy of the flooding seawater
+         zqsnic = rau0 * rcp * ( rtt - t_bo_b(ji) ) * dh_snowice(ji) * &
+            (rhoic - rhosn) / rhoic * snicswi(ji) ! generally positive
+         ! Heat conservation diagnostic
+         qt_i_in(ji,jl) = qt_i_in(ji,jl) + zqsnic 
+
+         qldif_1d(ji)   = qldif_1d(ji) + zqsnic * a_i_b(ji)
+
+         ! enthalpy of the newly formed snow-ice layer
+         ! = enthalpy of snow + enthalpy of frozen water
+         zqsnic         =  zqsnow(ji) + zqsnic
+         qm0(ji,1)      =  snicswi(ji) * zqsnic + ( 1 - snicswi(ji) ) * qm0(ji,1)
+
+      END DO ! ji
+
+      DO jk = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            ! Heat conservation
+            zqti_in(ji) = zqti_in(ji) + qm0(ji,jk) * MAX( 0.0 , SIGN(1.0,ht_i_b(ji)-epsi06+epsi20) ) &
+               &                                   * MAX( 0.0 , SIGN( 1. , nbot0(ji) - jk + epsi20 ) )
+         END DO
+      END DO
+
+      !-------------
+      ! NEW PROFILE
+      !-------------
+
+      !---------------
+      ! Vectors index
+      !---------------
+      ntop1 =  1 
+      nbot1 =  nlay_i
+
+      !------------------
+      ! Layers thickness 
+      !------------------
+      DO ji = kideb, kiut
+         zh_i(ji) = ht_i_b(ji) / nlay_i
+      ENDDO
+
+      !-------------
+      ! Layer cotes      
+      !-------------
+      z_i(:,0) =  0._wp
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            z_i(ji,jk) =  zh_i(ji) * jk
+         END DO
+      END DO
+
+      !--thicknesses of the layers
+      DO layer0 = ntop0, maxnbot0
+         DO ji = kideb, kiut
+            zhl0(ji,layer0) = zm0(ji,layer0) - zm0(ji,layer0-1)   ! thicknesses of the layers
+         END DO
+      END DO
+
+      !------------------------
+      ! Weights for relayering
+      !------------------------
+      q_i_b(:,:) = 0._wp
+      DO layer0 = ntop0, maxnbot0
+         DO layer1 = ntop1, nbot1
+            DO ji = kideb, kiut
+               zrl01(layer1,layer0) = MAX(0.0,( MIN(zm0(ji,layer0),z_i(ji,layer1)) &
+                  - MAX(zm0(ji,layer0-1), z_i(ji,layer1-1)))/MAX(zhl0(ji,layer0),epsi10))
+               q_i_b(ji,layer1) = q_i_b(ji,layer1) & 
+                  + zrl01(layer1,layer0)*qm0(ji,layer0) &
+                  * MAX(0.0,SIGN(1.0,ht_i_b(ji)-epsi06+epsi20)) &
+                  * MAX(0.0,SIGN(1.0,nbot0(ji)-layer0+epsi20))
+            END DO
+         END DO
+      END DO
+
+      !-------------------------
+      ! Heat conservation check
+      !-------------------------
+      zqti_fin(:) = 0._wp
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk)
+         END DO
+      END DO
+      !
+      DO ji = kideb, kiut
+         IF ( ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice .GT. 1.0e-6 ) THEN
+            zji                 = MOD( npb(ji) - 1, jpi ) + 1
+            zjj                 = ( npb(ji) - 1 ) / jpi + 1
+            WRITE(numout,*) ' violation of heat conservation : ', ABS ( zqti_in(ji) - zqti_fin(ji) ) / rdt_ice
+            WRITE(numout,*) ' ji, jj   : ', zji, zjj
+            WRITE(numout,*) ' ht_i_b   : ', ht_i_b(ji)
+            WRITE(numout,*) ' zqti_in  : ', zqti_in(ji) / rdt_ice
+            WRITE(numout,*) ' zqti_fin : ', zqti_fin(ji) / rdt_ice
+            WRITE(numout,*) ' dh_i_bott: ', dh_i_bott(ji)
+            WRITE(numout,*) ' dh_i_surf: ', dh_i_surf(ji)
+            WRITE(numout,*) ' dh_snowice:', dh_snowice(ji)
+            WRITE(numout,*) ' icsuswi  : ', icsuswi(ji)
+            WRITE(numout,*) ' icboswi  : ', icboswi(ji)
+            WRITE(numout,*) ' snicswi  : ', snicswi(ji)
+         ENDIF
+      END DO
+
+      !----------------------
+      ! Recover heat content 
+      !----------------------
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            q_i_b(ji,jk) = q_i_b(ji,jk) / MAX( zh_i(ji) , epsi20 )
+         END DO !ji
+      END DO !jk  
+
+      ! Heat conservation
+      zqti_fin(:) = 0.0
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            zqti_fin(ji) = zqti_fin(ji) + q_i_b(ji,jk) * zh_i(ji)
+         END DO
+      END DO
+
+      !
+      !------------------------------------------------------------------------------|
+      !  5) Update salinity and recover temperature                                  |
+      !------------------------------------------------------------------------------|
+      !
+      ! Update salinity (basal entrapment, snow ice formation)
+      DO ji = kideb, kiut
+         sm_i_b(ji) = sm_i_b(ji) + dsm_i_se_1d(ji) + dsm_i_si_1d(ji)
+      END DO !ji
+
+      ! Recover temperature
+      DO jk = 1, nlay_i
+         DO ji = kideb, kiut
+            ztmelts    =  -tmut*s_i_b(ji,jk) + rtt
+            !Conversion q(S,T) -> T (second order equation)
+            zaaa         =  cpic
+            zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus
+            zccc         =  lfus * ( ztmelts - rtt )
+            zdiscrim     =  SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0) )
+            t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa )
+         END DO !ji
+
+      END DO !jk
+      !
+      CALL wrk_dealloc( jpij, snswi, nbot0, icsuind, icsuswi, icboind, icboswi, snicind, snicswi, snind )   ! integer
+      CALL wrk_dealloc( jpij, zh_i, zh_s, zqsnow, zdeltah, zqti_in, zqts_in, zqti_fin, zqts_fin )           ! real
+      CALL wrk_dealloc( jpij,jkmax+4, zm0, qm0, z_s, z_i, zthick0, zhl0, kjstart = 0 )
+      CALL wrk_dealloc( jkmax+4,jkmax+4, zrl01, kistart = 0, kjstart = 0 )
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90	(revision 3437)
@@ -0,0 +1,714 @@
+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 dom_ice          ! LIM domain
+   USE par_ice          ! LIM parameters
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_thd_lac     ! called by lim_thd
+
+   REAL(wp) ::   epsi20 = 1e-20_wp   ! constant values
+   REAL(wp) ::   epsi13 = 1e-13_wp   !
+   REAL(wp) ::   epsi11 = 1e-11_wp   !
+   REAL(wp) ::   epsi10 = 1e-10_wp   !
+   REAL(wp) ::   epsi06 = 1e-06_wp   !
+   REAL(wp) ::   epsi03 = 1e-03_wp   !
+   REAL(wp) ::   zzero  = 0._wp      !
+   REAL(wp) ::   zone   = 1._wp      !
+
+   !!----------------------------------------------------------------------
+   !! 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_b, ht_i_b and tbif_1d(:,:)      
+      !!------------------------------------------------------------------------
+      INTEGER ::   ji,jj,jk,jl,jm   ! dummy loop indices
+      INTEGER ::   layer, nbpac     ! local integers 
+      INTEGER ::   zji, zjj, iter   !   -       -
+      REAL(wp)  ::   ztmelts, zdv, zqold, zfrazb, zweight, zalphai, zindb, zde  ! local scalars
+      REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf , zhicol_new        !   -      -
+      REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      -
+      LOGICAL  ::   iterate_frazil   ! iterate frazil ice collection thickness
+      CHARACTER (len = 15) :: fieldid
+      !
+      INTEGER , POINTER, DIMENSION(:) ::   zcatac      ! 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_ac    ! total ice fraction    
+      REAL(wp), POINTER, DIMENSION(:) ::   zat_i_lev   ! total ice fraction for level ice only (type 1)   
+      REAL(wp), POINTER, DIMENSION(:) ::   zdh_frazb   ! accretion of frazil ice at the ice bottom
+      REAL(wp), POINTER, DIMENSION(:) ::   zvrel_ac    ! relative ice / frazil velocity (1D vector)
+
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zhice_old   ! previous ice thickness
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdummy      ! dummy thickness of new ice 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdhicbot    ! thickness of new ice which is accreted vertically
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_old      ! old volume of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_old      ! old area of ice in category jl
+      REAL(wp), POINTER, DIMENSION(:,:) ::   za_i_ac     ! 1-D version of a_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zv_i_ac     ! 1-D version of v_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zoa_i_ac    ! 1-D version of oa_i
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zsmv_i_ac   ! 1-D version of smv_i
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze_i_ac   !: 1-D version of e_i
+
+      REAL(wp), POINTER, DIMENSION(:) ::   zqbgow    ! heat budget of the open water (negative)
+      REAL(wp), POINTER, DIMENSION(:) ::   zdhex     ! excessively thick accreted sea ice (hlead-hice)
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zqm0      ! old layer-system heat content
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zthick0   ! old ice thickness
+
+      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               !  snow energy summed over categories
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zvrel                   ! relative ice / frazil velocity
+      !!-----------------------------------------------------------------------!
+
+      CALL wrk_alloc( jpij, zcatac )   ! 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_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex )
+      CALL wrk_alloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )
+      CALL wrk_alloc( jpij,jkmax,jpl, ze_i_ac )
+      CALL wrk_alloc( jpij,jkmax+1,jpl, zqm0, zthick0 )
+      CALL wrk_alloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, zvrel )
+
+      et_i_init(:,:) = 0._wp
+      et_s_init(:,:) = 0._wp
+      vt_i_init(:,:) = 0._wp
+      vt_s_init(:,:) = 0._wp
+
+      !------------------------------------------------------------------------------!
+      ! 1) Conservation check and 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)
+         CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init)
+      ENDIF
+
+      !------------------------------------------------------------------------------|
+      ! 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]
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) / &
+                     MAX( area(ji,jj) * v_i(ji,jj,jl) ,  epsi10 ) * &
+                     nlay_i
+                  zindb      = 1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl))) !0 if no ice and 1 if yes
+                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl)*unit_fac*zindb
+               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.0
+
+      ! Default new ice thickness 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            hicol(ji,jj) = hiccrit(1)
+         END DO
+      END DO
+
+      IF (fraz_swi.eq.1.0) THEN
+
+         !--------------------
+         ! Physical constants
+         !--------------------
+         hicol(:,:) = 0.0
+
+         zhicrit = 0.04 ! frazil ice thickness
+         ztwogp  = 2. * rau0 / ( grav * 0.3 * ( rau0 - rhoic ) ) ! reduced grav
+         zsqcd   = 1.0 / SQRT( 1.3 * cai ) ! 1/SQRT(airdensity*drag)
+         zgamafr = 0.03
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+               IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN
+                  !-------------
+                  ! Wind stress
+                  !-------------
+                  ! C-grid wind stress components
+                  ztaux         = ( utau_ice(ji-1,jj  ) * tmu(ji-1,jj  ) &
+                     &          +   utau_ice(ji  ,jj  ) * tmu(ji  ,jj  ) ) / 2.0
+                  ztauy         = ( vtau_ice(ji  ,jj-1) * tmv(ji  ,jj-1) &
+                     &          +   vtau_ice(ji  ,jj  ) * tmv(ji  ,jj  ) ) / 2.0
+                  ! Square root of wind stress
+                  ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) )
+
+                  !---------------------
+                  ! Frazil ice velocity
+                  !---------------------
+                  zvfrx         = zgamafr * zsqcd * ztaux / MAX(ztenagm,epsi10)
+                  zvfry         = zgamafr * zsqcd * ztauy / MAX(ztenagm,epsi10)
+
+                  !-------------------
+                  ! Pack ice velocity
+                  !-------------------
+                  ! C-grid ice velocity
+                  zindb = MAX(0.0, SIGN(1.0, at_i(ji,jj) ))
+                  zvgx  = zindb * ( u_ice(ji-1,jj  ) * tmu(ji-1,jj  ) &
+                     + u_ice(ji,jj    ) * tmu(ji  ,jj  ) ) / 2.0
+                  zvgy  = zindb * ( v_ice(ji  ,jj-1) * tmv(ji  ,jj-1) &
+                     + v_ice(ji,jj    ) * tmv(ji  ,jj  ) ) / 2.0
+
+                  !-----------------------------------
+                  ! Relative frazil/pack ice velocity
+                  !-----------------------------------
+                  ! absolute relative velocity
+                  zvrel2        = MAX( ( zvfrx - zvgx ) * ( zvfrx - zvgx ) + &
+                     ( zvfry - zvgy ) * ( zvfry - zvgy )   &
+                     , 0.15 * 0.15 )
+                  zvrel(ji,jj)  = SQRT(zvrel2)
+
+                  !---------------------
+                  ! Iterative procedure
+                  !---------------------
+                  hicol(ji,jj) = zhicrit + 0.1 
+                  hicol(ji,jj) = zhicrit + hicol(ji,jj) /      & 
+                     ( hicol(ji,jj) * hicol(ji,jj) - &
+                     zhicrit * zhicrit ) * ztwogp * zvrel2
+
+                  iter = 1
+                  iterate_frazil = .true.
+
+                  DO WHILE ( iter .LT. 100 .AND. iterate_frazil ) 
+                     zf = ( hicol(ji,jj) - zhicrit ) * ( hicol(ji,jj)**2 - zhicrit**2 ) &
+                        - hicol(ji,jj) * zhicrit * ztwogp * zvrel2
+                     zfp = ( hicol(ji,jj) - zhicrit ) * ( 3.0*hicol(ji,jj) + zhicrit ) &
+                        - zhicrit * ztwogp * zvrel2
+                     zhicol_new = hicol(ji,jj) - zf/zfp
+                     hicol(ji,jj)   = zhicol_new
+
+                     iter = iter + 1
+
+                  END DO ! do while
+
+               ENDIF ! end of selection of pixels where ice forms
+
+            END DO ! loop on ji ends
+         END DO ! loop on jj ends
+
+      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
+      nbpac = 0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF ( tms(ji,jj) * ( qcmif(ji,jj) - qldif(ji,jj) ) > 0.e0 ) THEN
+               nbpac = nbpac + 1
+               npac( nbpac ) = (jj - 1) * jpi + ji
+               IF ( (ji.eq.jiindx).AND.(jj.eq.jjindx) ) THEN
+                  jiindex_1d = nbpac
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+
+      IF( ln_nicep ) THEN
+         WRITE(numout,*) 'lim_thd_lac : nbpac = ', nbpac
+      ENDIF
+
+      !------------------------------
+      ! Move from 2-D to 1-D vectors
+      !------------------------------
+      ! If ocean gains heat do nothing 
+      ! 0therwise compute new ice formation
+
+      IF ( nbpac > 0 ) THEN
+
+         CALL tab_2d_1d( nbpac, zat_i_ac  (1:nbpac)     , at_i         ,       &
+            jpi, jpj, npac(1:nbpac) )
+         DO jl = 1, jpl
+            CALL tab_2d_1d( nbpac, za_i_ac(1:nbpac,jl)  , a_i(:,:,jl)  ,       &
+               jpi, jpj, npac(1:nbpac) )
+            CALL tab_2d_1d( nbpac, zv_i_ac(1:nbpac,jl)  , v_i(:,:,jl)  ,       &
+               jpi, jpj, npac(1:nbpac) )
+            CALL tab_2d_1d( nbpac, zoa_i_ac(1:nbpac,jl) , oa_i(:,:,jl) ,       &
+               jpi, jpj, npac(1:nbpac) )
+            CALL tab_2d_1d( nbpac, zsmv_i_ac(1:nbpac,jl), smv_i(:,:,jl),       &
+               jpi, jpj, npac(1:nbpac) )
+            DO jk = 1, nlay_i
+               CALL tab_2d_1d( nbpac, ze_i_ac(1:nbpac,jk,jl), e_i(:,:,jk,jl) , &
+                  jpi, jpj, npac(1:nbpac) )
+            END DO ! jk
+         END DO ! jl
+
+         CALL tab_2d_1d( nbpac, qldif_1d  (1:nbpac)     , qldif ,              &
+            jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, qcmif_1d  (1:nbpac)     , qcmif ,              &
+            jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, t_bo_b    (1:nbpac)     , t_bo  ,              &
+            jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, fseqv_1d  (1:nbpac)     , fseqv ,              &
+            jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, hicol_b   (1:nbpac)     , hicol ,              &
+            jpi, jpj, npac(1:nbpac) )
+         CALL tab_2d_1d( nbpac, zvrel_ac  (1:nbpac)     , zvrel ,              &
+            jpi, jpj, npac(1:nbpac) )
+
+         !------------------------------------------------------------------------------!
+         ! 5) Compute thickness, salinity, enthalpy, age, area and volume of new ice
+         !------------------------------------------------------------------------------!
+
+         !----------------------
+         ! Thickness of new ice
+         !----------------------
+         DO ji = 1, nbpac
+            zh_newice(ji)     = hiccrit(1)
+         END DO
+         IF ( fraz_swi .EQ. 1.0 ) zh_newice(:) = hicol_b(:)
+
+         !----------------------
+         ! Salinity of new ice 
+         !----------------------
+
+         IF ( num_sal .EQ. 1 ) THEN
+            zs_newice(:)      =   bulk_sal
+         ENDIF ! num_sal
+
+         IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN
+
+            DO ji = 1, nbpac
+               zs_newice(ji)  =   MIN( 4.606 + 0.91 / zh_newice(ji) , s_i_max )
+               zji            =   MOD( npac(ji) - 1, jpi ) + 1
+               zjj            =   ( npac(ji) - 1 ) / jpi + 1
+               zs_newice(ji)  =   MIN( 0.5*sss_m(zji,zjj) , zs_newice(ji) )
+            END DO ! jl
+
+         ENDIF ! num_sal
+
+         IF ( num_sal .EQ. 3 ) THEN
+            zs_newice(:)      =   2.3
+         ENDIF ! num_sal
+
+         !-------------------------
+         ! 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) + rtt ! Melting point (K)
+            ze_newice(ji)     =   rhoic * ( cpic * ( ztmelts - t_bo_b(ji) )    &
+               + lfus * ( 1.0 - ( ztmelts - rtt )   &
+               / ( t_bo_b(ji) - rtt ) )           &
+               - rcp * ( ztmelts-rtt ) )
+            ze_newice(ji)     =   MAX( ze_newice(ji) , 0.0 ) +                 &
+               MAX( 0.0 , SIGN( 1.0 , - ze_newice(ji) ) )   & 
+               * rhoic * lfus
+         END DO ! ji
+         !----------------
+         ! Age of new ice
+         !----------------
+         DO ji = 1, nbpac
+            zo_newice(ji)     = 0.0
+         END DO ! ji
+
+         !--------------------------
+         ! Open water energy budget 
+         !--------------------------
+         DO ji = 1, nbpac
+            zqbgow(ji)        = qldif_1d(ji) - qcmif_1d(ji) !<0
+         END DO ! ji
+
+         !-------------------
+         ! Volume of new ice
+         !-------------------
+         DO ji = 1, nbpac
+            zv_newice(ji)     = - zqbgow(ji) / ze_newice(ji)
+
+            ! A fraction zfrazb of frazil ice is accreted at the ice bottom
+            zfrazb        = ( TANH ( Cfrazb * ( zvrel_ac(ji) - vfrazb ) )     & 
+               + 1.0 ) / 2.0 * maxfrazb
+            zdh_frazb(ji) = zfrazb*zv_newice(ji)
+            zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji)
+         END DO
+
+         !---------------------------------
+         ! Salt flux due to new ice growth
+         !---------------------------------
+         IF ( ( num_sal .EQ. 4 ) ) THEN 
+            DO ji = 1, nbpac
+               zji            = MOD( npac(ji) - 1, jpi ) + 1
+               zjj            = ( npac(ji) - 1 ) / jpi + 1
+               fseqv_1d(ji)   = fseqv_1d(ji) +                                     &
+                  ( sss_m(zji,zjj) - bulk_sal      ) * rhoic *       &
+                  zv_newice(ji) / rdt_ice
+            END DO
+         ELSE
+            DO ji = 1, nbpac
+               zji            = MOD( npac(ji) - 1, jpi ) + 1
+               zjj            = ( npac(ji) - 1 ) / jpi + 1
+               fseqv_1d(ji)   = fseqv_1d(ji) +                                     &
+                  ( sss_m(zji,zjj) - zs_newice(ji) ) * rhoic *       &
+                  zv_newice(ji) / rdt_ice
+            END DO ! ji
+         ENDIF
+
+         !------------------------------------
+         ! Diags for energy conservation test
+         !------------------------------------
+         DO ji = 1, nbpac
+            ! Volume
+            zji                  = MOD( npac(ji) - 1, jpi ) + 1
+            zjj                  = ( npac(ji) - 1 ) / jpi + 1
+            vt_i_init(zji,zjj)   = vt_i_init(zji,zjj) + zv_newice(ji)
+            ! Energy
+            zde                  = ze_newice(ji) / unit_fac
+            zde                  = zde * area(zji,zjj) * zv_newice(ji)
+            et_i_init(zji,zjj)   = et_i_init(zji,zjj) + zde
+         END DO
+
+         ! keep new ice volume in memory
+         CALL tab_1d_2d( nbpac, v_newice , npac(1:nbpac), zv_newice(1:nbpac) , &
+            jpi, jpj )
+
+         !-----------------
+         ! Area of new ice
+         !-----------------
+         DO ji = 1, nbpac
+            za_newice(ji)     = zv_newice(ji) / zh_newice(ji)
+            ! diagnostic
+            zji                  = MOD( npac(ji) - 1, jpi ) + 1
+            zjj                  = ( npac(ji) - 1 ) / jpi + 1
+            diag_lat_gr(zji,zjj) = zv_newice(ji) / rdt_ice
+         END DO !ji
+
+         !------------------------------------------------------------------------------!
+         ! 6) Redistribute new ice area and volume into ice categories                  !
+         !------------------------------------------------------------------------------!
+
+         !-----------------------------------------
+         ! Keep old ice areas and volume in memory
+         !-----------------------------------------
+         zv_old(:,:) = zv_i_ac(:,:) 
+         za_old(:,:) = za_i_ac(:,:)
+
+         !-------------------------------------------
+         ! Compute excessive new ice area and volume
+         !-------------------------------------------
+         ! 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
+            ! vectorize
+            IF ( za_newice(ji) .GT. ( 1.0 - zat_i_ac(ji) ) ) THEN
+               zda_res(ji)    = za_newice(ji) - (1.0 - zat_i_ac(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.0
+               zdv_res(ji) = 0.0
+            ENDIF
+         END DO ! ji
+
+         !------------------------------------------------
+         ! Laterally redistribute new ice volume and area
+         !------------------------------------------------
+         zat_i_ac(:) = 0._wp
+         DO jl = 1, jpl
+            DO ji = 1, nbpac
+               IF(  hi_max   (jl-1)  <  zh_newice(ji)   .AND.   &
+                  & zh_newice(ji)    <= hi_max   (jl)         ) THEN
+                  za_i_ac (ji,jl) = za_i_ac (ji,jl) + za_newice(ji)
+                  zv_i_ac (ji,jl) = zv_i_ac (ji,jl) + zv_newice(ji)
+                  zat_i_ac(ji)    = zat_i_ac(ji)    + za_i_ac  (ji,jl)
+                  zcatac  (ji)    = jl
+               ENDIF
+            END DO ! ji
+         END DO ! jl
+
+         !----------------------------------
+         ! Heat content - lateral accretion
+         !----------------------------------
+         DO ji = 1, nbpac
+            jl = zcatac(ji)                                                           ! categroy in which new ice is put
+            zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , -za_old(ji,jl) ) )             ! zindb=1 if ice =0 otherwise
+            zhice_old(ji,jl) = zv_old(ji,jl) / MAX( za_old(ji,jl) , epsi10 ) * zindb  ! old ice thickness
+            zdhex    (ji) = MAX( 0._wp , zh_newice(ji) - zhice_old(ji,jl) )           ! difference in thickness
+            zswinew  (ji) = MAX( 0._wp , SIGN( 1._wp , - za_old(ji,jl) + epsi11 ) )   ! ice totally new in jl category
+         END DO
+
+         DO jk = 1, nlay_i
+            DO ji = 1, nbpac
+               jl = zcatac(ji)
+               zqold   = ze_i_ac(ji,jk,jl) ! [ J.m-3 ]
+               zalphai = MIN( zhice_old(ji,jl) *   jk       / nlay_i , zh_newice(ji) )   &
+                  &    - MIN( zhice_old(ji,jl) * ( jk - 1 ) / nlay_i , zh_newice(ji) )
+               ze_i_ac(ji,jk,jl) = zswinew(ji) * ze_newice(ji)                                     &
+                  + ( 1.0 - zswinew(ji) ) * ( za_old(ji,jl)  * zqold * zhice_old(ji,jl) / nlay_i   &
+                  + za_newice(ji)  * ze_newice(ji) * zalphai                                       &
+                  + za_newice(ji)  * ze_newice(ji) * zdhex(ji) / nlay_i ) / ( ( zv_i_ac(ji,jl) ) / nlay_i )
+            END DO
+         END DO
+
+         !-----------------------------------------------
+         ! Add excessive volume of new ice at the bottom
+         !-----------------------------------------------
+         ! If the ice concentration exceeds 1, the remaining volume of new ice
+         ! is equally redistributed among all ice categories in which there is
+         ! ice
+
+         ! Fraction of level ice
+         jm = 1
+         zat_i_lev(:) = 0._wp
+
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO ji = 1, nbpac
+               zat_i_lev(ji) = zat_i_lev(ji) + za_i_ac(ji,jl) 
+            END DO
+         END DO
+
+         IF( ln_nicep ) WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl)
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO ji = 1, nbpac
+               zindb = MAX( 0._wp, SIGN( 1._wp , zdv_res(ji) ) )
+               zv_i_ac(ji,jl) = zv_i_ac(ji,jl) + zindb * zdv_res(ji) * za_i_ac(ji,jl) / MAX( zat_i_lev(ji) , epsi06 )
+            END DO
+         END DO
+         IF( ln_nicep )   WRITE(numout,*) ' zv_i_ac : ', zv_i_ac(jiindx, 1:jpl)
+
+         !---------------------------------
+         ! Heat content - bottom accretion
+         !---------------------------------
+         jm = 1
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO ji = 1, nbpac
+               zindb =  1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl ) ) )       ! zindb=1 if ice =0 otherwise
+               zhice_old(ji,jl) = zv_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb
+               zdhicbot (ji,jl) = zdv_res(ji)    / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb    &
+                  &             +  zindb * zdh_frazb(ji)                               ! frazil ice may coalesce
+               zdummy(ji,jl)    = zv_i_ac(ji,jl)/MAX(za_i_ac(ji,jl),epsi10)*zindb      ! thickness of residual ice
+            END DO
+         END DO
+
+         ! old layers thicknesses and enthalpies
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO jk = 1, nlay_i
+               DO ji = 1, nbpac
+                  zthick0(ji,jk,jl) =  zhice_old(ji,jl) / nlay_i
+                  zqm0   (ji,jk,jl) =  ze_i_ac(ji,jk,jl) * zthick0(ji,jk,jl)
+               END DO
+            END DO
+         END DO
+!!gm ???  why the previous do loop  if ocerwriten by the following one ?
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO ji = 1, nbpac
+               zthick0(ji,nlay_i+1,jl) =  zdhicbot(ji,jl)
+               zqm0   (ji,nlay_i+1,jl) =  ze_newice(ji) * zdhicbot(ji,jl)
+            END DO ! ji
+         END DO ! jl
+
+         ! Redistributing energy on the new grid
+         ze_i_ac(:,:,:) = 0._wp
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO jk = 1, nlay_i
+               DO layer = 1, nlay_i + 1
+                  DO ji = 1, nbpac
+                     zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) ) 
+                     ! Redistributing energy on the new grid
+                     zweight = MAX (  MIN( zhice_old(ji,jl) * layer , zdummy(ji,jl) * jk )   &
+                        &    - MAX( zhice_old(ji,jl) * ( layer - 1 ) , zdummy(ji,jl) * ( jk - 1 ) ) , 0._wp )   &
+                        &    /( MAX(nlay_i * zthick0(ji,layer,jl),epsi10) ) * zindb
+                     ze_i_ac(ji,jk,jl) =  ze_i_ac(ji,jk,jl) + zweight * zqm0(ji,layer,jl)  
+                  END DO ! ji
+               END DO ! layer
+            END DO ! jk
+         END DO ! jl
+
+         DO jl = ice_cat_bounds(jm,1), ice_cat_bounds(jm,2)
+            DO jk = 1, nlay_i
+               DO ji = 1, nbpac
+                  zindb =  1._wp -  MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) ) 
+                  ze_i_ac(ji,jk,jl) = ze_i_ac(ji,jk,jl)   &
+                     &              / MAX( zv_i_ac(ji,jl) , epsi10) * za_i_ac(ji,jl) * nlay_i * zindb
+               END DO
+            END DO
+         END DO
+
+         !------------
+         ! Update age 
+         !------------
+         DO jl = 1, jpl
+            DO ji = 1, nbpac
+               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - za_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes
+               zoa_i_ac(ji,jl)  = za_old(ji,jl) * zoa_i_ac(ji,jl) / MAX( za_i_ac(ji,jl) , epsi10 ) * zindb   
+            END DO 
+         END DO   
+
+         !-----------------
+         ! Update salinity
+         !-----------------
+         IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN
+            DO jl = 1, jpl
+               DO ji = 1, nbpac
+                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - zv_i_ac(ji,jl) ) )  ! 0 if no ice and 1 if yes
+                  zdv   = zv_i_ac(ji,jl) - zv_old(ji,jl)
+                  zsmv_i_ac(ji,jl) = ( zsmv_i_ac(ji,jl) + zdv * zs_newice(ji) ) * zindb
+               END DO
+            END DO   
+         ENDIF
+
+         !------------------------------------------------------------------------------!
+         ! 8) Change 2D vectors to 1D vectors 
+         !------------------------------------------------------------------------------!
+         DO jl = 1, jpl
+            CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_ac (1:nbpac,jl), jpi, jpj )
+            CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_ac (1:nbpac,jl), jpi, jpj )
+            CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_ac(1:nbpac,jl), jpi, jpj )
+            IF (  num_sal == 2  .OR.  num_sal == 4  )   &
+               CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_ac(1:nbpac,jl) , jpi, jpj )
+            DO jk = 1, nlay_i
+               CALL tab_1d_2d( nbpac, e_i(:,:,jk,jl), npac(1:nbpac), ze_i_ac(1:nbpac,jk,jl), jpi, jpj )
+            END DO
+         END DO
+         CALL tab_1d_2d( nbpac, fseqv , npac(1:nbpac), fseqv_1d  (1:nbpac) , jpi, jpj )
+         !
+      ENDIF ! nbpac > 0
+
+      !------------------------------------------------------------------------------!
+      ! 9) Change units for e_i
+      !------------------------------------------------------------------------------!    
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i          ! heat content in 10^9 Joules
+            e_i(:,:,jk,jl) = e_i(:,:,jk,jl) * area(:,:) * v_i(:,:,jl) / nlay_i  / unit_fac 
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------------|
+      ! 10) Conservation check and changes in each ice category
+      !------------------------------------------------------------------------------|
+      IF( con_i ) THEN 
+         CALL lim_column_sum (jpl,   v_i, vt_i_final)
+         fieldid = 'v_i, limthd_lac'
+         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, limthd_lac'
+         CALL lim_cons_check (et_i_final, et_i_final, 1.0e-3, fieldid) 
+         !
+         CALL lim_column_sum (jpl,   v_s, vt_s_final)
+         fieldid = 'v_s, limthd_lac'
+         CALL lim_cons_check (vt_s_init, vt_s_final, 1.0e-6, fieldid) 
+         !
+         !     CALL lim_column_sum (jpl,   e_s(:,:,1,:) , et_s_init)
+         !     fieldid = 'e_s, limthd_lac'
+         !     CALL lim_cons_check (et_s_init, et_s_final, 1.0e-3, fieldid) 
+         IF( ln_nicep ) THEN
+            WRITE(numout,*) ' vt_i_init : ', vt_i_init(jiindx,jjindx)
+            WRITE(numout,*) ' vt_i_final: ', vt_i_final(jiindx,jjindx)
+            WRITE(numout,*) ' et_i_init : ', et_i_init(jiindx,jjindx)
+            WRITE(numout,*) ' et_i_final: ', et_i_final(jiindx,jjindx)
+         ENDIF
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpij, zcatac )   ! 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_ac, zat_i_lev, zdh_frazb, zvrel_ac, zqbgow, zdhex )
+      CALL wrk_dealloc( jpij,jpl, zhice_old, zdummy, zdhicbot, zv_old, za_old, za_i_ac, zv_i_ac, zoa_i_ac, zsmv_i_ac )
+      CALL wrk_dealloc( jpij,jkmax,jpl, ze_i_ac )
+      CALL wrk_dealloc( jpij,jkmax+1,jpl, zqm0, zthick0 )
+      CALL wrk_dealloc( jpi,jpj, vt_i_init, vt_i_final, vt_s_init, vt_s_final, et_i_init, et_i_final, et_s_init, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90	(revision 3437)
@@ -0,0 +1,280 @@
+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 par_ice          ! LIM parameters
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_thd_sal        ! called by limthd module
+   PUBLIC   lim_thd_sal_init   ! called by iceini module
+
+   !!----------------------------------------------------------------------
+   !! 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  :  4 possibilities
+      !!               -> num_sal = 1 -> constant salinity for z,t
+      !!               -> num_sal = 2 -> S = S(z,t) [simple Vancoppenolle et al 2005]
+      !!               -> num_sal = 3 -> S = S(z)   [multiyear ice]
+      !!               -> num_sal = 4 -> S = S(h)   [Cox and Weeks 74]
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::  kideb, kiut   ! thickness category index
+      !
+      INTEGER  ::   ji, jk     ! dummy loop indices 
+      INTEGER  ::   zji, zjj   ! local integers
+      REAL(wp) ::   zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch,  ztmelts   ! local scalars
+      REAL(wp) ::   zaaa, zbbb, zccc, zdiscrim   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:) ::   ze_init, zhiold, zsiold
+      !!---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, ze_init, zhiold, zsiold )
+
+      !------------------------------------------------------------------------------|
+      ! 1) Constant salinity, constant in time                                       |
+      !------------------------------------------------------------------------------|
+!!gm comment: if num_sal = 1 s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !!
+      IF( num_sal == 1 ) THEN
+         !
+         DO jk = 1, nlay_i
+            DO ji = kideb, kiut
+               s_i_b(ji,jk) =  bulk_sal
+            END DO ! ji
+         END DO ! jk
+         !
+         DO ji = kideb, kiut
+            sm_i_b(ji)      =  bulk_sal 
+         END DO ! ji
+         !
+      ENDIF
+
+      !------------------------------------------------------------------------------|
+      !  Module 2 : Constant salinity varying in time                                |
+      !------------------------------------------------------------------------------|
+
+      IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN
+
+         !---------------------------------
+         ! Thickness at previous time step
+         !---------------------------------
+         DO ji = kideb, kiut
+            zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji)
+         END DO
+
+         !---------------------
+         ! Global heat content
+         !---------------------
+         ze_init(:)  =  0._wp
+         DO jk = 1, nlay_i
+            DO ji = kideb, kiut
+               ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i
+            END DO
+         END DO
+
+         DO ji = kideb, kiut
+            !
+            ! Switches 
+            !----------
+            iflush       =         MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt )        )    ! =1 if summer 
+            igravdr      =         MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) )    ! =1 if t_su < t_bo
+            iaccrbo      =         MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) )           )    ! =1 if bottom accretion
+            i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) )
+            isnowic      = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch   ! =1 if snow ice formation
+
+            !---------------------
+            ! Salinity tendencies
+            !---------------------
+            !                                   ! drainage by gravity drainage
+            dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 
+            !                                   ! drainage by flushing  
+            dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice
+
+            !-----------------
+            ! Update salinity   
+            !-----------------
+            ! only drainage terms ( gravity drainage and flushing )
+            ! snow ice / bottom sources are added in lim_thd_ent to conserve energy
+            zsiold(ji) = sm_i_b(ji)
+            sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji)
+
+            ! if no ice, salinity = 0.1
+            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )
+            sm_i_b(ji)   = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )
+         END DO ! ji
+
+         ! Salinity profile
+         CALL lim_var_salprof1d( kideb, kiut )
+
+         !----------------------------
+         ! Heat flux - brine drainage
+         !----------------------------
+
+         DO ji = kideb, kiut
+!!gm useless
+            ! iflush  : 1 if summer 
+            iflush  =  MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ) ) 
+            ! igravdr : 1 if t_su lt t_bo
+            igravdr =  MAX( 0._wp , SIGN ( 1._wp , t_bo_b(ji) - t_su_b(ji) ) ) 
+            ! iaccrbo : 1 if bottom accretion
+            iaccrbo =  MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ) )
+!!gm end useless
+            !
+            fhbri_1d(ji) = 0._wp
+         END DO ! ji
+
+         !----------------------------
+         ! Salt flux - brine drainage
+         !----------------------------
+         DO ji = kideb, kiut
+            i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) )
+            fsbri_1d(ji) = fsbri_1d(ji) - i_ice_switch * rhoic * a_i_b(ji) * ht_i_b(ji)         &
+               &         * ( MAX(dsm_i_gd_1d(ji) + dsm_i_fl_1d(ji), sm_i_b(ji) - zsiold(ji) ) ) / rdt_ice
+            IF( num_sal == 4 ) fsbri_1d(ji) = 0._wp
+         END DO ! ji
+
+         ! Only necessary for conservation check since salinity is modified
+         !--------------------
+         ! Temperature update
+         !--------------------
+         DO jk = 1, nlay_i
+            DO ji = kideb, kiut
+               ztmelts    =  -tmut*s_i_b(ji,jk) + rtt
+               !Conversion q(S,T) -> T (second order equation)
+               zaaa         =  cpic
+               zbbb         =  ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus
+               zccc         =  lfus * ( ztmelts - rtt )
+               zdiscrim     =  SQRT(  MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp )  )
+               t_i_b(ji,jk) =  rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa )
+            END DO
+         END DO
+         !
+      ENDIF ! num_sal .EQ. 2
+
+      !------------------------------------------------------------------------------|
+      !  Module 3 : Profile of salinity, constant in time                            |
+      !------------------------------------------------------------------------------|
+
+      IF( num_sal == 3 )   CALL lim_var_salprof1d( kideb, kiut )
+
+      !------------------------------------------------------------------------------|
+      !  Module 4 : Constant salinity varying in time                                |
+      !------------------------------------------------------------------------------|
+
+      IF( num_sal == 5 ) THEN      ! Cox and Weeks, 1974
+         !
+         DO ji = kideb, kiut
+            zsold = sm_i_b(ji)
+            IF( ht_i_b(ji) < 0.4 ) THEN
+               sm_i_b(ji) = 14.24 - 19.39 * ht_i_b(ji) 
+            ELSE
+               sm_i_b(ji) =  7.88 - 1.59 * ht_i_b(ji)
+               sm_i_b(ji) = MIN( sm_i_b(ji) , zsold )  
+            ENDIF
+            IF( ht_i_b(ji) > 3.06918239 ) THEN 
+               sm_i_b(ji) = 3._wp
+            ENDIF
+            DO jk = 1, nlay_i
+               s_i_b(ji,jk)   = sm_i_b(ji)
+            END DO
+         END DO
+         !
+      ENDIF ! num_sal
+
+      !------------------------------------------------------------------------------|
+      ! 5) Computation of salt flux due to Bottom growth
+      !------------------------------------------------------------------------------|
+
+      IF ( num_sal == 4 ) THEN
+         DO ji = kideb, kiut
+            zji = MOD( npb(ji) - 1 , jpi ) + 1
+            zjj =    ( npb(ji) - 1 ) / jpi + 1
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal    )               &
+               &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
+         END DO
+      ELSE
+         DO ji = kideb, kiut
+            zji = MOD( npb(ji) - 1 , jpi ) + 1
+            zjj =    ( npb(ji) - 1 ) / jpi + 1
+            fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) )               &
+               &                        * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpij, ze_init, zhiold, zsiold )
+      !
+   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
+      !!-------------------------------------------------------------------
+      NAMELIST/namicesal/ num_sal, bulk_sal, sal_G, time_G, sal_F, time_F,   &
+         &                s_i_max, s_i_min, s_i_0, s_i_1
+      !!-------------------------------------------------------------------
+      !
+      REWIND( numnam_ice )                   ! Read Namelist namicesal
+      READ  ( numnam_ice  , namicesal )
+      !
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_thd_sal_init : Ice parameters for salinity '
+         WRITE(numout,*) '~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) ' switch for salinity num_sal        : ', num_sal
+         WRITE(numout,*) ' bulk salinity value if num_sal = 1 : ', bulk_sal
+         WRITE(numout,*) ' restoring salinity for GD          : ', sal_G
+         WRITE(numout,*) ' restoring time for GD              : ', time_G
+         WRITE(numout,*) ' restoring salinity for flushing    : ', sal_F
+         WRITE(numout,*) ' restoring time for flushing        : ', time_F
+         WRITE(numout,*) ' Maximum tolerated ice salinity     : ', s_i_max
+         WRITE(numout,*) ' Minimum tolerated ice salinity     : ', s_i_min
+         WRITE(numout,*) ' 1st salinity for salinity profile  : ', s_i_0
+         WRITE(numout,*) ' 2nd salinity for salinity profile  : ', s_i_1
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90	(revision 3437)
@@ -0,0 +1,474 @@
+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 par_ice         ! LIM-3 parameter
+   USE dom_ice         ! LIM-3 domain
+   USE ice             ! LIM-3 variables
+   USE limadv          ! LIM-3 advection
+   USE limhdf          ! LIM-3 horizontal diffusion
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_trp    ! called by ice_step
+
+   REAL(wp)  ::   epsi06 = 1.e-06_wp   ! constant values
+   REAL(wp)  ::   epsi03 = 1.e-03_wp  
+   REAL(wp)  ::   zeps10 = 1.e-10_wp  
+   REAL(wp)  ::   epsi16 = 1.e-16_wp
+   REAL(wp)  ::   rzero  = 0._wp   
+   REAL(wp)  ::   rone   = 1._wp
+
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) ::   zs0e
+
+   !! * 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, a second order Prather scheme is used.  
+      !!
+      !! ** action :
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! number of iteration
+      !
+      INTEGER  ::   ji, jj, jk, jl, layer   ! dummy loop indices
+      INTEGER  ::   initad                  ! number of sub-timestep for the advection
+      INTEGER  ::   ierr                    ! error status
+      REAL(wp) ::   zindb  , zindsn , zindic      ! local scalar
+      REAL(wp) ::   zusvosn, zusvoic, zbigval     !   -      -
+      REAL(wp) ::   zcfl , zusnit , zrtt          !   -      -
+      REAL(wp) ::   ze   , zsal   , zage          !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:)      ::   zui_u, zvi_v, zsm, zs0at, zs0ow
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)  ::   zs0e
+      !!---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )
+      CALL wrk_alloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
+      CALL wrk_alloc( jpi, jpj, jkmax, jpl, zs0e )
+
+      IF( numit == nstart .AND. lwp ) THEN
+         WRITE(numout,*)
+         IF( ln_limdyn ) THEN   ;   WRITE(numout,*) 'lim_trp : Ice transport '
+         ELSE                   ;   WRITE(numout,*) 'lim_trp : No ice advection as ln_limdyn = ', ln_limdyn
+         ENDIF
+         WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+      
+      zsm(:,:) = area(:,:)
+
+      !                             !-------------------------------------!
+      IF( ln_limdyn ) THEN          !   Advection of sea ice properties   !
+         !                          !-------------------------------------!
+         !
+
+         !-------------------------
+         ! transported fields                                        
+         !-------------------------
+         ! Snow vol, ice vol, salt and age contents, area
+         zs0ow(:,:) = ato_i(:,:) * area(:,:)               ! Open water area 
+         DO jl = 1, jpl
+            zs0sn (:,:,jl)   = v_s  (:,:,jl) * area(:,:)    ! Snow volume
+            zs0ice(:,:,jl)   = v_i  (:,:,jl) * area(:,:)    ! Ice  volume
+            zs0a  (:,:,jl)   = a_i  (:,:,jl) * area(:,:)    ! Ice area
+            zs0sm (:,:,jl)   = smv_i(:,:,jl) * area(:,:)    ! Salt content
+            zs0oi (:,:,jl)   = oa_i (:,:,jl) * area(:,:)    ! Age content
+            zs0c0 (:,:,jl)   = e_s  (:,:,1,jl)              ! Snow heat content
+            zs0e  (:,:,:,jl) = e_i  (:,:,:,jl)              ! Ice  heat content
+         END DO
+
+         !--------------------------
+         ! Advection of Ice fields  (Prather scheme)                                            
+         !--------------------------
+         ! If ice drift field is too fast, use an appropriate time step for advection.         
+         ! CFL test for stability
+         zcfl  =            MAXVAL( ABS( u_ice(:,:) ) * rdt_ice / e1u(:,:) )
+         zcfl  = MAX( zcfl, MAXVAL( ABS( v_ice(:,:) ) * rdt_ice / e2v(:,:) ) )
+         IF(lk_mpp )   CALL mpp_max( zcfl )
+!!gm more readability:
+!         IF( zcfl > 0.5 ) THEN   ;   initad = 2   ;   zusnit = 0.5_wp
+!         ELSE                    ;   initad = 1   ;   zusnit = 1.0_wp
+!         ENDIF
+!!gm end
+         initad = 1 + INT( MAX( rzero, SIGN( rone, zcfl-0.5 ) ) )
+         zusnit = 1.0 / REAL( initad ) 
+         IF( zcfl > 0.5 .AND. lwp )   &
+            WRITE(numout,*) 'lim_trp_2 : CFL violation at day ', nday, ', cfl = ', zcfl,   &
+               &                        ': the ice time stepping is split 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( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   &
+                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               DO jl = 1, jpl
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---     
+                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   & 
+                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  DO layer = 1, nlay_i                                                           !--- ice heat contents ---
+                     CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
+                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
+                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                     CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
+                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
+                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                  END DO
+               END DO
+            END DO
+         ELSE
+            DO jk = 1, initad
+               CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ow (:,:), sxopw(:,:),   &             !--- ice open water area
+                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ow (:,:), sxopw(:,:),   &
+                  &                                       sxxopw(:,:), syopw(:,:), syyopw(:,:), sxyopw(:,:)  )
+               DO jl = 1, jpl
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &    !--- ice volume  ---
+                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0ice(:,:,jl), sxice(:,:,jl),   &
+                     &                                       sxxice(:,:,jl), syice(:,:,jl), syyice(:,:,jl), sxyice(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &    !--- snow volume  ---
+                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sn (:,:,jl), sxsn (:,:,jl),   &
+                     &                                       sxxsn (:,:,jl), sysn (:,:,jl), syysn (:,:,jl), sxysn (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &    !--- ice salinity ---
+                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0sm (:,:,jl), sxsal(:,:,jl),   &
+                     &                                       sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl)  )
+
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &   !--- ice age      ---
+                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0oi (:,:,jl), sxage(:,:,jl),   &
+                     &                                       sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &   !--- ice concentrations ---
+                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0a  (:,:,jl), sxa  (:,:,jl),   &
+                     &                                       sxxa  (:,:,jl), sya  (:,:,jl), syya  (:,:,jl), sxya  (:,:,jl)  )
+                  CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &  !--- snow heat contents ---
+                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0c0 (:,:,jl), sxc0 (:,:,jl),   &
+                     &                                       sxxc0 (:,:,jl), syc0 (:,:,jl), syyc0 (:,:,jl), sxyc0 (:,:,jl)  )
+                  DO layer = 1, nlay_i                                                           !--- ice heat contents ---
+                     CALL lim_adv_y( zusnit, v_ice, rzero, zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
+                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
+                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                     CALL lim_adv_x( zusnit, u_ice, rone , zsm, zs0e(:,:,layer,jl), sxe (:,:,layer,jl),   & 
+                        &                                       sxxe(:,:,layer,jl), sye (:,:,layer,jl),   &
+                        &                                       syye(:,:,layer,jl), sxye(:,:,layer,jl) )
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         !-------------------------------------------
+         ! Recover the properties from their contents
+         !-------------------------------------------
+         zs0ow(:,:) = zs0ow(:,:) / area(:,:)
+         DO jl = 1, jpl
+            zs0ice(:,:,jl) = zs0ice(:,:,jl) / area(:,:)
+            zs0sn (:,:,jl) = zs0sn (:,:,jl) / area(:,:)
+            zs0sm (:,:,jl) = zs0sm (:,:,jl) / area(:,:)
+            zs0oi (:,:,jl) = zs0oi (:,:,jl) / area(:,:)
+            zs0a  (:,:,jl) = zs0a  (:,:,jl) / area(:,:)
+            zs0c0 (:,:,jl) = zs0c0 (:,:,jl) / area(:,:)
+            DO jk = 1, nlay_i
+               zs0e(:,:,jk,jl) = zs0e(:,:,jk,jl) / area(:,:)
+            END DO
+         END DO
+
+         !------------------------------------------------------------------------------!
+         ! 4) Diffusion of Ice fields                  
+         !------------------------------------------------------------------------------!
+
+         !--------------------------------
+         !  diffusion of open water area
+         !--------------------------------
+         zs0at(:,:) = zs0a(:,:,1)      ! total ice fraction
+         DO jl = 2, jpl
+            zs0at(:,:) = zs0at(:,:) + zs0a(:,:,jl)
+         END DO
+         !
+         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points
+         DO jj = 1, jpjm1                    ! NB: has not to be defined on jpj line and jpi row
+            DO ji = 1 , fs_jpim1   ! vector opt.
+               pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji  ,jj) ) ) )   &
+                  &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji+1,jj) ) ) ) * ahiu(ji,jj)
+               pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0at(ji,jj  ) ) ) )   &
+                  &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0at(ji,jj+1) ) ) ) * ahiv(ji,jj)
+            END DO
+         END DO
+         !
+         CALL lim_hdf( zs0ow (:,:) )   ! Diffusion
+
+         !------------------------------------
+         !  Diffusion of other ice variables
+         !------------------------------------
+         DO jl = 1, jpl
+         !                             ! Masked eddy diffusivity coefficient at ocean U- and V-points
+            DO jj = 1, jpjm1                 ! NB: has not to be defined on jpj line and jpi row
+               DO ji = 1 , fs_jpim1   ! vector opt.
+                  pahu(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji  ,jj,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji+1,jj,jl) ) ) ) * ahiu(ji,jj)
+                  pahv(ji,jj) = ( 1._wp - MAX( rzero, SIGN( rone, -zs0a(ji,jj  ,jl) ) ) )   &
+                     &        * ( 1._wp - MAX( rzero, SIGN( rone,- zs0a(ji,jj+1,jl) ) ) ) * ahiv(ji,jj)
+               END DO
+            END DO
+
+            CALL lim_hdf( zs0ice (:,:,jl) )
+            CALL lim_hdf( zs0sn  (:,:,jl) )
+            CALL lim_hdf( zs0sm  (:,:,jl) )
+            CALL lim_hdf( zs0oi  (:,:,jl) )
+            CALL lim_hdf( zs0a   (:,:,jl) )
+            CALL lim_hdf( zs0c0  (:,:,jl) )
+            DO jk = 1, nlay_i
+               CALL lim_hdf( zs0e (:,:,jk,jl) )
+            END DO
+         END DO
+
+         !-----------------------------------------
+         !  Remultiply everything by ice area
+         !-----------------------------------------
+         zs0ow(:,:) = MAX( rzero, zs0ow(:,:) * area(:,:) )
+         DO jl = 1, jpl
+            zs0ice(:,:,jl) = MAX( rzero, zs0ice(:,:,jl) * area(:,:) )    !!bug:  est-ce utile
+            zs0sn (:,:,jl) = MAX( rzero, zs0sn (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres
+            zs0sm (:,:,jl) = MAX( rzero, zs0sm (:,:,jl) * area(:,:) )    !!bug:  cf /area  juste apres
+            zs0oi (:,:,jl) = MAX( rzero, zs0oi (:,:,jl) * area(:,:) )
+            zs0a  (:,:,jl) = MAX( rzero, zs0a  (:,:,jl) * area(:,:) )    !! suppress both change le resultat
+            zs0c0 (:,:,jl) = MAX( rzero, zs0c0 (:,:,jl) * area(:,:) )
+            DO jk = 1, nlay_i
+               zs0e(:,:,jk,jl) = MAX( rzero, zs0e (:,:,jk,jl) * area(:,:) )
+            END DO ! jk
+         END DO ! jl
+
+         !------------------------------------------------------------------------------!
+         ! 5) Update and limit ice properties after transport                           
+         !------------------------------------------------------------------------------!
+
+         !--------------------------------------------------
+         ! 5.1) Recover mean values over the grid squares.
+         !--------------------------------------------------
+
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zs0e(ji,jj,jk,jl) = MAX( rzero, zs0e(ji,jj,jk,jl) / area(ji,jj) )
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zs0ow(ji,jj) = MAX( rzero, zs0ow (ji,jj) / area(ji,jj) )
+            END DO
+         END DO
+
+         zs0at(:,:) = 0._wp
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zs0sn (ji,jj,jl) = MAX( rzero, zs0sn (ji,jj,jl)/area(ji,jj) )
+                  zs0ice(ji,jj,jl) = MAX( rzero, zs0ice(ji,jj,jl)/area(ji,jj) )
+                  zs0sm (ji,jj,jl) = MAX( rzero, zs0sm (ji,jj,jl)/area(ji,jj) )
+                  zs0oi (ji,jj,jl) = MAX( rzero, zs0oi (ji,jj,jl)/area(ji,jj) )
+                  zs0a  (ji,jj,jl) = MAX( rzero, zs0a  (ji,jj,jl)/area(ji,jj) )
+                  zs0c0 (ji,jj,jl) = MAX( rzero, zs0c0 (ji,jj,jl)/area(ji,jj) )
+                  zs0at (ji,jj)    = zs0at(ji,jj) + zs0a(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+
+         !---------------------------------------------------------
+         ! 5.2) Snow thickness, Ice thickness, Ice concentrations
+         !---------------------------------------------------------
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindb        = MAX( 0._wp , SIGN( 1.0, zs0at(ji,jj) - zeps10) )
+               zs0ow(ji,jj) = ( 1._wp - zindb ) + zindb * MAX( zs0ow(ji,jj), 0._wp )
+               ato_i(ji,jj) = zs0ow(ji,jj)
+            END DO
+         END DO
+
+         DO jl = 1, jpl         ! Remove very small areas 
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zindb         = MAX( 0.0 , SIGN( 1.0, zs0a(ji,jj,jl) - zeps10) )
+                  !
+                  zs0a(ji,jj,jl) = zindb * MIN( zs0a(ji,jj,jl), 0.99 )
+                  v_s(ji,jj,jl)  = zindb * zs0sn (ji,jj,jl) 
+                  v_i(ji,jj,jl)  = zindb * zs0ice(ji,jj,jl)
+                  !
+                  zindsn         = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) )
+                  zindic         = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) )
+                  zindb          = MAX( zindsn, zindic )
+                  zs0a(ji,jj,jl) = zindb  * zs0a(ji,jj,jl) !ice concentration
+                  a_i (ji,jj,jl) = zs0a(ji,jj,jl)
+                  v_s (ji,jj,jl) = zindsn * v_s(ji,jj,jl)
+                  v_i (ji,jj,jl) = zindic * v_i(ji,jj,jl)
+               END DO
+            END DO
+         END DO
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zs0at(ji,jj) = SUM( zs0a(ji,jj,1:jpl) )
+            END DO
+         END DO
+
+         !----------------------
+         ! 5.3) Ice properties
+         !----------------------
+
+         zbigval = 1.d+13
+
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+
+                  ! Switches and dummy variables
+                  zusvosn         = 1.0/MAX( v_s(ji,jj,jl) , epsi16 )
+                  zusvoic         = 1.0/MAX( v_i(ji,jj,jl) , epsi16 )
+                  zrtt            = 173.15 * rone 
+                  zindsn          = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - zeps10 ) )
+                  zindic          = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) )
+                  zindb           = MAX( zindsn, zindic )
+
+                  ! Ice salinity and age
+                  zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj)  , &
+                     zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl)
+                  IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) & 
+                     smv_i(ji,jj,jl) = zindic*zsal + (1.0-zindic)*0.0
+
+                  zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / & 
+                     MAX( a_i(ji,jj,jl), epsi16 )  ), 0.0 ) * a_i(ji,jj,jl)
+                  oa_i (ji,jj,jl)  = zindic*zage 
+
+                  ! Snow heat content
+                  ze              =  MIN( MAX( 0.0, zs0c0(ji,jj,jl)*area(ji,jj) ), zbigval )
+                  e_s(ji,jj,1,jl) = zindsn * ze + (1.0 - zindsn) * 0.0      
+
+               END DO !ji
+            END DO !jj
+         END DO ! jl
+
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ! Ice heat content
+                     zindic          =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - zeps10 ) )
+                     ze              =  MIN( MAX( 0.0, zs0e(ji,jj,jk,jl)*area(ji,jj) ), zbigval )
+                     e_i(ji,jj,jk,jl) = zindic * ze    + ( 1.0 - zindic ) * 0.0
+                  END DO !ji
+               END DO ! jj
+            END DO ! jk
+         END DO ! jl
+
+      ENDIF
+
+      IF(ln_ctl) THEN   ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=area , clinfo1=' lim_trp  : cell area :')
+         CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_trp  : at_i      :')
+         CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_trp  : vt_i      :')
+         CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_trp  : vt_s      :')
+         DO jl = 1, jpl
+            CALL prt_ctl_info(' ')
+            CALL prt_ctl_info(' - Category : ', ivar1=jl)
+            CALL prt_ctl_info('   ~~~~~~~~~~')
+            CALL prt_ctl(tab2d_1=a_i   (:,:,jl)   , clinfo1= ' lim_trp  : a_i      : ')
+            CALL prt_ctl(tab2d_1=ht_i  (:,:,jl)   , clinfo1= ' lim_trp  : ht_i     : ')
+            CALL prt_ctl(tab2d_1=ht_s  (:,:,jl)   , clinfo1= ' lim_trp  : ht_s     : ')
+            CALL prt_ctl(tab2d_1=v_i   (:,:,jl)   , clinfo1= ' lim_trp  : v_i      : ')
+            CALL prt_ctl(tab2d_1=v_s   (:,:,jl)   , clinfo1= ' lim_trp  : v_s      : ')
+            CALL prt_ctl(tab2d_1=e_s   (:,:,1,jl) , clinfo1= ' lim_trp  : e_s      : ')
+            CALL prt_ctl(tab2d_1=t_su  (:,:,jl)   , clinfo1= ' lim_trp  : t_su     : ')
+            CALL prt_ctl(tab2d_1=t_s   (:,:,1,jl) , clinfo1= ' lim_trp  : t_snow   : ')
+            CALL prt_ctl(tab2d_1=sm_i  (:,:,jl)   , clinfo1= ' lim_trp  : sm_i     : ')
+            CALL prt_ctl(tab2d_1=smv_i (:,:,jl)   , clinfo1= ' lim_trp  : smv_i    : ')
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' ')
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl_info('   ~~~~~~~')
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_trp  : t_i      : ')
+               CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_trp  : e_i      : ')
+            END DO
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zui_u, zvi_v, zsm, zs0at, zs0ow )
+      CALL wrk_dealloc( jpi, jpj, jpl, zs0ice, zs0sn, zs0a, zs0c0 , zs0sm , zs0oi )
+      CALL wrk_dealloc( jpi, jpj, jkmax, jpl, zs0e )
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limupdate.F90	(revision 3437)
@@ -0,0 +1,1047 @@
+MODULE limupdate
+   !!======================================================================
+   !!                     ***  MODULE  limupdate  ***
+   !!   LIM-3 : Update of sea-ice global variables at the end of the time step
+   !!======================================================================
+   !! History :  3.0  !  2006-04  (M. Vancoppenolle) Original code
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!    lim_update   : computes update of sea-ice global variables from trend terms
+   !!----------------------------------------------------------------------
+   USE limrhg          ! ice rheology
+
+   USE dom_oce
+   USE oce             ! dynamics and tracers variables
+   USE in_out_manager
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice fields
+   USE dom_ice
+   USE phycst          ! physical constants
+   USE ice
+   USE limdyn
+   USE limtrp
+   USE limthd
+   USE limsbc
+   USE limdia
+   USE limwri
+   USE limrst
+   USE thd_ice         ! LIM thermodynamic sea-ice variables
+   USE par_ice
+   USE limitd_th
+   USE limvar
+   USE prtctl           ! Print control
+   USE lbclnk           ! lateral boundary condition - MPP exchanges
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   lim_update   ! routine called by ice_step
+
+      REAL(wp)  ::   epsi06 = 1.e-06_wp   ! module constants
+      REAL(wp)  ::   epsi04 = 1.e-04_wp   !    -       -
+      REAL(wp)  ::   epsi03 = 1.e-03_wp   !    -       -
+      REAL(wp)  ::   epsi10 = 1.e-10_wp   !    -       -
+      REAL(wp)  ::   epsi16 = 1.e-16_wp   !    -       -
+      REAL(wp)  ::   epsi20 = 1.e-20_wp   !    -       -
+      REAL(wp)  ::   rzero  = 0._wp       !    -       -
+      REAL(wp)  ::   rone   = 1._wp       !    -       -
+         
+   !! * 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_update
+      !!-------------------------------------------------------------------
+      !!               ***  ROUTINE lim_update  ***
+      !!               
+      !! ** Purpose :  Computes update of sea-ice global variables at 
+      !!               the end of the time step.
+      !!               Address pathological cases
+      !!               This place is very important
+      !!                
+      !! ** Method  :  
+      !!    Ice speed from ice dynamics
+      !!    Ice thickness, Snow thickness, Temperatures, Lead fraction
+      !!      from advection and ice thermodynamics 
+      !!
+      !! ** Action  : - 
+      !!---------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk, jl, jm    ! dummy loop indices
+      INTEGER ::   jbnd1, jbnd2
+      INTEGER ::   i_ice_switch
+      INTEGER ::   ind_im, layer      ! indices for internal melt
+      REAL(wp) ::   zweight, zesum, zhimax, z_da_i, z_dv_i
+      REAL(wp) ::   zindb, zindsn, zindic, zacrith
+      REAL(wp) ::   zrtt, zindg, zh, zdvres, zviold
+      REAL(wp) ::   zbigvalue, zvsold, z_da_ex, zamax
+      REAL(wp) ::   z_prescr_hi, zat_i_old, ztmelts, ze_s
+
+      INTEGER , POINTER, DIMENSION(:,:,:) ::  internal_melt
+      REAL(wp), POINTER, DIMENSION(:) ::   zthick0, zqm0      ! thickness of the layers and heat contents for
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpl, internal_melt )   ! integer
+      CALL wrk_alloc( jkmax, zthick0, zqm0 )
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' lim_update '
+         WRITE(numout,*) ' ~~~~~~~~~~ '
+
+         WRITE(numout,*) ' O) Initial values '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      !------------------------------------------------------------------------------
+      ! 1. Update of Global variables                                               |
+      !------------------------------------------------------------------------------
+
+      !---------------------
+      ! Ice dynamics  
+      !---------------------
+      u_ice(:,:) = u_ice(:,:) + d_u_ice_dyn(:,:)
+      v_ice(:,:) = v_ice(:,:) + d_v_ice_dyn(:,:)
+
+      !-----------------------------
+      ! Update ice and snow volumes  
+      !-----------------------------
+      DO jl = 1, jpl
+         v_i(:,:,jl)  = v_i(:,:,jl) + d_v_i_trp(:,:,jl) + d_v_i_thd(:,:,jl) 
+         v_s(:,:,jl)  = v_s(:,:,jl) + d_v_s_trp(:,:,jl) + d_v_s_thd(:,:,jl)
+      END DO
+
+      !---------------------------------
+      ! Classify the pathological cases
+      !---------------------------------
+      ! (1) v_i (new) > 0; d_v_i_thd + v_i(old) > 0 (easy case)
+      ! (2) v_i (new) > 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation)
+      ! (3) v_i (new) < 0; d_v_i_thd + v_i(old) > 0 (combined total ablation)
+      ! (4) v_i (new) < 0; d_v_i_thd + v_i(old) = 0 (total thermodynamic ablation 
+      ! with negative advection, very pathological )
+      ! (5) v_i (old) = 0; d_v_i_trp > 0 (advection of ice in a free-cell)
+      !
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               patho_case(ji,jj,jl) = 1
+               IF( v_i(ji,jj,jl) .GE. 0.0 ) THEN
+                  IF ( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN 
+                     patho_case(ji,jj,jl) = 2
+                  ENDIF
+               ELSE
+                  patho_case(ji,jj,jl) = 3
+                  IF( old_v_i(ji,jj,jl) + d_v_i_thd(ji,jj,jl) .LT. epsi10 ) THEN 
+                     patho_case(ji,jj,jl) = 4
+                  ENDIF
+               ENDIF
+               IF( ( old_v_i(ji,jj,jl) .LE. epsi10 ) .AND. &
+                   ( d_v_i_trp(ji,jj,jl) .GT. epsi06 ) ) THEN
+                  patho_case(ji,jj,jl) = 5 ! advection of ice in an ice-free
+                  ! cell
+                  IF( ln_nicep ) THEN  
+                     WRITE(numout,*) ' ALERTE patho_case still equal to 5 '
+                     WRITE(numout,*) ' ji , jj   : ', ji, jj
+                     WRITE(numout,*) ' old_v_i   : ', old_v_i(ji,jj,jl)
+                     WRITE(numout,*) ' d_v_i_trp : ', d_v_i_trp(ji,jj,jl)
+                  ENDIF
+
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      !--------------------
+      ! Excessive ablation 
+      !--------------------
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (      ( patho_case(ji,jj,jl) .EQ. 3 ) &
+                  .OR. ( patho_case(ji,jj,jl) .EQ. 4 ) ) THEN
+                  zviold         = old_v_i(ji,jj,jl)
+                  zvsold         = old_v_s(ji,jj,jl)
+                  ! in cases 3 ( combined total ablation )
+                  !      and 4 ( total ablation with negative advection )
+                  ! there is excessive total ablation
+                  ! advection is chosen to be prioritary in order to conserve mass. 
+                  ! dv_i_thd is computed as a residual
+                  ! negative energy has to be kept in memory and to be given to the ocean
+                  ! equivalent salt flux is given to the ocean
+                  !
+                  ! This was the best solution found. Otherwise, mass conservation in advection
+                  ! scheme should have been revised, which could have been a big problem
+                  ! Martin Vancoppenolle (2006, updated 2007)
+
+                  ! is there any ice left ?
+                  zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi10 ) ) 
+                  !=1 if hi > 1e-3 and 0 if not
+                  zdvres        = MAX(0.0,-v_i(ji,jj,jl)) !residual volume if too much ice was molten
+                  !this quantity is positive
+                  v_i(ji,jj,jl) = zindic*v_i(ji,jj,jl)    !ice volume cannot be negative
+                  !correct thermodynamic ablation
+                  d_v_i_thd(ji,jj,jl)  = zindic  *  d_v_i_thd(ji,jj,jl) + (1.0-zindic) * (-zviold - d_v_i_trp(ji,jj,jl)) 
+                  ! THIS IS NEW
+                  d_a_i_thd(ji,jj,jl)  = zindic  *  d_a_i_thd(ji,jj,jl) + & 
+                     (1.0-zindic) * (-old_a_i(ji,jj,jl)) 
+
+                  !residual salt flux if ice is over-molten
+                  fsalt_res(ji,jj)  = fsalt_res(ji,jj) + ( sss_m(ji,jj) - sm_i(ji,jj,jl) ) * & 
+                     ( rhoic * zdvres / rdt_ice )
+                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhoic * lfus * zdvres / rdt_ice
+
+                  ! is there any snow left ?
+                  zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi10 ) ) 
+                  zvsold        = v_s(ji,jj,jl)
+                  zdvres        = MAX(0.0,-v_s(ji,jj,jl)) !residual volume if too much ice was molten
+                  !this quantity is positive
+                  v_s(ji,jj,jl) = zindsn*v_s(ji,jj,jl)    !snow volume cannot be negative
+                  !correct thermodynamic ablation
+                  d_v_s_thd(ji,jj,jl)  = zindsn  *  d_v_s_thd(ji,jj,jl) + & 
+                     (1.0-zindsn) * (-zvsold - d_v_s_trp(ji,jj,jl)) 
+                  !unsure correction on salt flux.... maybe future will tell it was not that right
+
+                  !residual salt flux if snow is over-molten
+                  fsalt_res(ji,jj)  = fsalt_res(ji,jj) + sss_m(ji,jj) * ( rhosn * zdvres / rdt_ice )
+                  !this flux will be positive if snow was over-molten
+                  !             fheat_res(ji,jj)  = fheat_res(ji,jj) + rhosn * lfus * zdvres / rdt_ice
+               ENDIF
+            END DO !ji
+         END DO !jj
+      END DO !jl
+
+      IF( ln_nicep ) THEN  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(fsalt_res(ji,jj)) .GT. 1.0 ) THEN 
+                  WRITE(numout,*) ' ALERTE 1000 : residual salt flux of -> ', &
+                     fsalt_res(ji,jj)
+                  WRITE(numout,*) ' ji, jj : ', ji, jj, ' gphit, glamt : ', &
+                     gphit(ji,jj), glamt(ji,jj)
+               ENDIF
+            END DO
+         END DO
+
+         WRITE(numout,*) ' 1. Before update of Global variables '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      !---------------------------------------------
+      ! Ice concentration and ice heat content
+      !---------------------------------------------
+
+      a_i (:,:,:) = a_i (:,:,:) + d_a_i_trp(:,:,:) + d_a_i_thd(:,:,:)
+      CALL lim_var_glo2eqv    ! useless, just for debug
+      IF( ln_nicep ) THEN 
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_trp(:,:,:,:)  
+      CALL lim_var_glo2eqv    ! useless, just for debug
+      IF( ln_nicep) THEN
+         WRITE(numout,*) ' After transport update '
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+      e_i(:,:,:,:) = e_i(:,:,:,:) + d_e_i_thd(:,:,:,:)  
+      CALL lim_var_glo2eqv ! useless, just for debug
+      IF( ln_nicep ) THEN
+         WRITE(numout,*) ' After thermodyn update '
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 1. After update of Global variables (2) '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' oa_i : ', oa_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' e_s : ', e_s(jiindx, jjindx, 1, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      !------------------------------
+      ! Snow temperature and ice age
+      !------------------------------
+      e_s (:,:,:,:) = e_s (:,:,:,:) + d_e_s_trp (:,:,:,:) + d_e_s_thd (:,:,:,:)
+      oa_i(:,:,:)   = oa_i(:,:,:)   + d_oa_i_trp(:,:,:)   + d_oa_i_thd(:,:,:)
+
+      !--------------
+      ! Ice salinity    
+      !--------------
+
+      IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN      ! general case
+         !
+         IF( ln_nicep ) THEN  
+            WRITE(numout,*) ' Before everything '
+            WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+            WRITE(numout,*) ' oa_i:  ', oa_i(jiindx, jjindx, 1:jpl)
+            DO jk = 1, nlay_i
+               WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+            END DO
+            WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         ENDIF
+
+         smv_i(:,:,:) = smv_i(:,:,:) + d_smv_i_thd(:,:,:) + d_smv_i_trp(:,:,:)
+         !
+         IF( ln_nicep ) THEN  
+            WRITE(numout,*) ' After advection   '
+            WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+            WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         ENDIF
+         !
+      ENDIF
+
+      CALL lim_var_glo2eqv
+
+      !--------------------------------------
+      ! 2. Review of all pathological cases
+      !--------------------------------------
+      zrtt    = 173.15_wp * rone
+      zacrith = 1.e-6_wp
+
+      !-------------------------------------------
+      ! 2.1) Advection of ice in an ice-free cell
+      !-------------------------------------------
+      ! should be removed since it is treated after dynamics now
+
+      zhimax = 5._wp
+      ! first category
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            !--- the thickness of such an ice is often out of bounds
+            !--- thus we recompute a new area while conserving ice volume
+            zat_i_old = SUM(old_a_i(ji,jj,:))
+            zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,1)) - epsi10 ) ) 
+            IF (      ( ABS(d_v_i_trp(ji,jj,1))/MAX(ABS(d_a_i_trp(ji,jj,1)),epsi10)*zindb.GT.zhimax) &
+               .AND.( ( v_i(ji,jj,1)/MAX(a_i(ji,jj,1),epsi10)*zindb).GT.zhimax ) &
+               .AND.( zat_i_old.LT.zacrith ) )  THEN ! new line
+               z_prescr_hi      = hi_max(1) / 2.0
+               a_i(ji,jj,1)     = v_i(ji,jj,1) / z_prescr_hi
+            ENDIF
+         END DO
+      END DO
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.1 '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      !change this 14h44
+      zhimax = 20.0     ! line added up
+      ! change this also 17 aug
+      zhimax = 30.0     ! line added up
+
+      DO jl = 2, jpl
+         jm = ice_types(jl)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindb          =  MAX( rzero, SIGN( rone, ABS(d_a_i_trp(ji,jj,jl)) - epsi10 ) ) 
+               ! this correction is very tricky... sometimes, advection gets wrong i don't know why
+               ! it makes problems when the advected volume and concentration do not seem to be 
+               ! related with each other
+               ! the new thickness is sometimes very big!
+               ! and sometimes d_a_i_trp and d_v_i_trp have different sign
+               ! which of course is plausible
+               ! but fuck! it fucks everything up :)
+               IF ( (ABS(d_v_i_trp(ji,jj,jl))/MAX(ABS(d_a_i_trp(ji,jj,jl)),epsi10)*zindb.GT.zhimax) &
+                  .AND.(v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi10)*zindb).GT.zhimax ) THEN
+                  z_prescr_hi  =  ( hi_max_typ(jl-ice_cat_bounds(jm,1)  ,jm) + &
+                     hi_max_typ(jl-ice_cat_bounds(jm,1)+1,jm) ) / 2.0
+                  a_i (ji,jj,jl) = v_i(ji,jj,jl) / z_prescr_hi
+                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+               ENDIF
+               zat_i_old = SUM(old_a_i(ji,jj,:))
+
+            END DO ! ji
+         END DO !jj
+      END DO !jl
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.1 initial '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+      ENDIF
+
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      !----------------------------------------------------
+      ! 2.2) Rebin categories with thickness out of bounds
+      !----------------------------------------------------
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.1 before rebinning '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      DO jm = 1, jpm
+         jbnd1 = ice_cat_bounds(jm,1)
+         jbnd2 = ice_cat_bounds(jm,2)
+         IF (ice_ncat_types(jm) .GT. 1 )   CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
+      END DO
+
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.1 after rebinning'
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      at_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      !---------------------------------
+      ! 2.3) Melt of an internal layer
+      !---------------------------------
+      internal_melt(:,:,:) = 0
+
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt
+                  IF ( ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR. &
+                     ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) .AND. &
+                     ( v_i(ji,jj,jl) .GT. 0.0 ) .AND. &
+                     ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN
+                     !                    WRITE(numout,*) ' Internal layer melt : '
+                     !                    WRITE(numout,*) ' ji, jj, jk, jl : ', ji,jj,jk,jl
+                     !                    WRITE(numout,*) ' e_i : ', e_i(ji,jj,jk,jl)
+                     !                    WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl)
+                     internal_melt(ji,jj,jl) = 1
+                  ENDIF
+               END DO ! ji
+            END DO ! jj
+         END DO !jk
+      END DO !jl
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               IF( internal_melt(ji,jj,jl) == 1 ) THEN
+                  ! initial ice thickness
+                  !-----------------------
+                  ht_i(ji,jj,jl) = v_i(ji,jj,jl) / a_i(ji,jj,jl)
+                  !             WRITE(numout,*) ' ji,jj,jl : ', ji,jj,jl
+                  !             WRITE(numout,*) ' old ht_i: ', ht_i(ji,jj,jl)
+                  !             WRITE(numout,*) ' Enthalpy at the beg : ', e_i(ji,jj,1:nlay_i,jl)
+                  !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl)
+
+                  ! reduce ice thickness
+                  !-----------------------
+                  ind_im = 0
+                  zesum = 0.0
+                  DO jk = 1, nlay_i
+                     ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt
+                     IF ( ( e_i(ji,jj,jk,jl) .LE. 0.0 ) .OR.  & 
+                        ( t_i(ji,jj,jk,jl) .GE. ztmelts ) ) &
+                        ind_im = ind_im + 1
+                     zesum = zesum + e_i(ji,jj,jk,jl)
+                  END DO
+                  IF (ind_im .LT.nlay_i ) smv_i(ji,jj,jl)= smv_i(ji,jj,jl) / ht_i(ji,jj,jl) * & 
+                     ( ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i )
+                  ht_i(ji,jj,jl) = ht_i(ji,jj,jl) - ind_im*ht_i(ji,jj,jl) / nlay_i
+                  v_i(ji,jj,jl)  = ht_i(ji,jj,jl) * a_i(ji,jj,jl)
+
+                  !             WRITE(numout,*) ' ind_im  : ', ind_im
+                  !             WRITE(numout,*) ' new ht_i: ', ht_i(ji,jj,jl)
+                  !             WRITE(numout,*) ' smv_i   : ', smv_i(ji,jj,jl)
+                  !             WRITE(numout,*) ' zesum   : ', zesum
+
+                  ! redistribute heat
+                  !-----------------------
+                  ! old thicknesses and enthalpies
+                  ind_im = 0
+                  DO jk = 1, nlay_i
+                     ztmelts = - tmut * s_i(ji,jj,jk,jl) + rtt
+                     IF ( ( e_i(ji,jj,jk,jl) .GT. 0.0 ) .AND.  & 
+                        ( t_i(ji,jj,jk,jl) .LT. ztmelts ) ) THEN
+                        ind_im = ind_im + 1
+                        zthick0(ind_im) = ht_i(ji,jj,jl) * ind_im / nlay_i
+                        zqm0   (ind_im) = MAX( e_i(ji,jj,jk,jl) , 0.0 )
+                     ENDIF
+                  END DO
+
+                  !             WRITE(numout,*) ' Old thickness, enthalpy '
+                  !             WRITE(numout,*) ' Number of layer : ind_im ', ind_im
+                  !             WRITE(numout,*) ' zthick0 : ', zthick0(1:ind_im)
+                  !             WRITE(numout,*) ' zqm0    : ', zqm0(1:ind_im)
+
+                  ! Redistributing energy on the new grid
+                  IF ( ind_im .GT. 0 ) THEN
+
+                     DO jk = 1, nlay_i
+                        e_i(ji,jj,jk,jl) = 0.0
+                        DO layer = 1, ind_im
+                           zweight         = MAX (  &
+                              MIN( ht_i(ji,jj,jl) * layer / ind_im , ht_i(ji,jj,jl) * jk / nlay_i ) -       &
+                              MAX( ht_i(ji,jj,jl) * (layer-1) / ind_im , ht_i(ji,jj,jl) * (jk-1) / nlay_i ) , 0.0 ) &
+                              /  ( ht_i(ji,jj,jl) / ind_im )
+
+                           e_i(ji,jj,jk,jl) =  e_i(ji,jj,jk,jl) + zweight*zqm0(layer)
+                        END DO !layer
+                     END DO ! jk
+
+                     zesum = 0.0
+                     DO jk = 1, nlay_i
+                        zesum = zesum + e_i(ji,jj,jk,jl)
+                     END DO
+
+                     !             WRITE(numout,*) ' Enthalpy at the end : ', e_i(ji,jj,1:nlay_i,jl)
+                     !             WRITE(numout,*) ' Volume   at the end : ', v_i(ji,jj,jl)
+                     !             WRITE(numout,*) ' zesum : ', zesum
+
+                  ELSE ! ind_im .EQ. 0, total melt
+                     e_i(ji,jj,jk,jl) = 0.0
+                  ENDIF
+
+               ENDIF ! internal_melt
+
+            END DO ! ji
+         END DO !jj
+      END DO !jl
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.3 after melt of an internal ice layer '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+            WRITE(numout,*) ' t_i : ', t_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      internal_melt(:,:,:) = 0
+
+      ! Melt of snow
+      !--------------
+      DO jl = 1, jpl
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               ! snow energy of melting
+               ze_s = e_s(ji,jj,1,jl) * unit_fac / area(ji,jj) /              &
+                  MAX( v_s(ji,jj,jl), 1.0e-6 )  ! snow energy of melting
+
+               ! If snow energy of melting smaller then Lf
+               ! Then all snow melts and meltwater, heat go to the ocean
+               IF ( ze_s .LE. rhosn * lfus ) internal_melt(ji,jj,jl) = 1
+
+               IF( ln_nicep ) THEN  
+                  IF ( (ji.eq.jiindx) .AND. (jj.eq.jjindx) ) THEN
+                     WRITE(numout,*) ' jl    : ', jl
+                     WRITE(numout,*) ' ze_s  : ', ze_s
+                     WRITE(numout,*) ' v_s   : ', v_s(ji,jj,jl)
+                     WRITE(numout,*) ' rhosn : ', rhosn
+                     WRITE(numout,*) ' rhosn : ', lfus 
+                     WRITE(numout,*) ' area  : ', area(ji,jj)
+                     WRITE(numout,*) ' rhosn * lfus : ', rhosn * lfus 
+                     WRITE(numout,*) ' internal_melt : ', internal_melt(ji,jj,jl)
+                  ENDIF
+               ENDIF
+
+            END DO
+         END DO
+      END DO
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               IF ( internal_melt(ji,jj,jl) == 1 ) THEN
+                  v_s(ji,jj,jl)   = 0.0
+                  e_s(ji,jj,1,jl) = 0.0
+                  !   ! release heat
+                  fheat_res(ji,jj) = fheat_res(ji,jj)  &
+                     + ze_s * v_s(ji,jj,jl) / rdt_ice
+                  ! release mass
+                  rdmsnif(ji,jj) =  rdmsnif(ji,jj) + rhosn * v_s(ji,jj,jl)
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      zbigvalue      = 1.0d+20
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+
+               !switches
+               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) ) 
+               !switch = 1 if a_i > 1e-06 and 0 if not
+               zindsn        = MAX( rzero, SIGN( rone, v_s(ji,jj,jl) - epsi06 ) ) !=1 if hs > 1e-6 and 0 if not
+               zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi04 ) ) !=1 if hi > 1e-3 and 0 if not
+               ! bug fix 25 avril 2007
+               zindb         = zindb*zindic
+
+               !--- 2.3 Correction to ice age 
+               !------------------------------
+               !                IF ((o_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*float(numit))) THEN
+               !                   o_i(ji,jj,jl) = rdt_ice*FLOAT(numit)/86400.0
+               !                ENDIF
+               IF ((oa_i(ji,jj,jl)-1.0)*86400.0.gt.(rdt_ice*numit*a_i(ji,jj,jl))) THEN
+                  oa_i(ji,jj,jl) = rdt_ice*numit/86400.0*a_i(ji,jj,jl)
+               ENDIF
+               oa_i(ji,jj,jl) = zindb*zindic*oa_i(ji,jj,jl)
+
+               !--- 2.4 Correction to snow thickness
+               !-------------------------------------
+               !          ! snow thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hs = 0
+               !             v_s(ji,jj,jl)  = MAX( zindb * v_s(ji,jj,jl), 0.0) 
+               ! snow thickness cannot be smaller than 1e-6
+               v_s(ji,jj,jl)  = zindsn*v_s(ji,jj,jl)*zindb
+               v_s(ji,jj,jl)  = v_s(ji,jj,jl) *  MAX( 0.0 , SIGN( 1.0 , v_s(ji,jj,jl) - epsi06 ) )
+
+               !--- 2.5 Correction to ice thickness
+               !-------------------------------------
+               ! ice thickness has to be greater than 0, and if ice concentration smaller than 1e-6 then hi = 0
+               v_i(ji,jj,jl) = MAX( zindb * v_i(ji,jj,jl), 0.0)
+               ! ice thickness cannot be smaller than 1e-3
+               v_i(ji,jj,jl)  = zindic*v_i(ji,jj,jl)
+
+               !--- 2.6 Snow is transformed into ice if the original ice cover disappears
+               !----------------------------------------------------------------------------
+               zindg          = tms(ji,jj) *  MAX( rzero , SIGN( rone , -v_i(ji,jj,jl) ) )
+               v_i(ji,jj,jl)  = v_i(ji,jj,jl) + zindg * rhosn * v_s(ji,jj,jl) / rau0
+               v_s(ji,jj,jl)  = ( rone - zindg ) * v_s(ji,jj,jl) + & 
+                  zindg * v_i(ji,jj,jl) * ( rau0 - rhoic ) / rhosn
+
+               !--- 2.7 Correction to ice concentrations 
+               !--------------------------------------------
+               ! if greater than 0, ice concentration cannot be smaller than 1e-10
+               a_i(ji,jj,jl) = zindb * MAX(zindsn, zindic) * MAX( a_i(ji,jj,jl), epsi06 )
+               ! then ice volume has to be corrected too...
+               ! instead, zap small areas
+
+               !-------------------------
+               ! 2.8) Snow heat content
+               !-------------------------
+
+               e_s(ji,jj,1,jl) = zindsn *                                &
+                  ( MIN ( MAX ( 0.0, e_s(ji,jj,1,jl) ), zbigvalue ) ) + &
+                  ( 1.0 - zindsn ) * 0.0
+
+            END DO ! ji
+         END DO ! jj
+      END DO ! jl
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.8 '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i: ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      !------------------------
+      ! 2.9) Ice heat content 
+      !------------------------
+
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj 
+               DO ji = 1, jpi
+                  zindic        = MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi06 ) ) 
+                  ! =1 if v_i > 1e-6 and 0 if not
+                  e_i(ji,jj,jk,jl)= zindic * & 
+                     ( MIN ( MAX ( 0.0, e_i(ji,jj,jk,jl) ), zbigvalue ) ) + &
+                     ( 1.0 - zindic ) * 0.0
+               END DO ! ji
+            END DO ! jj
+         END DO !jk
+      END DO !jl
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.9 '
+         DO jk = 1, nlay_i
+            WRITE(numout,*) ' e_i : ', e_i(jiindx, jjindx, jk, 1:jpl)
+         END DO
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      !---------------------
+      ! 2.11) Ice salinity
+      !---------------------
+
+      IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN ! general case
+
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj 
+                  DO ji = 1, jpi
+                     ! salinity stays in bounds
+                     smv_i(ji,jj,jl)  =  MAX(MIN((rhoic-rhosn)/rhoic*sss_m(ji,jj),smv_i(ji,jj,jl)), &
+                        0.1 * v_i(ji,jj,jl) )
+                     i_ice_switch    =  1.0-MAX(0.0,SIGN(1.0,-v_i(ji,jj,jl)))
+                     smv_i(ji,jj,jl)  = i_ice_switch*smv_i(ji,jj,jl) + &
+                        0.1*(1.0-i_ice_switch)*v_i(ji,jj,jl)
+                  END DO ! ji
+               END DO ! jj
+            END DO !jk
+         END DO !jl
+
+      ENDIF
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.11 '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      DO jm = 1, jpm
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+               jl = ice_cat_bounds(jm,1)
+               !--- 2.12 Constrain the thickness of the smallest category above 5 cm
+               !----------------------------------------------------------------------
+               ! the ice thickness of the smallest category should be higher than 5 cm
+               ! we changed hiclim to 10
+               zindb         = MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) ) 
+               ht_i(ji,jj,jl) = zindb*v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl), epsi06)
+               zh            = MAX( rone , zindb * hiclim  / MAX( ht_i(ji,jj,jl) , epsi20 ) )
+               ht_s(ji,jj,jl) = ht_s(ji,jj,jl)* zh
+               !             v_s(ji,jj,jl)  = v_s(ji,jj,jl) * zh
+               ht_i(ji,jj,jl) = ht_i(ji,jj,jl)* zh
+               !             v_i(ji,jj,jl)  = v_i(ji,jj,jl) * zh
+               a_i (ji,jj,jl) = a_i(ji,jj,jl) /zh
+            END DO !ji
+         END DO !jj
+      END DO !jm
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.12 '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      !--- 2.13 Total ice concentration should not exceed 1
+      !-----------------------------------------------------
+      zamax = amax
+      ! 2.13.1) individual concentrations cannot exceed zamax
+      !------------------------------------------------------
+
+      at_i(:,:) = 0.0
+      DO jl = 1, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      ! 2.13.2) Total ice concentration cannot exceed zamax
+      !----------------------------------------------------
+      at_i(:,:) = a_i(:,:,1)
+      DO jl = 2, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+            ! 0) Excessive area ?
+            z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )        
+
+            ! 1) Count the number of existing categories
+            DO jl  = 1, jpl
+               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) - epsi03 ) ) 
+               zindb   =  MAX( rzero, SIGN( rone, v_i(ji,jj,jl) ) ) 
+               z_da_i = a_i(ji,jj,jl) * z_da_ex / MAX( at_i(ji,jj), epsi06 ) * zindb
+               z_dv_i = v_i(ji,jj,jl) * z_da_i  / MAX( at_i(ji,jj), epsi06 )
+               a_i(ji,jj,jl) = a_i(ji,jj,jl) - z_da_i
+               v_i(ji,jj,jl) = v_i(ji,jj,jl) + z_dv_i
+            END DO
+
+         END DO !ji
+      END DO !jj
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' 2.13 '
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl), ' at_i    ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl), ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      at_i(:,:) = a_i(:,:,1)
+      DO jl = 2, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      IF( ln_nicep ) THEN  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF (at_i(ji,jj).GT.1.0) THEN
+                  WRITE(numout,*) ' lim_update ! : at_i > 1 -> PAS BIEN -> ALERTE '
+                  WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj)
+                  WRITE(numout,*) ' Point ', ji, jj
+                  WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+                  DO jl = 1, jpl
+                     WRITE(numout,*) ' a_i ***         ', a_i(ji,jj,jl), ' CAT no ', jl
+                     WRITE(numout,*) ' a_i_old ***     ', old_a_i(ji,jj,jl), ' CAT no ', jl
+                     WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
+                  END DO
+                  !             WRITE(numout,*) ' CORRECTION BARBARE '
+                  !             z_da_ex =  MAX( at_i(ji,jj) - zamax , 0.0 )        
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+
+      ! Final thickness distribution rebinning
+      ! --------------------------------------
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' rebinning before'
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+      ENDIF
+      !old version
+      !    CALL lim_itd_th_reb(1,jpl)
+
+      DO jm = 1, jpm
+         jbnd1 = ice_cat_bounds(jm,1)
+         jbnd2 = ice_cat_bounds(jm,2)
+         IF (ice_ncat_types(jm) .GT. 1 ) CALL lim_itd_th_reb(jbnd1, jbnd2, jm)
+         IF (ice_ncat_types(jm) .EQ. 1 ) THEN
+         ENDIF
+      END DO
+
+      IF( ln_nicep ) THEN  
+         WRITE(numout,*) ' rebinning final'
+         WRITE(numout,*) ' a_i : ', a_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' at_i    ', at_i(jiindx,jjindx)
+         WRITE(numout,*) ' v_i : ', v_i(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' v_s : ', v_s(jiindx, jjindx, 1:jpl)
+         WRITE(numout,*) ' smv_i: ', smv_i(jiindx, jjindx, 1:jpl)
+      ENDIF
+
+      at_i(:,:) = a_i(:,:,1)
+      DO jl = 2, jpl
+         at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
+      END DO
+
+      !------------------------------------------------------------------------------
+      ! 2) Corrections to avoid wrong values                                        |
+      !------------------------------------------------------------------------------
+      ! Ice drift
+      !------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            IF ( at_i(ji,jj) .EQ. 0.0 ) THEN ! what to do if there is no ice
+               IF ( at_i(ji+1,jj) .EQ. 0.0 ) u_ice(ji,jj)   = 0.0 ! right side
+               IF ( at_i(ji-1,jj) .EQ. 0.0 ) u_ice(ji-1,jj) = 0.0 ! left side
+               IF ( at_i(ji,jj+1) .EQ. 0.0 ) v_ice(ji,jj)   = 0.0 ! upper side
+               IF ( at_i(ji,jj-1) .EQ. 0.0 ) v_ice(ji,jj-1) = 0.0 ! bottom side
+            ENDIF
+         END DO
+      END DO
+      !mask velocities
+      u_ice(:,:) = u_ice(:,:) * tmu(:,:)
+      v_ice(:,:) = v_ice(:,:) * tmv(:,:)
+      !lateral boundary conditions
+      CALL lbc_lnk( u_ice(:,:), 'U', -1. )
+      CALL lbc_lnk( v_ice(:,:), 'V', -1. )
+
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      ! ALERTES
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      IF( ln_nicep ) THEN  
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jl = 1, jpl
+                  IF ( (a_i(ji,jj,jl).GT.1.0).OR.(at_i(ji,jj).GT.1.0) ) THEN
+                     zindb          =  MAX( rzero, SIGN( rone, a_i(ji,jj,jl) - epsi06 ) ) 
+                     WRITE(numout,*) ' lim_update : a_i > 1 '
+                     WRITE(numout,*) ' PAS BIEN ----> ALERTE !!! '
+                     WRITE(numout,*) ' ~~~~~~~~~~   at_i     ', at_i(ji,jj)
+                     WRITE(numout,*) ' Point - category', ji, jj, jl
+                     WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
+                     WRITE(numout,*) ' a_i *** a_i_old ', a_i(ji,jj,jl), old_a_i(ji,jj,jl)
+                     WRITE(numout,*) ' v_i *** v_i_old ', v_i(ji,jj,jl), old_v_i(ji,jj,jl)
+                     WRITE(numout,*) ' ht_i ***        ', v_i(ji,jj,jl)/MAX(a_i(ji,jj,jl),epsi06)*zindb 
+                     WRITE(numout,*) ' hi_max(jl), hi_max(jl-1) ', hi_max(jl), hi_max(jl-1)
+                     WRITE(numout,*) ' d_v_i_thd / trp ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)
+                     WRITE(numout,*) ' d_a_i_thd / trp ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
+                  ENDIF
+               END DO
+
+            END DO !jj
+         END DO !ji
+
+         WRITE(numout,*) ' TESTOSC1 ', tio_u(jiindx,jjindx), tio_v(jiindx,jjindx)
+         WRITE(numout,*) ' TESTOSC2 ', u_ice(jiindx,jjindx), v_ice(jiindx,jjindx)
+         WRITE(numout,*) ' TESTOSC3 ', u_oce(jiindx,jjindx), v_oce(jiindx,jjindx)
+         WRITE(numout,*) ' TESTOSC4 ', utau (jiindx,jjindx), vtau (jiindx,jjindx)
+      ENDIF
+
+
+      IF(ln_ctl) THEN   ! Control print
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Cell values : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=area       , clinfo1=' lim_update  : cell area   :')
+         CALL prt_ctl(tab2d_1=at_i       , clinfo1=' lim_update  : at_i        :')
+         CALL prt_ctl(tab2d_1=vt_i       , clinfo1=' lim_update  : vt_i        :')
+         CALL prt_ctl(tab2d_1=vt_s       , clinfo1=' lim_update  : vt_s        :')
+         CALL prt_ctl(tab2d_1=strength   , clinfo1=' lim_update  : strength    :')
+         CALL prt_ctl(tab2d_1=u_ice      , clinfo1=' lim_update  : u_ice       :', tab2d_2=v_ice      , clinfo2=' v_ice       :')
+         CALL prt_ctl(tab2d_1=d_u_ice_dyn, clinfo1=' lim_update  : d_u_ice_dyn :', tab2d_2=d_v_ice_dyn, clinfo2=' d_v_ice_dyn :')
+         CALL prt_ctl(tab2d_1=old_u_ice  , clinfo1=' lim_update  : old_u_ice   :', tab2d_2=old_v_ice  , clinfo2=' old_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= ' lim_update  : ht_i        : ')
+            CALL prt_ctl(tab2d_1=ht_s       (:,:,jl)        , clinfo1= ' lim_update  : ht_s        : ')
+            CALL prt_ctl(tab2d_1=t_su       (:,:,jl)        , clinfo1= ' lim_update  : t_su        : ')
+            CALL prt_ctl(tab2d_1=t_s        (:,:,1,jl)      , clinfo1= ' lim_update  : t_snow      : ')
+            CALL prt_ctl(tab2d_1=sm_i       (:,:,jl)        , clinfo1= ' lim_update  : sm_i        : ')
+            CALL prt_ctl(tab2d_1=o_i        (:,:,jl)        , clinfo1= ' lim_update  : o_i         : ')
+            CALL prt_ctl(tab2d_1=a_i        (:,:,jl)        , clinfo1= ' lim_update  : a_i         : ')
+            CALL prt_ctl(tab2d_1=old_a_i    (:,:,jl)        , clinfo1= ' lim_update  : old_a_i     : ')
+            CALL prt_ctl(tab2d_1=d_a_i_trp  (:,:,jl)        , clinfo1= ' lim_update  : d_a_i_trp   : ')
+            CALL prt_ctl(tab2d_1=d_a_i_thd  (:,:,jl)        , clinfo1= ' lim_update  : d_a_i_thd   : ')
+            CALL prt_ctl(tab2d_1=v_i        (:,:,jl)        , clinfo1= ' lim_update  : v_i         : ')
+            CALL prt_ctl(tab2d_1=old_v_i    (:,:,jl)        , clinfo1= ' lim_update  : old_v_i     : ')
+            CALL prt_ctl(tab2d_1=d_v_i_trp  (:,:,jl)        , clinfo1= ' lim_update  : d_v_i_trp   : ')
+            CALL prt_ctl(tab2d_1=d_v_i_thd  (:,:,jl)        , clinfo1= ' lim_update  : d_v_i_thd   : ')
+            CALL prt_ctl(tab2d_1=v_s        (:,:,jl)        , clinfo1= ' lim_update  : v_s         : ')
+            CALL prt_ctl(tab2d_1=old_v_s    (:,:,jl)        , clinfo1= ' lim_update  : old_v_s     : ')
+            CALL prt_ctl(tab2d_1=d_v_s_trp  (:,:,jl)        , clinfo1= ' lim_update  : d_v_s_trp   : ')
+            CALL prt_ctl(tab2d_1=d_v_s_thd  (:,:,jl)        , clinfo1= ' lim_update  : d_v_s_thd   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : e_i1        : ')
+            CALL prt_ctl(tab2d_1=old_e_i    (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : old_e_i1    : ')
+            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : de_i1_trp   : ')
+            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : de_i1_thd   : ')
+            CALL prt_ctl(tab2d_1=e_i        (:,:,2,jl)/1.0e9, clinfo1= ' lim_update  : e_i2        : ')
+            CALL prt_ctl(tab2d_1=old_e_i    (:,:,2,jl)/1.0e9, clinfo1= ' lim_update  : old_e_i2    : ')
+            CALL prt_ctl(tab2d_1=d_e_i_trp  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update  : de_i2_trp   : ')
+            CALL prt_ctl(tab2d_1=d_e_i_thd  (:,:,2,jl)/1.0e9, clinfo1= ' lim_update  : de_i2_thd   : ')
+            CALL prt_ctl(tab2d_1=e_s        (:,:,1,jl)      , clinfo1= ' lim_update  : e_snow      : ')
+            CALL prt_ctl(tab2d_1=old_e_s    (:,:,1,jl)      , clinfo1= ' lim_update  : old_e_snow  : ')
+            CALL prt_ctl(tab2d_1=d_e_s_trp  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : d_e_s_trp   : ')
+            CALL prt_ctl(tab2d_1=d_e_s_thd  (:,:,1,jl)/1.0e9, clinfo1= ' lim_update  : d_e_s_thd   : ')
+            CALL prt_ctl(tab2d_1=smv_i      (:,:,jl)        , clinfo1= ' lim_update  : smv_i       : ')
+            CALL prt_ctl(tab2d_1=old_smv_i  (:,:,jl)        , clinfo1= ' lim_update  : old_smv_i   : ')
+            CALL prt_ctl(tab2d_1=d_smv_i_trp(:,:,jl)        , clinfo1= ' lim_update  : d_smv_i_trp : ')
+            CALL prt_ctl(tab2d_1=d_smv_i_thd(:,:,jl)        , clinfo1= ' lim_update  : d_smv_i_thd : ')
+            CALL prt_ctl(tab2d_1=oa_i       (:,:,jl)        , clinfo1= ' lim_update  : oa_i        : ')
+            CALL prt_ctl(tab2d_1=old_oa_i   (:,:,jl)        , clinfo1= ' lim_update  : old_oa_i    : ')
+            CALL prt_ctl(tab2d_1=d_oa_i_trp (:,:,jl)        , clinfo1= ' lim_update  : d_oa_i_trp  : ')
+            CALL prt_ctl(tab2d_1=d_oa_i_thd (:,:,jl)        , clinfo1= ' lim_update  : d_oa_i_thd  : ')
+            CALL prt_ctl(tab2d_1=REAL(patho_case(:,:,jl))   , clinfo1= ' lim_update  : Path. case  : ')
+
+            DO jk = 1, nlay_i
+               CALL prt_ctl_info(' - Layer : ', ivar1=jk)
+               CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update  : 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=fmmec  , clinfo1= ' lim_update : fmmec : ', tab2d_2=fhmec     , clinfo2= ' fhmec     : ')
+         CALL prt_ctl(tab2d_1=sst_m  , clinfo1= ' lim_update : sst   : ', tab2d_2=sss_m     , clinfo2= ' sss       : ')
+         CALL prt_ctl(tab2d_1=fhbri  , clinfo1= ' lim_update : fhbri : ', tab2d_2=fheat_rpo , clinfo2= ' fheat_rpo : ')
+
+         CALL prt_ctl_info(' ')
+         CALL prt_ctl_info(' - Stresses : ')
+         CALL prt_ctl_info('   ~~~~~~~~~~ ')
+         CALL prt_ctl(tab2d_1=utau       , clinfo1= ' lim_update : utau      : ', tab2d_2=vtau       , clinfo2= ' vtau      : ')
+         CALL prt_ctl(tab2d_1=utau_ice   , clinfo1= ' lim_update : utau_ice  : ', tab2d_2=vtau_ice   , clinfo2= ' vtau_ice  : ')
+         CALL prt_ctl(tab2d_1=u_oce      , clinfo1= ' lim_update : u_oce     : ', tab2d_2=v_oce      , clinfo2= ' v_oce     : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj,jpl, internal_melt )   ! integer
+      CALL wrk_dealloc( jkmax, zthick0, zqm0 )
+
+   END SUBROUTINE lim_update
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty Module               No sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE lim_update     ! Empty routine
+   END SUBROUTINE lim_update
+
+#endif
+
+END MODULE limupdate
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90	(revision 3437)
@@ -0,0 +1,527 @@
+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
+   !!                        - ot_i(jpi,jpj)  !average ice age
+   !!======================================================================
+   !! History :   -   ! 2006-01 (M. Vancoppenolle) Original code
+   !!            4.0  ! 2011-02 (G. Madec) dynamical allocation
+   !!----------------------------------------------------------------------
+#if defined key_lim3
+   !!----------------------------------------------------------------------
+   !!   'key_lim3'                                      LIM3 sea-ice model
+   !!----------------------------------------------------------------------
+   !!   lim_var_agg       : 
+   !!   lim_var_glo2eqv   :
+   !!   lim_var_eqv2glo   :
+   !!   lim_var_salprof   : 
+   !!   lim_var_salprof1d :
+   !!   lim_var_bv        :
+   !!----------------------------------------------------------------------
+   USE par_oce          ! ocean parameters
+   USE phycst           ! physical constants (ocean directory) 
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE ice              ! LIM variables
+   USE par_ice          ! LIM parameters
+   USE dom_ice          ! LIM domain
+   USE thd_ice          ! LIM thermodynamics
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   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    !
+
+   REAL(wp) ::   eps20 = 1.e-20_wp   ! module constants
+   REAL(wp) ::   eps16 = 1.e-16_wp   !    -       -
+   REAL(wp) ::   eps13 = 1.e-13_wp   !    -       -
+   REAL(wp) ::   eps10 = 1.e-10_wp   !    -       -
+   REAL(wp) ::   eps06 = 1.e-06_wp   !    -       -
+   REAL(wp) ::   zzero = 0.e0        !    -       -
+   REAL(wp) ::   zone  = 1.e0        !    -       -
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , 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
+      REAL(wp) ::   zinda
+      !!------------------------------------------------------------------
+
+      !--------------------
+      ! Compute variables
+      !--------------------
+      vt_i (:,:) = 0._wp
+      vt_s (:,:) = 0._wp
+      at_i (:,:) = 0._wp
+      ato_i(:,:) = 1._wp
+      !
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
+               vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
+               at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
+               !
+               zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
+               icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , eps16 ) * zinda  ! ice thickness
+            END DO
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp )   ! open water fraction
+         END DO
+      END DO
+
+      IF( kn > 1 ) THEN
+         et_s (:,:) = 0._wp
+         ot_i (:,:) = 0._wp
+         smt_i(:,:) = 0._wp
+         et_i (:,:) = 0._wp
+         !
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  et_s(ji,jj)  = et_s(ji,jj)  + e_s(ji,jj,1,jl)                                       ! snow heat content
+                  zinda = MAX( zzero , SIGN( zone , vt_i(ji,jj) - 0.10 ) ) 
+                  smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , eps13 ) * zinda   ! ice salinity
+                  zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) ) 
+                  ot_i(ji,jj)  = ot_i(ji,jj)  + oa_i(ji,jj,jl)  / MAX( at_i(ji,jj) , eps13 ) * zinda   ! ice age
+               END DO
+            END DO
+         END DO
+         !
+         DO jl = 1, jpl
+            DO jk = 1, nlay_i
+               et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl)       ! ice heat content
+            END DO
+         END DO
+         !
+      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, zindb, zq_s, zfac1, zfac2   !   -      -
+      !!------------------------------------------------------------------
+
+      !-------------------------------------------------------
+      ! Ice thickness, snow thickness, ice salinity, ice age
+      !-------------------------------------------------------
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes
+               ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
+               ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
+               o_i(ji,jj,jl)  = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , eps10 ) * zindb
+            END DO
+         END DO
+      END DO
+
+      IF(  num_sal == 2  .OR.  num_sal == 4  )THEN
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) ) )   !0 if no ice and 1 if yes
+                  sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , eps10 ) * zindb
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      CALL lim_var_salprof      ! salinity profile
+
+      !-------------------
+      ! Ice temperatures
+      !-------------------
+!CDIR NOVERRCHK
+      DO jl = 1, jpl
+!CDIR NOVERRCHK
+         DO jk = 1, nlay_i
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  !                                                              ! Energy of melting q(S,T) [J.m-3]
+                  zq_i    = e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , eps06 ) * REAL(nlay_i,wp) 
+                  zindb   = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes
+                  zq_i    = zq_i * unit_fac * zindb                              !convert units
+                  ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt                       ! Ice layer melt temperature
+                  !
+                  zaaa       =  cpic                  ! Conversion q(S,T) -> T (second order equation)
+                  zbbb       =  ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
+                  zccc       =  lfus * (ztmelts-rtt)
+                  zdiscrim   =  SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
+                  t_i(ji,jj,jk,jl) = rtt + zindb *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
+                  t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) )       ! 100-rtt < t_i < rtt
+               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]
+                  zq_s  = e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , eps06 ) ) * REAL(nlay_s,wp)
+                  zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) ) )     ! zindb = 0 if no ice and 1 if yes
+                  zq_s  = zq_s * unit_fac * zindb                                    ! convert units
+                  !
+                  t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 )
+                  t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) )     ! 100-rtt < t_i < rtt
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------
+      ! Mean temperature
+      !-------------------
+      tm_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zindb = (  1._wp - MAX( 0._wp , SIGN( 1._wp , -a_i(ji,jj,jl) ) )  )   &
+                     &  * (  1._wp - MAX( 0._wp , SIGN( 1._wp , -v_i(ji,jj,jl) ) )  )
+                  tm_i(ji,jj) = tm_i(ji,jj) + t_i(ji,jj,jk,jl) * v_i(ji,jj,jl)   &
+                     &                      / (  REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , eps10 )  )
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+   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(:,:,:)
+      oa_i (:,:,:) = o_i (:,:,:) * a_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 s_i_1, 
+      !!              the profile is assumed to be constant (S_inf)
+      !!              If bulk salinity lower than s_i_0,
+      !!              the profile is linear with 0 at the surface (S_zero)
+      !!              If it is between s_i_0 and s_i_1, it is a
+      !!              alpha-weighted linear combination of s_inf and s_zero
+      !!
+      !! ** References : Vancoppenolle et al., 2007 (in preparation)
+      !!------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index
+      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac, zsal      ! local scalar
+      REAL(wp) ::   zind0, zind01, zindbal, zargtemp , zs_zero   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_slope_s, zalpha   ! 3D pointer
+      !!------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
+
+      !---------------------------------------
+      ! Vertically constant, constant in time
+      !---------------------------------------
+      IF( num_sal == 1 )   s_i(:,:,:,:) = bulk_sal
+
+      !-----------------------------------
+      ! Salinity profile, varying in time
+      !-----------------------------------
+
+      IF(   num_sal == 2  .OR.   num_sal == 4   ) 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
+                  z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( 0.01 , ht_i(ji,jj,jl) )
+               END DO
+            END DO
+         END DO
+         !
+         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )       ! Weighting factor between zs_zero and zs_inf
+         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
+
+         zalpha(:,:,:) = 0._wp
+         DO jl = 1, jpl
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
+                  zind0  = MAX( 0.0   , SIGN( 1.0  , s_i_0 - sm_i(ji,jj,jl) ) ) 
+                  ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
+                  zind01 = ( 1.0 - zind0 ) * MAX( 0.0   , SIGN( 1.0  , s_i_1 - sm_i(ji,jj,jl) ) ) 
+                  ! If 2.sm_i GE sss_m then zindbal = 1
+                  zindbal = MAX( 0.0 , SIGN( 1.0 , 2. * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
+                  zalpha(ji,jj,jl) = zind0  * 1.0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
+                  zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1.0 - zindbal )
+               END DO
+            END DO
+         END DO
+
+         dummy_fac = 1._wp / nlay_i                   ! 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) * dummy_fac
+                     !                                      ! weighting the profile
+                     s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
+                  END DO ! ji
+               END DO ! jj
+            END DO ! jk
+         END DO ! jl
+
+      ENDIF ! num_sal
+
+      !-------------------------------------------------------
+      ! Vertically varying salinity profile, constant in time
+      !-------------------------------------------------------
+
+      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+         !
+         sm_i(:,:,:) = 2.30_wp
+         !
+         DO jl = 1, jpl
+!CDIR NOVERRCHK
+            DO jk = 1, nlay_i
+               zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
+               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 ! num_sal
+      !
+      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
+      REAL(wp) ::   zbvi, zindb      ! local scalars
+      !!------------------------------------------------------------------
+      !
+      bv_i(:,:) = 0._wp
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zindb = 1.0-MAX(0.0,SIGN(1.0,-a_i(ji,jj,jl))) !0 if no ice and 1 if yes
+                  zbvi  = - zindb * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - 273.15 , eps13 )   &
+                     &                   * v_i(ji,jj,jl)    / REAL(nlay_i,wp)
+                  bv_i(ji,jj) = bv_i(ji,jj) + zbvi  / MAX( vt_i(ji,jj) , eps13 )
+               END DO
+            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  ::   zji, zjj  ! local integers
+      REAL(wp) ::   dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal   ! local scalars
+      REAL(wp) ::   zalpha, zind0, zind01, zindbal, zs_zero              !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:) ::   z_slope_s
+      !!---------------------------------------------------------------------
+
+      CALL wrk_alloc( jpij, z_slope_s )
+
+      !---------------------------------------
+      ! Vertically constant, constant in time
+      !---------------------------------------
+      IF( num_sal == 1 )   s_i_b(:,:) = bulk_sal
+
+      !------------------------------------------------------
+      ! Vertically varying salinity profile, varying in time
+      !------------------------------------------------------
+
+      IF(  num_sal == 2  .OR.  num_sal == 4  ) THEN
+         !
+         DO ji = kideb, kiut          ! Slope of the linear profile zs_zero
+            z_slope_s(ji) = 2._wp * sm_i_b(ji) / MAX( 0.01 , ht_i_b(ji) )
+         END DO
+
+         ! Weighting factor between zs_zero and zs_inf
+         !---------------------------------------------
+         dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
+         dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
+         dummy_fac2 = 1._wp / REAL(nlay_i,wp)
+
+!CDIR NOVERRCHK
+         DO jk = 1, nlay_i
+!CDIR NOVERRCHK
+            DO ji = kideb, kiut
+               zji =  MOD( npb(ji) - 1 , jpi ) + 1
+               zjj =     ( npb(ji) - 1 ) / jpi + 1
+               ! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
+               zind0  = MAX( 0._wp , SIGN( 1._wp  , s_i_0 - sm_i_b(ji) ) ) 
+               ! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws 
+               zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_b(ji) ) ) 
+               ! if 2.sm_i GE sss_m then zindbal = 1
+               zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_b(ji) - sss_m(zji,zjj) ) )
+               !
+               zalpha = (  zind0 + zind01 * ( sm_i_b(ji) * dummy_fac0 + dummy_fac1 )  ) * ( 1.0 - zindbal )
+               !
+               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_b(ji) * dummy_fac2
+               ! weighting the profile
+               s_i_b(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_b(ji)
+            END DO ! ji
+         END DO ! jk
+
+      ENDIF ! num_sal
+
+      !-------------------------------------------------------
+      ! Vertically varying salinity profile, constant in time
+      !-------------------------------------------------------
+
+      IF( num_sal == 3 ) THEN      ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
+         !
+         sm_i_b(:) = 2.30_wp
+         !
+!CDIR NOVERRCHK
+         DO jk = 1, nlay_i
+            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
+            zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  )
+            DO ji = kideb, kiut
+               s_i_b(ji,jk) = zsal
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpij, z_slope_s )
+      !
+   END SUBROUTINE lim_var_salprof1d
+
+#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
+#endif
+
+   !!======================================================================
+END MODULE limvar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90	(revision 3437)
@@ -0,0 +1,473 @@
+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_init : initialization and namelist read
+   !!----------------------------------------------------------------------
+   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 dom_ice
+   USE ice
+   USE limvar
+   USE in_out_manager
+   USE lbclnk
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE par_ice
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC lim_wri        ! routine called by lim_step.F90
+
+   INTEGER, PARAMETER ::   jpnoumax = 40   !: maximum number of variable for ice output
+   
+   INTEGER  ::   noumef             ! number of fields
+   INTEGER  ::   noumefa            ! number of additional fields
+   INTEGER  ::   add_diag_swi       ! additional diagnostics
+   INTEGER  ::   nz                                         ! dimension for the itd field
+
+   REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant
+   REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant
+   REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant
+   REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant
+   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field
+   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field
+   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field
+   INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 )
+
+   REAL(wp)  ::   epsi16 = 1e-16_wp
+   REAL(wp)  ::   zzero  = 0._wp
+   REAL(wp)  ::   zone   = 1._wp      
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_dimgout
+# include "limwri_dimg.h90"
+#else
+
+   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, jf, ipl ! dummy loop indices
+      INTEGER ::  ierr
+      REAL(wp),DIMENSION(1) ::   zdept
+      REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei
+
+      CHARACTER(len = 40) ::   clhstnam, clop, clhstnama
+
+      INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
+      INTEGER , SAVE ::   nicea, nhorida, ndimitd
+      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51
+      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd
+      !!-------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zfield )
+      CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
+      CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
+
+      ipl = jpl
+
+      IF( numit == nstart ) THEN 
+
+         ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr )
+         IF( lk_mpp    )   CALL mpp_sum ( ierr )
+         IF( ierr /= 0 ) THEN
+            CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN
+         ENDIF
+
+         CALL lim_wri_init 
+
+         IF(lwp) WRITE(numout,*) ' lim_wri, first time step '
+         IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi
+
+         !--------------------
+         !  1) Initialization
+         !--------------------
+
+         !-------------
+         ! Normal file
+         !-------------
+
+         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(lwp) WRITE(numout,*) 'jf', jf
+            IF ( nc(jf) == 1 ) THEN
+               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
+                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
+               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout'
+               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout 
+            ENDIF
+         END DO
+
+         CALL histend(nice, snc4set)
+
+         !-----------------
+         ! ITD file output
+         !-----------------
+         zsto     = rdt_ice
+         clop     = "ave(x)"
+         zout     = nwrite * rdt_ice / nn_fsbc
+         zdept(1) = 0.
+
+         CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
+         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         &
+            1, jpi, 1, jpj,            & ! zoom
+            niter, zjulian, rdt_ice,   & ! time
+            nhorida,                   & ! ? linked with horizontal ...
+            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file 
+         CALL histvert( nicea, "icethi", "L levels",               &
+            "m", ipl , hi_mean , nz )
+         DO jl = 1, jpl
+            zmaskitd(:,:,jl) = tmask(:,:,1)
+         END DO
+         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
+         CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  )  
+         CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   &  
+            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
+         CALL histend(nicea, snc4set)
+      ENDIF
+
+      !     !-----------------------------------------------------------------------!
+      !     !--2. Computation of instantaneous values                               ! 
+      !     !-----------------------------------------------------------------------!
+
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+      IF( ln_nicep ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) ' kindic = ', kindic
+      ENDIF
+      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+      !-- calculs des valeurs instantanees
+      zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
+      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
+
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
+               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
+               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 
+               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 
+               zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda
+            END DO
+         END DO
+      END DO
+
+      CALL lim_var_bv
+
+      DO jj = 2 , jpjm1
+         DO ji = 2 , jpim1
+            zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
+            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
+            zindb  = zindh * zinda
+
+            zcmo(ji,jj,1)  = at_i(ji,jj)
+            zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda
+            zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda
+            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0 * zinda    ! Bottom thermodynamic ice production
+            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0 * zinda    ! Dynamic ice production (rid/raft)
+            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda    ! Lateral thermodynamic ice production
+            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda    ! Snow ice production ice production
+            zcmo(ji,jj,24) = tm_i(ji,jj) - rtt
+
+            zcmo(ji,jj,6)  = fbif  (ji,jj)
+            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
+            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
+            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)
+            zcmo(ji,jj,14) = fhbri(ji,jj)
+            zcmo(ji,jj,15) = utau_ice(ji,jj)
+            zcmo(ji,jj,16) = vtau_ice(ji,jj)
+            zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj)
+            zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj)
+            zcmo(ji,jj,19) = sprecip(ji,jj)
+            zcmo(ji,jj,20) = smt_i(ji,jj)
+            zcmo(ji,jj,21) = ot_i(ji,jj)
+            zcmo(ji,jj,25) = et_i(ji,jj)
+            zcmo(ji,jj,26) = et_s(ji,jj)
+            zcmo(ji,jj,28) = fsbri(ji,jj)
+            zcmo(ji,jj,29) = fseqv(ji,jj)
+
+            zcmo(ji,jj,30) = bv_i(ji,jj)
+            zcmo(ji,jj,31) = hicol(ji,jj)
+            zcmo(ji,jj,32) = strength(ji,jj)
+            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  )
+            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda    ! Surface melt
+            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda    ! Bottom melt
+            zcmo(ji,jj,36) = divu_i(ji,jj)
+            zcmo(ji,jj,37) = shear_i(ji,jj)
+         END DO
+      END DO
+
+      !
+      ! ecriture d'un fichier netcdf
+      !
+      niter = niter + 1
+      DO jf = 1 , noumef
+         !
+         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf)
+         !
+         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. )
+         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. )
+         ENDIF
+         !
+         IF( ln_nicep ) THEN 
+            WRITE(numout,*)
+            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
+            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
+         ENDIF
+         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
+         !
+      END DO
+
+      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
+         IF( lwp) WRITE(numout,*) ' Closing the icemod file '
+         CALL histclo( nice )
+      ENDIF
+
+      !-----------------------------
+      ! Thickness distribution file
+      !-----------------------------
+      IF( add_diag_swi == 1 ) THEN
+
+         DO jl = 1, jpl 
+            CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. )
+            CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. )
+            CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. )
+            CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. )
+            CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. )
+         END DO
+
+         ! Compute ice age
+         DO jl = 1, jpl 
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
+                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda
+               END DO
+            END DO
+         END DO
+
+         ! Compute brine volume
+         zei(:,:,:) = 0._wp
+         DO jl = 1, jpl 
+            DO jk = 1, nlay_i
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
+                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
+                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * &
+                        zinda / nlay_i
+                  END DO
+               END DO
+            END DO
+         END DO
+
+         DO jl = 1, jpl 
+            CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. )
+         END DO
+
+         CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area
+         CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness
+         CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth
+         CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity
+         CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age
+         CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume
+
+         !     !  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
+
+         IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
+            IF(lwp) WRITE(numout,*) ' Closing the icemod file '
+            CALL histclo( nicea ) 
+         ENDIF
+         !
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, zfield )
+      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
+      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
+      
+   END SUBROUTINE lim_wri
+#endif
+
+   SUBROUTINE lim_wri_init
+      !!-------------------------------------------------------------------
+      !!                    ***   ROUTINE lim_wri_init  ***
+      !!                
+      !! ** Purpose :   ???
+      !!
+      !! ** Method  : Read the namicewri namelist and check the parameter 
+      !!       values called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namelist namicewri
+      !!-------------------------------------------------------------------
+      INTEGER ::   nf      ! ???
+
+      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, field_20, field_21, field_22, field_23, field_24,   &
+         field_25, field_26, field_27, field_28, field_29, field_30,   &
+         field_31, field_32, field_33, field_34, field_35, field_36,   &
+         field_37
+
+      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, field_20, field_21, field_22, field_23, field_24,   &
+         field_25, field_26, field_27, field_28, field_29, field_30,   &
+         field_31, field_32, field_33, field_34, field_35, field_36,   &
+         field_37, add_diag_swi
+      !!-------------------------------------------------------------------
+
+      REWIND( numnam_ice )                ! Read Namelist namicewri
+      READ  ( numnam_ice  , 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
+      zfield(20) = field_20
+      zfield(21) = field_21
+      zfield(22) = field_22
+      zfield(23) = field_23
+      zfield(24) = field_24
+      zfield(25) = field_25
+      zfield(26) = field_26
+      zfield(27) = field_27
+      zfield(28) = field_28
+      zfield(29) = field_29
+      zfield(30) = field_30
+      zfield(31) = field_31
+      zfield(32) = field_32
+      zfield(33) = field_33
+      zfield(34) = field_34
+      zfield(35) = field_35
+      zfield(36) = field_36
+      zfield(37) = field_37
+
+      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                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'lim_wri_init : 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
+         WRITE(numout,*) ' add_diag_swi ', add_diag_swi
+      ENDIF
+      !
+   END SUBROUTINE lim_wri_init
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/limwri_dimg.h90	(revision 3437)
@@ -0,0 +1,196 @@
+SUBROUTINE lim_wri
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!-------------------------------------------------------------------
+   !!  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
+   !!-------------------------------------------------------------------
+   USE  diawri, ONLY : dia_wri_dimg
+   REAL(wp),DIMENSION(1) ::   zdept
+
+   REAL(wp) ::   zsto, zsec, zjulian,zout, &
+   REAL(wp) ::   zindh,zinda,zindb, ztmu
+   REAL(wp), DIMENSION(jpi,jpj,jpnoumax) ::   zcmo
+   REAL(wp), DIMENSION(jpi,jpj) ::   zfield
+   INTEGER, SAVE ::   nmoyice   !: counter for averaging
+   INTEGER, SAVE ::   nwf       !: number of fields to write on disk
+   INTEGER, SAVE,DIMENSION (:), ALLOCATABLE  :: nsubindex   !: subindex to be saved
+   ! according to namelist
+
+   REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
+#if ! defined key_diainstant
+   LOGICAL, PARAMETER :: ll_dia_inst=.false.      ! local logical variable 
+#else
+   LOGICAL, PARAMETER :: ll_dia_inst=.true.
+#endif
+   INTEGER ::  ji, jj, jf, ii   ! dummy loop indices and array index
+   INTEGER :: iyear, iday, imon ! 
+
+   CHARACTER(LEN=80) :: clname, cltext, clmode
+
+
+   INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
+   INTEGER , DIMENSION( jpij ) , SAVE ::   ndex51  
+   !!-------------------------------------------------------------------
+   IF ( numit == nstart ) THEN 
+
+      CALL lim_wri_init 
+
+      nwf = 0 
+      ii  = 0
+
+      IF (lwp ) THEN
+         WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '   According to namelist_ice, following fields saved:'
+         DO jf =1, noumef
+            IF (nc(jf) == 1 ) THEN
+               WRITE(numout,* ) '    -',titn(jf), nam(jf), uni(jf)
+            ENDIF
+         END DO
+      ENDIF
+
+      DO jf = 1, noumef
+         IF (nc(jf) == 1 ) nwf = nwf + 1
+      END DO
+
+      ALLOCATE( nsubindex (nwf) )
+
+      DO jf = 1, noumef
+         IF (nc(jf) == 1 ) THEN 
+            ii = ii +1 
+            nsubindex(ii) = jf
+         END IF
+      END DO
+
+      zsto     = rdt_ice
+      zout     = nwrite * rdt_ice / nn_fsbc
+      zsec     = 0.
+      niter    = 0
+      zdept(1) = 0.
+      nmoyice  = 0
+
+   ENDIF
+
+#if ! defined key_diainstant 
+   !-- calculs des valeurs instantanees
+
+   zcmo(:,:, 1:jpnoumax ) = 0.e0 
+   DO jj = 2 , jpjm1
+      DO ji = 2 , jpim1   ! NO vector opt.
+         zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (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)  = ht_s (ji,jj,1)
+         zcmo(ji,jj,2)  = ht_i (ji,jj,1)
+         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)
+         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
+         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) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+         zcmo(ji,jj,15) = utau_ice(ji,jj)
+         zcmo(ji,jj,16) = vtau_ice(ji,jj)
+         zcmo(ji,jj,17) = qsr (ji,jj)
+         zcmo(ji,jj,18) = qns(ji,jj)
+         zcmo(ji,jj,19) = sprecip(ji,jj)
+      END DO
+   END DO
+   ! Cumulates values between outputs           
+   rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
+   nmoyice = nmoyice + 1 
+   ! compute mean value if it is time to write on file
+   IF ( MOD(numit,nwrite) == 0 ) THEN
+      rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
+#else  
+      IF ( MOD(numit,nwrite) == 0 ) THEN 
+         !  case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
+         DO jj = 2 , jpjm1
+            DO ji = 2 , jpim1   ! NO vector opt.
+               zindh  = MAX( zzero , SIGN( zone , ht_i(ji,jj,1) * (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) ) )
+               rcmoy(ji,jj,1)  = ht_s (ji,jj,1)
+               rcmoy(ji,jj,2)  = ht_i (ji,jj,1)
+               rcmoy(ji,jj,3)  = hicifp(ji,jj)
+               rcmoy(ji,jj,4)  = frld  (ji,jj)
+               rcmoy(ji,jj,5)  = sist  (ji,jj)
+               rcmoy(ji,jj,6)  = fbif  (ji,jj)
+               rcmoy(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                  + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                  / ztmu
+
+               rcmoy(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
+                  + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
+                  / ztmu
+               rcmoy(ji,jj,9)  = sst_m(ji,jj)
+               rcmoy(ji,jj,10) = sss_m(ji,jj)
+
+               rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
+               rcmoy(ji,jj,12) = qsr(ji,jj)
+               rcmoy(ji,jj,13) = qns(ji,jj)
+               ! See thersf for the coefficient
+               rcmoy(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
+               rcmoy(ji,jj,15) = utau_ice(ji,jj)
+               rcmoy(ji,jj,16) = vtau_ice(ji,jj)
+               rcmoy(ji,jj,17) = qsr(ji,jj)
+               rcmoy(ji,jj,18) = qns(ji,jj)
+               rcmoy(ji,jj,19) = sprecip(ji,jj)
+            END DO
+         END DO
+#endif
+
+         !
+         niter = niter + 1
+         DO jf = 1 , noumef
+            zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
+
+            IF ( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN 
+               CALL lbc_lnk( zfield, 'T', -1. )
+            ELSE 
+               CALL lbc_lnk( zfield, 'T',  1. )
+            ENDIF
+            rcmoy(:,:,jf) = zfield(:,:)
+         END DO
+
+         IF (ll_dia_inst) THEN
+            clmode='instantaneous'
+         ELSE
+            WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
+         END IF
+         iyear = ndastp/10000
+         imon = (ndastp-iyear*10000)/100
+         iday = ndastp - imon*100 - iyear*10000
+         WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
+         cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
+         CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
+9000     FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+
+         rcmoy(:,:,:) = 0.0
+         nmoyice = 0 
+      END IF     !  MOD(numit, nwrite == 0 ) !
+
+   END SUBROUTINE lim_wri
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/par_ice.F90	(revision 3437)
@@ -0,0 +1,26 @@
+MODULE par_ice
+   !!======================================================================
+   !!                       ***  MODULE par_ice   ***
+   !! LIM-3 Sea Ice :   definition of parameters
+   !!======================================================================
+   !! History :  3.0  ! 2003-08  (M. Vancoppenolle)  LIM-3
+   !!----------------------------------------------------------------------
+   USE par_oce
+
+   IMPLICIT NONE
+   PUBLIC          
+
+   !                                             !!! ice thermodynamics
+   INTEGER, PUBLIC, PARAMETER ::   jkmax    = 6   !: maximum number of ice layers
+   INTEGER, PUBLIC, PARAMETER ::   nlay_s   = 1   !: number of snow layers
+
+   !                                             !!! ice mechanical redistribution
+   INTEGER, PUBLIC, PARAMETER ::   jpl      = 5   !: number of ice categories
+   INTEGER, PUBLIC, PARAMETER ::   jpm      = 1   !: number of ice types
+
+   !!----------------------------------------------------------------------
+   !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_ice
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90	(revision 3437)
@@ -0,0 +1,203 @@
+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
+   !!----------------------------------------------------------------------
+   USE par_ice        ! LIM-3 parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90
+
+   !!---------------------------
+   !! * Share Module variables
+   !!---------------------------
+   !                                         !!! ** ice-thermo namelist (namicethd) **
+   REAL(wp), PUBLIC ::   hmelt   = -0.15     !: maximum melting at the bottom; active only for one category
+   REAL(wp), PUBLIC ::   hicmin  = 0.2       !: (REMOVE)
+   REAL(wp), PUBLIC ::   hiclim  = 0.05      !: minimum ice thickness
+   REAL(wp), PUBLIC ::   amax    = 0.999     !: maximum lead fraction
+   REAL(wp), PUBLIC ::   sbeta   = 1.0       !: numerical scheme for diffusion in ice  (REMOVE)
+   REAL(wp), PUBLIC ::   parlat  = 0.0       !: (REMOVE)
+   REAL(wp), PUBLIC ::   hakspl  = 0.5       !: (REMOVE)
+   REAL(wp), PUBLIC ::   hibspl  = 0.5       !: (REMOVE)
+   REAL(wp), PUBLIC ::   exld    = 2.0       !: (REMOVE)
+   REAL(wp), PUBLIC ::   hakdif  = 1.0       !: (REMOVE)
+   REAL(wp), PUBLIC ::   thth    = 0.2       !: (REMOVE)
+   REAL(wp), PUBLIC ::   hnzst   = 0.1       !: thick. of the surf. layer in temp. comp.
+   REAL(wp), PUBLIC ::   parsub  = 1.0       !: switch for snow sublimation or not
+   REAL(wp), PUBLIC ::   alphs   = 1.0       !: coef. for snow density when snow-ice formation
+   REAL(wp), PUBLIC ::   fraz_swi= 1.0       !: use of frazil ice collection in function of wind (1.0) or not (0.0)
+   REAL(wp), PUBLIC ::   maxfrazb= 0.7       !: maximum portion of frazil ice collecting at the ice bottom
+   REAL(wp), PUBLIC ::   vfrazb  = 0.41667   !: threshold drift speed for collection of bottom frazil ice
+   REAL(wp), PUBLIC ::   Cfrazb  = 5.0       !: squeezing coefficient for collection of bottom frazil ice
+
+   REAL(wp), PUBLIC, DIMENSION(2) ::   hiccrit = (/0.3,0.3/)  !: ice th. for lateral accretion in the NH (SH) (m)
+
+   !!-----------------------------
+   !! * 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 (or _b)
+   !: are the variables corresponding to 2d vectors
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npb    !: number of points where computations has to be done
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   npac   !: correspondance between points (lateral accretion)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qldif_1d      !: <==> the 2D  qldif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qcmif_1d      !: <==> the 2D  qcmif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fstbif_1d     !: <==> the 2D  fstric
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fltbif_1d     !: <==> the 2D  ffltbif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fscbq_1d      !: <==> the 2D  fscmcbq
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qsr_ice_1d    !: <==> the 2D  qsr_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr1_i0_1d     !: <==> the 2D  fr1_i0
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fr2_i0_1d     !: <==> the 2D  fr2_i0
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qnsr_ice_1d   !: <==> the 2D  qns_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qfvbq_1d      !: <==> the 2D  qfvbq
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_bo_b        !: <==> the 2D  t_bo
+
+   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_b        !: <==> the 2D  frld
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fbif_1d       !: <==> the 2D  fbif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmicif_1d    !: <==> the 2D  rdmicif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdmsnif_1d    !: <==> the 2D  rdmsnif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qlbbq_1d      !: <==> the 2D  qlbsbq
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dmgwi_1d      !: <==> the 2D  dmgwi
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvsbq_1d      !: <==> the 2D  rdvosif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvbbq_1d      !: <==> the 2D  rdvobif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvlbq_1d      !: <==> the 2D  rdvolif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dvnbq_1d      !: <==> the 2D  rdvolif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqns_ice_1d   !: <==> the 2D  dqns_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   qla_ice_1d    !: <==> the 2D  qla_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dqla_ice_1d   !: <==> the 2D  dqla_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tatm_ice_1d   !: <==> the 2D  tatm_ice
+   !                                                     ! to reintegrate longwave flux inside the ice thermodynamics
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsup          !: Energy flux sent from bottom to lateral ablation if |dhb|> 0.15 m
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   focea         !: Remaining energy in case of total ablation
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   i0            !: fraction of radiation transmitted to the ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   old_ht_i_b    !: Ice thickness at the beginnning of the time step [m]
+    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::  old_ht_s_b    !: Snow thickness at the beginning of the time step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fsbri_1d      !: Salt flux due to brine drainage
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fhbri_1d      !: Heat flux due to brine drainage
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   fseqv_1d      !: Equivalent Salt flux due to ice growth/decay
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_fl_1d   !: Ice salinity variations due to flushing
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_gd_1d   !: Ice salinity variations due to gravity drainage
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_se_1d   !: Ice salinity variations due to basal salt entrapment
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   dsm_i_si_1d   !: Ice salinity variations due to lateral accretion    
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   hicol_b       !: Ice collection thickness accumulated in fleads
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   t_su_b      !: <==> the 2D  t_su
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   a_i_b       !: <==> the 2D  a_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_i_b      !: <==> the 2D  ht_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ht_s_b      !: <==> 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_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_b      !: 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(:) ::   s_snowice   !: Salinity of new snow ice on top of the ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   o_i_b       !: Ice age                        [days]
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_s_b   !: corresponding to the 2D var  t_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   t_i_b   !: corresponding to the 2D var  t_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   s_i_b   !: profiled ice salinity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_b   !:    Ice  enthalpy per unit volume
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_s_b   !:    Snow enthalpy per unit volume
+
+   ! Clean the following ...
+   ! These variables are coded for conservation checks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_in                  !: ice energy summed over categories (initial)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_i_fin                 !: ice energy summed over categories (final)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qt_s_in, qt_s_fin        !: snow energy summed over categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i, sum_fluxq          !: increment of energy, sum of fluxes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fatm, foce               !: atmospheric, oceanic, heat flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cons_error, surf_error   !: conservation, surface error
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_in        !: goes to trash
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   q_i_layer_fin       !: goes to trash
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   dq_i_layer, radab   !: goes to trash
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_in    !: initial total heat flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ftotal_fin   !: final total heat flux
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_s
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fc_i
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_s_lay
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   de_i_lay
+   
+   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)
+      !!---------------------------------------------------------------------!
+
+      ALLOCATE( npb      (jpij) , npac     (jpij),                          &
+         !                                                                  !
+         &      qldif_1d (jpij) , qcmif_1d (jpij) , fstbif_1d  (jpij) ,     &
+         &      fltbif_1d(jpij) , fscbq_1d (jpij) , qsr_ice_1d (jpij) ,     &
+         &      fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qnsr_ice_1d(jpij) ,     &
+         &      qfvbq_1d (jpij) , t_bo_b   (jpij)                     , STAT=ierr(1) )
+      !
+      ALLOCATE( sprecip_1d (jpij) , frld_1d    (jpij) , at_i_b     (jpij) ,     &
+         &      fbif_1d    (jpij) , rdmicif_1d (jpij) , rdmsnif_1d (jpij) ,     &
+         &      qlbbq_1d   (jpij) , dmgwi_1d   (jpij) , dvsbq_1d   (jpij) ,     &
+         &      dvbbq_1d   (jpij) , dvlbq_1d   (jpij) , dvnbq_1d   (jpij) ,     &
+         &      dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) ,     &
+         &      tatm_ice_1d(jpij) , fsup       (jpij) , focea      (jpij) ,     &   
+         &      i0         (jpij) , old_ht_i_b (jpij) , old_ht_s_b (jpij) ,     &  
+         &      fsbri_1d   (jpij) , fhbri_1d   (jpij) , fseqv_1d   (jpij) ,     &
+         &      dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) ,     &     
+         &      dsm_i_si_1d(jpij) , hicol_b    (jpij)                     , STAT=ierr(2) )
+      !
+      ALLOCATE( t_su_b    (jpij) , a_i_b    (jpij) , ht_i_b   (jpij) ,    &   
+         &      ht_s_b    (jpij) , fc_su    (jpij) , fc_bo_i  (jpij) ,    &    
+         &      dh_s_tot  (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) ,    &    
+         &      dh_snowice(jpij) , sm_i_b   (jpij) , s_i_new  (jpij) ,    &    
+         &      s_snowice (jpij) , o_i_b    (jpij)                   ,    &
+         !                                                                !
+         &      t_s_b(jpij,nlay_s),                                       &
+         !                                                                !
+         &      t_i_b(jpij,jkmax), s_i_b(jpij,jkmax)                ,     &            
+         &      q_i_b(jpij,jkmax), q_s_b(jpij,jkmax)                , STAT=ierr(3))
+      !
+      ALLOCATE( qt_i_in   (jpij,jpl) , qt_i_fin(jpij,jpl) , qt_s_in   (jpij,jpl) ,     &
+         &      qt_s_fin  (jpij,jpl) , dq_i    (jpij,jpl) , sum_fluxq (jpij,jpl) ,     &
+         &      fatm      (jpij,jpl) , foce    (jpij,jpl) , cons_error(jpij,jpl) ,     &
+         &      surf_error(jpij,jpl)                                             ,     &
+         !                                                                             !
+         &      q_i_layer_in(jpij,jkmax) , q_i_layer_fin(jpij,jkmax)             ,     &
+         &      dq_i_layer  (jpij,jkmax) , radab        (jpij,jkmax)             ,     &
+         !                                                                             !
+         &      ftotal_in(jpij), ftotal_fin(jpij)                                ,     &
+         !                                                                             !
+         &      fc_s(jpij,0:nlay_s) , de_s_lay(jpij,nlay_s)                      ,     &
+         &      fc_i(jpij,0:jkmax)  , de_i_lay(jpij,jkmax)                       , STAT=ierr(4) )
+
+      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
+   
+   !!======================================================================
+END MODULE thd_ice
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif2model.F90	(revision 3437)
@@ -0,0 +1,101 @@
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Set_numberofcells ***
+      !!--------------------------------------------- 
+      USE Agrif_Types
+      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_Types
+      IMPLICIT NONE
+
+      Type(Agrif_Grid), Pointer :: Agrif_Gr
+
+#include "GetNumberofcells.h"
+
+   END SUBROUTINE Agrif_Get_numberofcells
+
+   SUBROUTINE Agrif_Allocationcalls(Agrif_Gr)
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Allocationscalls ***
+      !!--------------------------------------------- 
+      USE Agrif_Types 
+#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 ***
+      !!--------------------------------------------- 
+      Use Agrif_Types
+      IMPLICIT NONE
+
+      Return
+
+   END SUBROUTINE Agrif_clustering_def
+
+   SUBROUTINE Agrif_comm_def(modelcomm)
+
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_clustering_def ***
+      !!--------------------------------------------- 
+      Use Agrif_Types
+      Use lib_mpp
+
+      IMPLICIT NONE
+
+      INTEGER :: modelcomm
+
+#if defined key_mpp_mpi
+      modelcomm = mpi_comm_opa
+#endif
+      Return
+
+   END SUBROUTINE Agrif_comm_def
+#else
+   SUBROUTINE Agrif2Model
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif2Model ***
+      !!--------------------------------------------- 
+      WRITE(*,*) 'Impossible to bet here'
+   END SUBROUTINE Agrif2model
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90	(revision 3437)
@@ -0,0 +1,59 @@
+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 
+   REAL(wp), PUBLIC ::   rn_sponge_tra = 2800.     !: sponge coeff. for tracers
+   REAL(wp), PUBLIC ::   rn_sponge_dyn = 2800.     !: sponge coeff. for dynamics
+
+   !                                              !!! OLD namelist names
+   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
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ???
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ???
+   
+   INTEGER :: tsn_id,tsb_id,tsa_id
+   INTEGER :: un_id, vn_id, ua_id, va_id
+   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id
+   INTEGER :: trn_id, trb_id, tra_id
+
+   !!----------------------------------------------------------------------
+   !! 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  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) ,      &
+         &      spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc ) 
+   END FUNCTION agrif_oce_alloc
+
+#endif
+   !!======================================================================
+END MODULE agrif_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90	(revision 3437)
@@ -0,0 +1,625 @@
+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) 
+   !!----------------------------------------------------------------------
+#if defined key_agrif && ! defined key_offline
+   !!----------------------------------------------------------------------
+   !!   'key_agrif'                                              AGRIF zoom
+   !!   NOT 'key_offline'                               NO off-line tracers
+   !!----------------------------------------------------------------------
+   !!   Agrif_tra     :
+   !!   Agrif_dyn     : 
+   !!   interpu       :
+   !!   interpv       :
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE oce
+   USE dom_oce      
+   USE sol_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, interpu, interpv
+
+#  include "domzgr_substitute.h90"  
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+   
+   SUBROUTINE Agrif_tra
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_Tra  ***
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3
+      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa
+      !!----------------------------------------------------------------------
+      !
+      IF( Agrif_Root() )   RETURN
+
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa ) 
+
+      Agrif_SpecialValue    = 0.e0
+      Agrif_UseSpecialValue = .TRUE.
+      ztsa(:,:,:,:) = 0.e0
+
+      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn )
+      Agrif_UseSpecialValue = .FALSE.
+
+      zrhox = Agrif_Rhox()
+
+      alpha1 = ( zrhox - 1. ) * 0.5
+      alpha2 = 1. - alpha1
+
+      alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha4 = 1. - alpha3
+
+      alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
+      alpha7 =    - ( zrhox - 1. ) / ( zrhox + 3. )
+      alpha5 = 1. - alpha6 - alpha7
+
+      IF( nbondi == 1 .OR. nbondi == 2 ) THEN
+
+         DO jn = 1, jpts
+            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
+                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                  ELSE
+                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
+                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  &
+                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+
+      IF( nbondj == 1 .OR. nbondj == 2 ) THEN
+
+         DO jn = 1, jpts
+            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
+                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  ELSE
+                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
+                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  &
+                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO 
+      ENDIF
+
+      IF( nbondi == -1 .OR. nbondi == 2 ) THEN
+         DO jn = 1, jpts
+            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  IF( umask(2,jj,jk) == 0.e0 ) THEN
+                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
+                  ELSE
+                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)        
+                     IF( un(2,jj,jk) < 0.e0 ) THEN
+                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF( nbondj == -1 .OR. nbondj == 2 ) THEN
+         DO jn = 1, jpts
+            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)
+            DO jk=1,jpk      
+               DO ji=1,jpi
+                  IF( vmask(ji,2,jk) == 0.e0 ) THEN
+                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
+                  ELSE
+                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)
+                     IF( vn(ji,2,jk) < 0.e0 ) THEN
+                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         ENDDO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa ) 
+      !
+   END SUBROUTINE Agrif_tra
+
+
+   SUBROUTINE Agrif_dyn( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE Agrif_DYN  ***
+      !!----------------------------------------------------------------------  
+      !! 
+      INTEGER, INTENT(in) ::   kt
+      !!
+      INTEGER :: ji,jj,jk
+      REAL(wp) :: timeref
+      REAL(wp) :: z2dt, znugdt
+      REAL(wp) :: zrhox, rhoy
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva
+      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d
+      !!----------------------------------------------------------------------  
+
+      IF( Agrif_Root() )   RETURN
+
+      CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
+      CALL wrk_alloc( jpi, jpj, jpk, zua, zva )
+
+      zrhox = Agrif_Rhox()
+      rhoy = Agrif_Rhoy()
+
+      timeref = 1.
+
+      ! time step: leap-frog
+      z2dt = 2. * rdt
+      ! time step: Euler if restart from rest
+      IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
+      ! coefficients
+      znugdt =  grav * z2dt    
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+
+      zua = 0.
+      zva = 0.
+      CALL Agrif_Bc_variable(zua,un_id,procname=interpu)
+      CALL Agrif_Bc_variable(zva,vn_id,procname=interpv)
+      zua2d = 0.
+      zva2d = 0.
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d)
+      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d)
+      Agrif_UseSpecialValue = .FALSE.
+
+
+      IF((nbondi == -1).OR.(nbondi == 2)) THEN
+
+         DO jj=1,jpj
+            laplacu(2,jj) = timeref * (zua2d(2,jj)/(rhoy*e2u(2,jj)))*umask(2,jj,1)
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(rhoy*e2u(1:2,jj)))
+               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         spgu(2,:)=0.
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
+            END DO
+         END DO
+
+         DO jj=1,jpj
+            IF (umask(2,jj,1).NE.0.) THEN
+               spgu(2,jj)=spgu(2,jj)/hu(2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk))
+               ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
+            END DO
+         END DO
+
+         spgu1(2,:)=0.
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
+            END DO
+         END DO
+
+         DO jj=1,jpj
+            IF (umask(2,jj,1).NE.0.) THEN
+               spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)
+               va(2,jj,jk) = va(2,jj,jk) / fse3v(2,jj,jk)
+            END DO
+         END DO
+
+      ENDIF
+
+      IF((nbondi == 1).OR.(nbondi == 2)) THEN
+
+         DO jj=1,jpj
+            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(rhoy*e2u(nlci-2,jj)))
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(rhoy*e2u(nlci-2:nlci-1,jj)))
+
+               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk)
+
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+
+
+         spgu(nlci-2,:)=0.
+
+         do jk=1,jpkm1
+            do jj=1,jpj
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
+            enddo
+         enddo
+
+         DO jj=1,jpj
+            IF (umask(nlci-2,jj,1).NE.0.) THEN
+               spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
+
+               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
+
+            END DO
+         END DO
+
+         spgu1(nlci-2,:)=0.
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+
+         DO jj=1,jpj
+            IF (umask(nlci-2,jj,1).NE.0.) THEN
+               spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj
+               ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO jj=1,jpj-1
+               va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk)
+               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v(nlci-1,jj,jk)
+            END DO
+         END DO
+
+      ENDIF
+
+      IF((nbondj == -1).OR.(nbondj == 2)) THEN
+
+         DO ji=1,jpi
+            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
+               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v(ji,1:2,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk)
+            END DO
+         END DO
+
+         spgv(:,2)=0.
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
+            END DO
+         END DO
+
+         DO ji=1,jpi
+            IF (vmask(ji,2,1).NE.0.) THEN
+               spgv(ji,2)=spgv(ji,2)/hv(ji,2)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk))
+               va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk)
+            END DO
+         END DO
+
+         spgv1(:,2)=0.
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)
+            END DO
+         END DO
+
+         DO ji=1,jpi
+            IF (vmask(ji,2,1).NE.0.) THEN
+               spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               ua(ji,2,jk) = (zua(ji,2,jk)/(rhoy*e2u(ji,2)))*umask(ji,2,jk) 
+               ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk)
+            END DO
+         END DO
+
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+
+         DO ji=1,jpi
+            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))
+               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v(ji,nlcj-2:nlcj-1,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+
+         spgv(:,nlcj-2)=0.
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+         DO ji=1,jpi
+            IF (vmask(ji,nlcj-2,1).NE.0.) THEN
+               spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk))
+               va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+         spgv1(:,nlcj-2)=0.
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+         DO ji=1,jpi
+            IF (vmask(ji,nlcj-2,1).NE.0.) THEN
+               spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
+            ENDIF
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
+            END DO
+         END DO
+
+         DO jk=1,jpkm1
+            DO ji=1,jpi
+               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(rhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)
+               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk)
+            END DO
+         END DO
+
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d )
+      CALL wrk_dealloc( jpi, jpj, jpk, zua, zva )
+      !
+   END SUBROUTINE Agrif_dyn
+
+
+   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)=sshn(:,3)
+         sshn(:,2)=sshb(:,3)
+      ENDIF
+
+      IF((nbondj == 1).OR.(nbondj == 2)) THEN
+         ssha(:,nlcj-1)=ssha(:,nlcj-2)
+         ssha(:,nlcj-1)=sshn(:,nlcj-2)                
+      ENDIF
+
+   END SUBROUTINE Agrif_ssh
+
+
+   SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj,jk
+      !!----------------------------------------------------------------------  
+
+      DO jk=k1,k2
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+   END SUBROUTINE interpu
+
+
+   SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu2d  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) &
+               * umask(ji,jj,1)
+         END DO
+      END DO
+
+   END SUBROUTINE interpu2d
+
+
+   SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpv  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji, jj, jk
+      !!----------------------------------------------------------------------  
+
+      DO jk=k1,k2
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE interpv
+
+
+   SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE interpu2d  ***
+      !!----------------------------------------------------------------------  
+      INTEGER, INTENT(in) :: i1,i2,j1,j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      !!
+      INTEGER :: ji,jj
+      !!----------------------------------------------------------------------  
+
+      DO jj=j1,j2
+         DO ji=i1,i2
+            tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) &
+               * vmask(ji,jj,1)
+         END DO
+      END DO
+
+   END SUBROUTINE interpv2d
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90	(revision 3437)
@@ -0,0 +1,376 @@
+#define SPONGE
+
+Module agrif_opa_sponge
+#if defined key_agrif  && ! defined key_offline
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE in_out_manager
+   USE agrif_oce
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE Agrif_Sponge_Tra
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Sponge_Tra ***
+      !!---------------------------------------------
+#include "domzgr_substitute.h90"
+      !!
+      INTEGER :: ji,jj,jk,jn
+      INTEGER :: spongearea
+      REAL(wp) :: timecoeff
+      REAL(wp) :: ztsa, zabe1, zabe2, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge
+      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff
+
+#if defined SPONGE
+      CALL wrk_alloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
+
+      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .TRUE.
+      ztab = 0.e0
+      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)
+
+      spongearea = 2 + 2 * Agrif_irhox()
+
+      localviscsponge = 0.
+      
+      IF (.NOT. spongedoneT) THEN
+         spe1ur(:,:) = 0.
+         spe2vr(:,:) = 0.
+
+      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO ji = 2, spongearea
+            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
+	       * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
+
+         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
+	          localviscsponge(2:spongearea,2:jpj)) &
+	        * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
+      ENDIF
+
+      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO ji = nlci-spongearea + 1,nlci-1
+            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
+	        localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
+	       * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
+
+         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
+	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
+	        * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
+      ENDIF
+
+
+      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO jj = 2, spongearea
+            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
+	        localviscsponge(2:jpi,2:spongearea)) &
+	       * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
+
+         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
+	          localviscsponge(:,3:spongearea)) &
+	        * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
+      ENDIF
+
+      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO jj = nlcj-spongearea + 1,nlcj-1
+            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
+	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
+	       * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
+
+         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
+	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
+	        * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
+      ENDIF
+      
+         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
+
+         spongedoneT = .TRUE.
+      ENDIF
+
+      DO jn = 1, jpts
+         DO jk = 1, jpkm1
+            !
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
+               ENDDO
+            ENDDO
+
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+                  ! horizontal diffusive trends
+                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   &
+                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  )
+                  ! add it to the general tracer trends
+                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa
+               END DO
+            END DO
+            !
+         ENDDO
+      ENDDO
+
+      CALL wrk_dealloc( jpi, jpj, localviscsponge, ztu, ztv )
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff  )
+#endif
+
+   END SUBROUTINE Agrif_Sponge_Tra
+
+   SUBROUTINE Agrif_Sponge_dyn
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Sponge_dyn ***
+      !!---------------------------------------------
+#include "domzgr_substitute.h90"
+      !!
+      INTEGER :: ji,jj,jk
+      INTEGER :: spongearea
+      REAL(wp) :: timecoeff
+      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
+
+#if defined SPONGE
+      CALL wrk_alloc( jpi, jpj, localviscsponge )
+      CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
+
+      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      ztab = 0.e0
+      CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun)
+      Agrif_UseSpecialValue = .FALSE.
+
+      ubdiff(:,:,:) = (ub(:,:,:) - ztab(:,:,:))*umask(:,:,:)
+
+      ztab = 0.e0
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = ln_spc_dyn
+      CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:)
+
+      spongearea = 2 + 2 * Agrif_irhox()
+
+      localviscsponge = 0.
+
+      IF (.NOT. spongedoneU) THEN
+         spe1ur2(:,:) = 0.
+         spe2vr2(:,:) = 0.
+
+      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO ji = 2, spongearea
+            localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:))
+
+         spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
+	          localviscsponge(2:spongearea,2:jpj))
+      ENDIF
+
+      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO ji = nlci-spongearea + 1,nlci-1
+            localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
+	        localviscsponge(nlci-spongearea + 2:nlci-1,:))
+
+         spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
+	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj))
+      ENDIF
+
+
+      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO jj = 2, spongearea
+            localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
+	        localviscsponge(2:jpi,2:spongearea))
+
+         spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
+	          localviscsponge(:,3:spongearea))
+      ENDIF
+
+      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO jj = nlcj-spongearea + 1,nlcj-1
+            localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
+	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1))
+
+         spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
+	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1))
+      ENDIF
+
+         spongedoneU = .TRUE.
+	 
+	  spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:))
+      ENDIF
+      
+      IF (.NOT. spongedoneT) THEN
+        spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))      
+      ENDIF
+      
+      DO jk=1,jpkm1
+      ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
+      vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
+      ENDDO
+      
+      hdivdiff = 0.
+      rotdiff = 0.
+
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+               hdivdiff(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * & 
+                  ubdiff(ji,jj,jk) - e2u(ji-1,jj  )* &
+                  fse3u(ji-1,jj  ,jk)  * ubdiff(ji-1,jj  ,jk)       &
+                  + e1v(ji,jj)*fse3v(ji,jj,jk) * &
+                  vbdiff(ji,jj,jk) - e1v(ji  ,jj-1)* &
+                  fse3v(ji  ,jj-1,jk)  * vbdiff(ji  ,jj-1,jk)  ) * zbtr
+            END DO
+         END DO
+
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1   ! vector opt.
+               zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
+               rotdiff(ji,jj,jk) = (  e2v(ji+1,jj  ) * vbdiff(ji+1,jj  ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk)    &
+                  &              - e1u(ji  ,jj+1) * ubdiff(ji  ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk)  ) &
+                  &           * fmask(ji,jj,jk) * zbtr
+            END DO
+         END DO
+
+      ENDDO
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! vector opt.
+               ze2u = rotdiff (ji,jj,jk)
+               ze1v = hdivdiff(ji,jj,jk)
+               ! horizontal diffusive trends
+               zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                  + ( hdivdiff(ji+1,jj,jk) - ze1v      &
+                  ) / e1u(ji,jj)
+
+               zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                  + ( hdivdiff(ji,jj+1,jk) - ze1v    &
+                  ) / e2v(ji,jj)
+
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, localviscsponge )
+      CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )
+
+#endif
+
+   END SUBROUTINE Agrif_Sponge_dyn
+
+   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptsn ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"       
+      
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+
+      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
+
+   END SUBROUTINE interptsn
+
+   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpun ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"       
+      
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+
+      tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2)
+
+   END SUBROUTINE interpun
+
+   SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interpvn ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"       
+      
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+
+      tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
+
+   END SUBROUTINE interpvn
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90	(revision 3437)
@@ -0,0 +1,366 @@
+#define TWO_WAY
+
+MODULE agrif_opa_update
+#if defined key_agrif  && ! defined key_offline
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE agrif_oce
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn
+
+   INTEGER, PUBLIC :: nbcline = 0
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE Agrif_Update_Tra( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Tra ***
+      !!---------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: kt
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab
+
+       
+      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+#if defined TWO_WAY
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab )
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+
+      IF (MOD(nbcline,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS)
+      ELSE
+         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS)
+      ENDIF
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab )
+#endif
+
+   END SUBROUTINE Agrif_Update_Tra
+
+   SUBROUTINE Agrif_Update_Dyn( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Update_Dyn ***
+      !!---------------------------------------------
+      !!
+      INTEGER, INTENT(in) :: kt
+      REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab
+
+
+      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return
+#if defined TWO_WAY
+      CALL wrk_alloc( jpi, jpj,      ztab2d )
+      CALL wrk_alloc( jpi, jpj, jpk, ztab   )
+
+      IF (mod(nbcline,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable(ztab,un_id,procname = updateU)
+         CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV)
+      ELSE
+         CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU)
+         CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV)         
+      ENDIF
+
+      CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d)
+      CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d)  
+
+      nbcline = nbcline + 1
+
+      Agrif_UseSpecialValueInUpdate = ln_spc_dyn
+      Agrif_SpecialValueFineGrid = 0.
+      CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH)
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+
+      CALL wrk_dealloc( jpi, jpj,      ztab2d )
+      CALL wrk_dealloc( jpi, jpj, jpk, ztab   )
+
+!Done in step
+!      CALL Agrif_ChildGrid_To_ParentGrid()
+!      CALL recompute_diags( kt )
+!      CALL Agrif_ParentGrid_To_ChildGrid()
+
+#endif
+
+   END SUBROUTINE Agrif_Update_Dyn
+
+   SUBROUTINE recompute_diags( kt )
+      !!---------------------------------------------
+      !!   *** ROUTINE recompute_diags ***
+      !!---------------------------------------------
+      INTEGER, INTENT(in) :: kt
+
+   END SUBROUTINE recompute_diags
+
+   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
+      !!---------------------------------------------
+      !!           *** ROUTINE updateT ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
+      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
+      LOGICAL, iNTENT(in) :: before
+
+      INTEGER :: ji,jj,jk,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
+         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 ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhoy
+
+      IF (before) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  un(ji,jj,jk) = tabres(ji,jj,jk) / (e2u(ji,jj))
+                  un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk)
+                  un(ji,jj,jk) = un(ji,jj,jk) / fse3u(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 ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER :: i1,i2,j1,j2,k1,k2
+      INTEGER :: ji,jj,jk
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
+      LOGICAL :: before
+
+      REAL(wp) :: zrhox
+
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
+                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jk=k1,k2
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  vn(ji,jj,jk) = tabres(ji,jj,jk) / (e1v(ji,jj))
+                  vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk)
+                  vn(ji,jj,jk) = vn(ji,jj,jk) / fse3v(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE updatev
+
+   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updateu2d ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji, jj, jk
+      REAL(wp) :: zrhoy
+      REAL(wp) :: zhinv
+
+      IF (before) THEN
+         zrhoy = Agrif_Rhoy()
+         DO jk = 1,jpkm1
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj) = tabres(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = tabres(ji,jj) * e2u(ji,jj)
+            END DO
+         END DO
+         tabres = zrhoy * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               IF(umask(ji,jj,1) .NE. 0.) THEN             
+                  spgu(ji,jj) = 0.e0
+                  DO jk=1,jpk
+                     spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk)
+                  END DO
+                  spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
+                  zhinv = (tabres(ji,jj)-spgu(ji,jj))/(hu(ji,jj)*e2u(ji,jj))
+                  Do jk=1,jpk              
+                     un(ji,jj,jk) = un(ji,jj,jk) + zhinv
+                     un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk)            
+                  END DO
+               ENDIF
+            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) :: zhinv
+
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         tabres = 0.e0
+         DO jk = 1,jpkm1
+            DO jj=j1,j2
+               DO ji=i1,i2
+                  tabres(ji,jj) = tabres(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = tabres(ji,jj) * e1v(ji,jj)
+            END DO
+         END DO
+         tabres = zrhox * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               IF(vmask(ji,jj,1) .NE. 0.) THEN             
+                  spgv(ji,jj) = 0.
+                  DO jk=1,jpk
+                     spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk)
+                  END DO
+                  spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
+                  zhinv = (tabres(ji,jj)-spgv(ji,jj))/(hv(ji,jj)*e1v(ji,jj))
+                  DO jk=1,jpk             
+                     vn(ji,jj,jk) = vn(ji,jj,jk) + zhinv
+                     vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk)
+                  END DO
+               ENDIF
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE updatev2d
+
+   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
+      !!---------------------------------------------
+      !!          *** ROUTINE updateSSH ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1, i2, j1, j2
+      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+
+      INTEGER :: ji, jj
+      REAL(wp) :: zrhox, zrhoy
+
+      IF (before) THEN
+         zrhox = Agrif_Rhox()
+         zrhoy = Agrif_Rhoy()
+         DO jj=j1,j2
+            DO ji=i1,i2
+               tabres(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * sshn(ji,jj)
+            END DO
+         END DO
+         tabres = zrhox * zrhoy * tabres
+      ELSE
+         DO jj=j1,j2
+            DO ji=i1,i2
+               sshn(ji,jj) = tabres(ji,jj) / (e1t(ji,jj) * e2t(ji,jj))
+               sshn(ji,jj) = sshn(ji,jj) * tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+
+   END SUBROUTINE updateSSH
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90	(revision 3437)
@@ -0,0 +1,151 @@
+MODULE agrif_top_interp
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE oce
+   USE dom_oce      
+   USE sol_oce
+   USE agrif_oce
+   USE agrif_top_sponge
+   USE trc
+   USE lib_mpp
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_trc
+
+#  include "domzgr_substitute.h90"  
+#  include "vectopt_loop_substitute.h90"
+  !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE Agrif_trc
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_trc ***
+      !!---------------------------------------------
+      
+      INTEGER :: ji,jj,jk,jn
+      REAL(wp) :: zrhox
+      REAL(wp) :: alpha1, alpha2, alpha3, alpha4
+      REAL(wp) :: alpha5, alpha6, alpha7
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
+           
+      IF (Agrif_Root()) RETURN
+
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .TRUE.
+      ztra = 0.e0
+
+      CALL Agrif_Bc_variable(ztra,trn_id, procname = interptrn )
+      Agrif_UseSpecialValue = .FALSE.
+
+      zrhox = Agrif_Rhox()
+
+      alpha1 = (zrhox-1.)/2.
+      alpha2 = 1.-alpha1
+
+      alpha3 = (zrhox-1)/(zrhox+1)
+      alpha4 = 1.-alpha3
+
+      alpha6 = 2.*(zrhox-1.)/(zrhox+1.)
+      alpha7 = -(zrhox-1)/(zrhox+3)
+      alpha5 = 1. - alpha6 - alpha7
+
+      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
+         tra(nlci,:,:,:) = alpha1 * ztra(nlci,:,:,:) + alpha2 * ztra(nlci-1,:,:,:)
+         DO jn=1,jptra 
+            DO jk=1,jpk      
+               DO jj=1,jpj
+                  IF (umask(nlci-2,jj,jk).EQ.0.) THEN
+                     tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
+                  ELSE
+                     tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     IF (un(nlci-2,jj,jk).GT.0.) THEN
+                        tra(nlci-1,jj,jk,jn)=(alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) &
+                           +alpha7*tra(nlci-3,jj,jk,jn))*tmask(nlci-1,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
+         tra(:,nlcj,:,:) = alpha1 * ztra(:,nlcj,:,:) + alpha2 * ztra(:,nlcj-1,:,:)
+         DO jn=1, jptra            
+            DO jk=1,jpk      
+               DO ji=1,jpi
+                  IF (vmask(ji,nlcj-2,jk).EQ.0.) THEN
+                     tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
+                  ELSE
+                     tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)        
+                     IF (vn(ji,nlcj-2,jk) .GT. 0.) THEN
+                        tra(ji,nlcj-1,jk,jn)=(alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) &
+                           +alpha7*tra(ji,nlcj-3,jk,jn))*tmask(ji,nlcj-1,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
+         tra(1,:,:,:) = alpha1 * ztra(1,:,:,:) + alpha2 * ztra(2,:,:,:)
+         DO jn=1, jptra
+            DO jk=1,jpk      
+               DO jj=1,jpj
+                  IF (umask(2,jj,jk).EQ.0.) THEN
+                     tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)
+                  ELSE
+                     tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)        
+                     IF (un(2,jj,jk).LT.0.) THEN
+                        tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn) &
+                           +alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
+         tra(:,1,:,:) = alpha1 * ztra(:,1,:,:) + alpha2 * ztra(:,2,:,:)
+         DO jn=1, jptra  
+            DO jk=1,jpk      
+               DO ji=1,jpi
+                  IF (vmask(ji,2,jk).EQ.0.) THEN
+                     tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)
+                  ELSE
+                     tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)
+                     IF (vn(ji,2,jk) .LT. 0.) THEN
+                        tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)&
+                           +alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk)
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )
+
+   END SUBROUTINE Agrif_trc
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90	(revision 3437)
@@ -0,0 +1,179 @@
+#define SPONGE_TOP
+
+Module agrif_top_sponge
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE in_out_manager
+   USE agrif_oce
+   USE trc
+   USE lib_mpp
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Sponge_Trc, interptrn
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   CONTAINS
+
+   SUBROUTINE Agrif_Sponge_Trc
+      !!---------------------------------------------
+      !!   *** ROUTINE Agrif_Sponge_Trc ***
+      !!---------------------------------------------
+#include "domzgr_substitute.h90"
+      !! 
+      INTEGER :: ji,jj,jk,jl
+      INTEGER :: spongearea
+      REAL(wp) :: timecoeff
+      REAL(wp) :: ztra, zabe1, zabe2, zbtr
+      REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff, ztru, ztrv, ztab
+
+#if defined SPONGE_TOP
+      CALL wrk_alloc( jpi, jpj, localviscsponge )
+      CALL wrk_alloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+
+      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
+
+      Agrif_SpecialValue=0.
+      Agrif_UseSpecialValue = .TRUE.
+      ztab = 0.e0
+      CALL Agrif_Bc_Variable(ztab, tra_id,calledweight=timecoeff,procname=interptrn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      trbdiff(:,:,:,:) = trb(:,:,:,:) - ztab(:,:,:,:)
+
+      spongearea = 2 + 2 * Agrif_irhox()
+
+      localviscsponge = 0.
+      
+      IF (.NOT. spongedoneT) THEN
+         spe1ur(:,:) = 0.
+         spe2vr(:,:) = 0.
+
+      IF ((nbondi == -1).OR.(nbondi == 2)) THEN
+         DO ji = 2, spongearea
+            localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
+	       * e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
+
+         spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
+	          localviscsponge(2:spongearea,2:jpj)) &
+	        * e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
+      ENDIF
+
+      IF ((nbondi == 1).OR.(nbondi == 2)) THEN
+         DO ji = nlci-spongearea + 1,nlci-1
+            localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
+	        localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
+	       * e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
+
+         spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
+	           + localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
+	        * e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
+      ENDIF
+
+
+      IF ((nbondj == -1).OR.(nbondj == 2)) THEN
+         DO jj = 2, spongearea
+            localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
+	        localviscsponge(2:jpi,2:spongearea)) &
+	       * e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
+
+         spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
+	          localviscsponge(:,3:spongearea)) &
+	        * e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
+      ENDIF
+
+      IF ((nbondj == 1).OR.(nbondj == 2)) THEN
+         DO jj = nlcj-spongearea + 1,nlcj-1
+            localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
+         ENDDO
+	 
+	 spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
+	         localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
+	       * e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
+
+         spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
+	         localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
+	        * e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
+      ENDIF
+      
+         spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
+
+         spongedoneT = .TRUE.
+      ENDIF
+
+      DO jl = 1, jptra
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
+               zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
+               ztru(ji,jj,jk,jl) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jl) - trbdiff(ji,jj,jk,jl) )
+               ztrv(ji,jj,jk,jl) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jl) - trbdiff(ji,jj,jk,jl) )
+            ENDDO
+         ENDDO
+
+         DO jj = 2,jpjm1
+            DO ji = 2,jpim1
+               zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
+               ! horizontal diffusive trends
+               ztra = zbtr * (  ztru(ji,jj,jk,jl) - ztru(ji-1,jj,jk,jl)   &
+                  &          + ztrv(ji,jj,jk,jl) - ztrv(ji,jj-1,jk,jl)  )
+               ! add it to the general tracer trends
+               tra(ji,jj,jk,jl) = (tra(ji,jj,jk,jl) + ztra)
+            END DO
+         END DO
+
+      ENDDO
+      ENDDO
+ 
+      CALL wrk_dealloc( jpi, jpj, localviscsponge )
+      CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztru, ztrv, ztab )
+
+#endif
+
+   END SUBROUTINE Agrif_Sponge_Trc
+
+   SUBROUTINE interptrn(tabres,i1,i2,j1,j2,k1,k2,l1,l2)
+      !!---------------------------------------------
+      !!   *** ROUTINE interptn ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"       
+      
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
+      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
+
+      tabres(i1:i2,j1:j2,k1:k2,l1:l2) = trn(i1:i2,j1:j2,k1:k2,l1:l2)
+
+   END SUBROUTINE interptrn
+
+#else
+CONTAINS
+
+   SUBROUTINE agrif_top_sponge_empty
+      !!---------------------------------------------
+      !!   *** ROUTINE 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90	(revision 3437)
@@ -0,0 +1,106 @@
+#define TWO_WAY
+
+MODULE agrif_top_update
+
+#if defined key_agrif && defined key_top
+   USE par_oce
+   USE oce
+   USE dom_oce
+   USE agrif_oce
+   USE trc
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC Agrif_Update_Trc
+
+   INTEGER, PUBLIC :: nbcline_trc = 0
+
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $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
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra
+
+  
+      IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN
+
+#if defined TWO_WAY
+      CALL wrk_alloc( jpi, jpj, jpk, jpts, ztra )
+
+      Agrif_UseSpecialValueInUpdate = .TRUE.
+      Agrif_SpecialValueFineGrid = 0.
+ 
+     IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN
+         CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC)
+      ELSE
+         CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC)
+      ENDIF
+
+      Agrif_UseSpecialValueInUpdate = .FALSE.
+      nbcline_trc = nbcline_trc + 1
+
+      CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztra )
+#endif
+
+   END SUBROUTINE Agrif_Update_Trc
+
+   SUBROUTINE updateTRC(tabres,i1,i2,j1,j2,k1,k2,l1,l2,before)
+      !!---------------------------------------------
+      !!   *** ROUTINE UpdateTrc ***
+      !!---------------------------------------------
+#  include "domzgr_substitute.h90"
+
+      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,l1,l2
+      REAL, DIMENSION(i1:i2,j1:j2,k1:k2,l1:l2), INTENT(inout) :: tabres
+      LOGICAL, INTENT(in) :: before
+   
+      INTEGER :: ji,jj,jk,jl
+
+         IF (before) THEN
+            DO jl=l1,l2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        tabres(ji,jj,jk,jl) = trn(ji,jj,jk,jl)
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+         ELSE
+            DO jl=l1,l2
+               DO jk=k1,k2
+                  DO jj=j1,j2
+                     DO ji=i1,i2
+                        IF (tabres(ji,jj,jk,jl).NE.0.) THEN
+                           trn(ji,jj,jk,jl) = tabres(ji,jj,jk,jl) * tmask(ji,jj,jk)
+                        ENDIF
+                     ENDDO
+                  ENDDO
+               ENDDO
+            ENDDO
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/NST_SRC/agrif_user.F90	(revision 3437)
@@ -0,0 +1,502 @@
+#if defined key_agrif
+   !!----------------------------------------------------------------------
+   !! NEMO/NST 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   SUBROUTINE agrif_before_regridding
+   END SUBROUTINE
+
+   SUBROUTINE Agrif_InitWorkspace
+      !!----------------------------------------------------------------------
+      !!                 *** ROUTINE Agrif_InitWorkspace ***
+      !!----------------------------------------------------------------------
+      USE par_oce
+      USE dom_oce
+      USE Agrif_Util
+      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
+         jpk     = jpkdta
+         jpim1   = jpi-1
+         jpjm1   = jpj-1
+         jpkm1   = jpk-1                                        
+         jpij    = jpi*jpj
+         jpidta  = jpiglo
+         jpjdta  = jpjglo
+         jpizoom = 1
+         jpjzoom = 1
+         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 obc_par
+      USE bdy_par
+
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+
+      ! 0. Initializations
+      !-------------------
+#if defined key_orca_r025 || defined key_orca_r05 || defined key_orca_r2 || defined key_orca_r4
+      jp_cfg = -1    ! set special value for jp_cfg on fine grids
+      cp_cfg = "default"
+#endif
+
+      ! Specific fine grid Initializations
+      ! no tracer damping on fine grids
+      ln_tradmp = .FALSE.
+      ! no open boundary on fine grids
+      lk_obc = .FALSE.
+      lk_bdy = .FALSE.
+
+      CALL nemo_init  ! Initializations of each fine grid
+      CALL agrif_nemo_init
+# if ! defined key_offline
+      CALL Agrif_InitValues_cont
+# endif       
+# if defined key_top
+      CALL Agrif_InitValues_cont_top
+# endif      
+   END SUBROUTINE Agrif_initvalues
+
+# if ! defined key_offline
+
+   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 sol_oce
+      USE in_out_manager
+      USE agrif_opa_update
+      USE agrif_opa_interp
+      USE agrif_opa_sponge
+      !
+      IMPLICIT NONE
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp
+      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp
+      LOGICAL :: check_namelist
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) )
+      ALLOCATE( tabuvtemp(jpi, jpj, jpk)       )
+
+
+      ! 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(tabtstemp,tsn_id,calledweight=1.,procname=interptsn)
+      Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn)
+
+      Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu)
+      Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv)
+      Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun)
+      Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      ! 3. Some controls
+      !-----------------
+      check_namelist = .true.
+            
+      IF( check_namelist ) THEN
+     
+         ! Check time steps           
+         IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN
+            WRITE(*,*) 'incompatible time step between grids'
+            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
+            WRITE(*,*) 'child  grid value : ',nint(rdt)
+            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
+            STOP
+         ENDIF
+         
+         ! Check run length
+         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
+            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
+            WRITE(*,*) 'incompatible run length between grids'
+            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
+               Agrif_Parent(nit000)+1),' time step'
+            WRITE(*,*) 'child  grid value : ', &
+               (nitend-nit000+1),' time step'
+            WRITE(*,*) 'value on child grid should be : ', &
+               Agrif_IRhot() * (Agrif_Parent(nitend)- &
+               Agrif_Parent(nit000)+1)
+            STOP
+         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) /= 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
+      ENDIF
+       
+      CALL Agrif_Update_tra(0)
+      CALL Agrif_Update_dyn(0)
+
+      nbcline = 0
+      !
+      DEALLOCATE(tabtstemp)
+      DEALLOCATE(tabuvtemp)
+      !
+   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
+      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/),(/jpi,jpj,jpk,jpts/),tsn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id)
+
+      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id)
+      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id)
+      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id)
+      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id)
+   
+      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
+      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
+
+      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
+      CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id)
+       
+      ! 2. Type of interpolation
+      !-------------------------
+      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
+      CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear)
+   
+      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+      Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+
+      Call Agrif_Set_bcinterp(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(un_id,(/0,1/))
+      Call Agrif_Set_bc(vn_id,(/0,1/))
+
+      Call Agrif_Set_bc(e1u_id,(/0,0/))
+      Call Agrif_Set_bc(e2v_id,(/0,0/))
+
+      Call Agrif_Set_bc(tsn_id,(/0,1/))
+      Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/))
+
+      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/))
+      Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/))
+
+      ! 5. Update type
+      !--------------- 
+      Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
+      Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average)
+
+      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
+      Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average)
+
+      Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
+      Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
+
+      Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
+      Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
+
+   END SUBROUTINE agrif_declare_var
+# 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 trc
+      USE in_out_manager
+      USE agrif_top_update
+      USE agrif_top_interp
+      USE agrif_top_sponge
+      !
+      IMPLICIT NONE
+      !
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp
+      LOGICAL :: check_namelist
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )
+      
+      
+      ! 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(tabtrtemp,trn_id,calledweight=1.)
+      Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn)
+      Agrif_UseSpecialValue = .FALSE.
+
+      ! 3. Some controls
+      !-----------------
+      check_namelist = .true.
+            
+      IF( check_namelist ) THEN
+#  if defined offline     
+         ! Check time steps
+         IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN
+            WRITE(*,*) 'incompatible time step between grids'
+            WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt)
+            WRITE(*,*) 'child  grid value : ',nint(rdt)
+            WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot()
+            STOP
+         ENDIF
+
+         ! Check run length
+         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
+            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN
+            WRITE(*,*) 'incompatible run length between grids'
+            WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- &
+               Agrif_Parent(nit000)+1),' time step'
+            WRITE(*,*) 'child  grid value : ', &
+               (nitend-nit000+1),' time step'
+            WRITE(*,*) 'value on child grid should be : ', &
+               Agrif_IRhot() * (Agrif_Parent(nitend)- &
+               Agrif_Parent(nit000)+1)
+            STOP
+         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
+#  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)
+      nbcline_trc = 0
+      !
+      DEALLOCATE(tabtrtemp)
+      !
+   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 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/),(/jpi,jpj,jpk,jptra/),trn_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id)
+      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id)
+#  if defined key_offline
+      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
+      CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id)
+#  endif
+       
+      ! 2. Type of interpolation
+      !-------------------------
+      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
+      CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear)
+   
+#  if defined key_offline
+      Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
+      Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
+#  endif
+
+      ! 3. Location of interpolation
+      !-----------------------------
+#  if defined key_offline
+      Call Agrif_Set_bc(e1u_id,(/0,0/))
+      Call Agrif_Set_bc(e2v_id,(/0,0/))
+#  endif
+      Call Agrif_Set_bc(trn_id,(/0,1/))
+      Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/))
+
+      ! 5. Update type
+      !--------------- 
+      Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
+      Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average)
+
+#  if defined key_offline
+      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)
+#  endif
+
+   END SUBROUTINE agrif_declare_var_top
+# endif
+   
+   SUBROUTINE Agrif_detect( kg, ksizex )
+      !!----------------------------------------------------------------------
+      !!   *** ROUTINE Agrif_detect ***
+      !!----------------------------------------------------------------------
+      USE Agrif_Types
+      !
+      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 in_out_manager
+      USE lib_mpp
+      IMPLICIT NONE
+      !
+      NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )                ! Read namagrif namelist
+      READ  ( numnam, 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,*) 
+      ENDIF
+      !
+      ! convert DOCTOR namelist name into OLD names
+      nbclineupdate = nn_cln_update
+      visc_tra      = rn_sponge_tra
+      visc_dyn      = rn_sponge_dyn
+      !
+      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed')
+      !
+    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(3)   ;   indglob = indloc
+      CASE(4)   ;   indglob = indloc
+      END SELECT
+      !
+   END SUBROUTINE Agrif_InvLoc
+
+# endif
+
+#else
+   SUBROUTINE Subcalledbyagrif
+      !!----------------------------------------------------------------------
+      !!                   *** ROUTINE Subcalledbyagrif ***
+      !!----------------------------------------------------------------------
+      WRITE(*,*) 'Impossible to be here'
+   END SUBROUTINE Subcalledbyagrif
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domain.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domain.F90	(revision 3437)
@@ -0,0 +1,342 @@
+MODULE domain
+   !!==============================================================================
+   !!                       ***  MODULE domain   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   dom_init       : initialize the space and time domain
+   !!   dom_nam        : read and contral domain namelists
+   !!   dom_ctl        : control print for the ocean domain
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   USE domstp          ! domain: set the time-step
+   USE domrea          ! domain: write the meshmask file
+   USE dommsk          ! domain : mask
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dom_init       ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dom_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_init  ***
+      !!                    
+      !! ** Purpose :   Domain initialization. Call the routines that are 
+      !!      required to create the arrays which define the space and time
+      !!      domain of the ocean model.
+      !!
+      !! ** Method  :
+      !!      - dom_stp: defined the model time step
+      !!      - dom_rea: read the meshmask file if nmsh=1
+      !!
+      !! History :
+      !!        !  90-10  (C. Levy - G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  92-01  (M. Imbard) insert time step initialization
+      !!        !  96-06  (G. Madec) generalized vertical coordinate 
+      !!        !  97-02  (G. Madec) creation of domwri.F
+      !!        !  01-05  (E.Durand - G. Madec) insert closed sea
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+
+      CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+      CALL dom_zgr      ! Vertical mesh and bathymetry option
+      CALL dom_rea      ! Create a domain file
+      CALL dom_stp      ! Time step
+      CALL dom_msk      ! Masks
+      CALL dom_ctl      ! Domain control
+
+   END SUBROUTINE dom_init
+
+   SUBROUTINE dom_nam
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_nam  ***
+      !!                    
+      !! ** Purpose :   read domaine namelists and print the variables.
+      !!
+      !! ** input   : - namrun namelist
+      !!              - namdom namelist
+      !!              - namcla namelist
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
+      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,     &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,              &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
+      NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )              ! Namelist namrun : parameters of the run
+      READ  ( numnam, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'  
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nwrite = nn_write
+
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday
+
+#if defined key_agrif
+      IF( Agrif_Root() ) THEN
+#endif
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE (  1 ) 
+         CALL ioconf_calendar('gregorian')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
+      CASE (  0 )
+         CALL ioconf_calendar('noleap')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
+      CASE ( 30 )
+         CALL ioconf_calendar('360d')
+         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
+      END SELECT
+#if defined key_agrif
+      ENDIF
+#endif
+
+      REWIND( numnam )             ! Domain
+      READ  ( numnam, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created                 '
+         WRITE(numout,*) '           = 1   mesh_mask                       '
+         WRITE(numout,*) '           = 2   mesh and mask                   '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      '
+         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+      ENDIF
+
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      nacc      = nn_acc
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+      rdtmin    = rn_rdtmin
+      rdtmax    = rn_rdtmin
+      rdth      = rn_rdth
+
+      REWIND( numnam )             ! Namelist cross land advection
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namcla'
+         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
+      ENDIF
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
+      READ  ( numnam, namnc4 )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+   SUBROUTINE dom_zgr
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate  
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0   ! temporary integer
+      !!
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
+         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
+         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
+      ENDIF
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco ) ioptio = ioptio + 1
+      IF( ln_zps ) ioptio = ioptio + 1
+      IF( ln_sco ) ioptio = ioptio + 1
+      IF ( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+
+   END SUBROUTINE dom_zgr
+
+   SUBROUTINE dom_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dom_ctl  ***
+      !!
+      !! ** Purpose :   Domain control.
+      !!
+      !! ** Method  :   compute and print extrema of masked scale factors
+      !!
+      !! History :
+      !!   8.5  !  02-08  (G. Madec)    Original code
+      !!----------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
+      INTEGER, DIMENSION(2) ::   iloc      ! 
+      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
+      !!----------------------------------------------------------------------
+
+      ! Extrema of the scale factors
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
+      IF(lwp)WRITE(numout,*) '~~~~~~~'
+
+      IF (lk_mpp) THEN
+         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
+         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
+         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
+         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
+      ENDIF
+
+   END SUBROUTINE dom_ctl
+
+   !!======================================================================
+END MODULE domain
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dommsk.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dommsk.F90	(revision 3437)
@@ -0,0 +1,103 @@
+MODULE dommsk
+   !!======================================================================
+   !!                       ***  MODULE dommsk   ***
+   !! Ocean initialization : domain land/sea masks, off-line case 
+   !!======================================================================
+   !! History :  3.3  ! 2010-10  (C. Ethe)  adapted from OPA_SRC/DOM/dommsk
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk        : compute land/ocean mask
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE lib_mpp         ! MPP library
+   USE in_out_manager  ! I/O manager
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk    ! routine called by inidom.F90
+
+   REAL(wp)        :: rn_shlat   = 2.   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  = .false.   !  consistency of vorticity boundary condition 
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Off-line case: defines the interior domain T-mask.
+      !!
+      !! ** Method  :   The interior ocean/land mask is computed from tmask
+      !!              setting to zero the duplicated row and lines due to
+      !!              MPP exchange halos, est-west cyclic and north fold
+      !!              boundary conditions.
+      !!
+      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point
+      !!               tpol     : ???
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jk                   ! dummy loop indices
+      INTEGER  ::   iif, iil, ijf, ijl       ! local integers
+      INTEGER, POINTER, DIMENSION(:,:) ::  imsk 
+      !
+      !!---------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi, jpj, imsk )
+      !
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                        ! thickness of exchange halos in i-axis
+      iil = nlci - jpreci + 1
+      ijf = jprecj                        ! thickness of exchange halos in j-axis
+      ijl = nlcj - jprecj + 1
+      !
+      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns
+      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows)
+      !
+      !                                   ! north fold mask
+      tpol(1:jpiglo) = 1._wp
+      !                                
+      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot
+      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot
+      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row
+         IF( mjg(ijl-1) == jpjglo-1 ) THEN
+            DO ji = iif+1, iil-1
+               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji))
+            END DO
+         ENDIF
+      ENDIF 
+      !
+      IF( nprint == 1 .AND. lwp ) THEN    ! Control print
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout)
+         END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, imsk )
+      !
+   END SUBROUTINE dom_msk
+   !!======================================================================
+END MODULE dommsk
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domrea.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/domrea.F90	(revision 3437)
@@ -0,0 +1,375 @@
+MODULE domrea
+   !!======================================================================
+   !!                       ***  MODULE domrea  ***
+   !! Ocean initialization : read the ocean domain meshmask file(s)
+   !!======================================================================
+   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_rea        : read mesh and mask file(s)
+   !!                    nmsh = 1  :   mesh_mask file
+   !!                         = 2  :   mesh and mask file
+   !!                         = 3  :   mesh_hgr, mesh_zgr and mask
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE dommsk          ! domain: masks
+   USE lbclnk          ! lateral boundary condition - MPP exchanges
+   USE trc_oce         ! shared ocean/biogeochemical variables
+   USE lib_mpp 
+   USE in_out_manager
+   USE wrk_nemo  
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_rea    ! routine called by inidom.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dom_rea
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_rea  ***
+      !!                   
+      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the
+      !!      ocean domain informations (mesh and mask arrays). This (these)
+      !!      file(s) is (are) used for visualisation (SAXO software) and
+      !!      diagnostic computation.
+      !!
+      !! ** Method  :   Read in a file all the arrays generated in routines
+      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on
+      !!      the vertical coord. used (z-coord, partial steps, s-coord)
+      !!                    nmsh = 1  :   'mesh_mask.nc' file
+      !!                         = 2  :   'mesh.nc' and mask.nc' files
+      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and
+      !!                                  'mask.nc' files
+      !!      For huge size domain, use option 2 or 3 depending on your 
+      !!      vertical coordinate.
+      !!
+      !! ** input file : 
+      !!      meshmask.nc  : domain size, horizontal grid-point position,
+      !!                     masks, depth and vertical scale factors
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ik, inum0 , inum1 , inum2 , inum3 , inum4   ! local integers
+      REAL(wp) ::   zrefdep         ! local real
+      REAL(wp), POINTER, DIMENSION(:,:) :: zmbk, zprt, zprw
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL wrk_alloc( jpi, jpj, zmbk, zprt, zprw )
+
+      zmbk(:,:) = 0._wp
+
+      SELECT CASE (nmsh)
+         !                                     ! ============================
+         CASE ( 1 )                            !  create 'mesh_mask.nc' file
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" '
+            CALL iom_open( 'mesh_mask', inum0 )
+
+            inum2 = inum0                                            ! put all the informations
+            inum3 = inum0                                            ! in unit inum0
+            inum4 = inum0
+
+            !                                  ! ============================
+         CASE ( 2 )                            !  create 'mesh.nc' and 
+            !                                  !         'mask.nc' files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" '
+            CALL iom_open( 'mesh', inum1 )
+            CALL iom_open( 'mask', inum2 )
+
+            inum3 = inum1                                            ! put mesh informations 
+            inum4 = inum1                                            ! in unit inum1 
+
+            !                                  ! ============================
+         CASE ( 3 )                            !  create 'mesh_hgr.nc'
+            !                                  !         'mesh_zgr.nc' and
+            !                                  !         'mask.nc'     files
+            !                                  ! ============================
+
+            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , "mesh_zgr.nc" and "mask.nc" '
+            CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc'
+            CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc'
+            CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc'
+
+         END SELECT
+
+         !                                                         ! masks (inum2) 
+         CALL iom_get( inum2, jpdom_data, 'tmask', tmask )
+         CALL iom_get( inum2, jpdom_data, 'umask', umask )
+         CALL iom_get( inum2, jpdom_data, 'vmask', vmask )
+         CALL iom_get( inum2, jpdom_data, 'fmask', fmask )
+
+#if defined key_c1d
+         ! set umask and vmask equal tmask in 1D configuration
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********'
+         IF(lwp) WRITE(numout,*) '**********                                                     ********'
+
+         umask(:,:,:) = tmask(:,:,:)
+         vmask(:,:,:) = tmask(:,:,:)
+#endif
+
+#if defined key_degrad
+         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol )
+#endif
+
+         !                                                         ! horizontal mesh (inum3)
+         CALL iom_get( inum3, jpdom_data, 'glamt', glamt )
+         CALL iom_get( inum3, jpdom_data, 'glamu', glamu )
+         CALL iom_get( inum3, jpdom_data, 'glamv', glamv )
+         CALL iom_get( inum3, jpdom_data, 'glamf', glamf )
+
+         CALL iom_get( inum3, jpdom_data, 'gphit', gphit )
+         CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu )
+         CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv )
+         CALL iom_get( inum3, jpdom_data, 'gphif', gphif )
+
+         CALL iom_get( inum3, jpdom_data, 'e1t', e1t )
+         CALL iom_get( inum3, jpdom_data, 'e1u', e1u )
+         CALL iom_get( inum3, jpdom_data, 'e1v', e1v )
+         
+         CALL iom_get( inum3, jpdom_data, 'e2t', e2t )
+         CALL iom_get( inum3, jpdom_data, 'e2u', e2u )
+         CALL iom_get( inum3, jpdom_data, 'e2v', e2v )
+
+         e1e2t(:,:) = e1t(:,:) * e2t(:,:)                              ! surface at T-points
+
+         CALL iom_get( inum3, jpdom_data, 'ff', ff )
+
+         CALL iom_get( inum4, jpdom_data, 'mbathy', zmbk )              ! number of ocean t-points
+         mbathy(:,:) = INT( zmbk(:,:) )
+         
+         CALL zgr_bot_level                                             ! mbk. arrays (deepest ocean t-, u- & v-points
+         !
+         IF( ln_sco ) THEN                                         ! s-coordinate
+            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt )
+            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu )
+            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv )
+            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf )
+            
+            CALL iom_get( inum4, jpdom_unknown, 'gsigt', gsigt ) ! scaling coef.
+            CALL iom_get( inum4, jpdom_unknown, 'gsigw', gsigw )
+            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', gsi3w ) 
+            CALL iom_get( inum4, jpdom_unknown, 'esigt', esigt )
+            CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw )
+
+            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors
+            CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
+            CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
+            CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
+
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+         ENDIF
+
+ 
+         IF( ln_zps ) THEN                                           ! z-coordinate - partial steps
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 )    ! reference depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )    ! reference scale factors
+            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
+            !
+            IF( nmsh <= 6 ) THEN                                        ! 3D vertical scale factors
+               CALL iom_get( inum4, jpdom_data, 'e3t', e3t )
+               CALL iom_get( inum4, jpdom_data, 'e3u', e3u )
+               CALL iom_get( inum4, jpdom_data, 'e3v', e3v )
+               CALL iom_get( inum4, jpdom_data, 'e3w', e3w )
+            ELSE                                                        ! 2D bottom scale factors
+               CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp )
+               CALL iom_get( inum4, jpdom_data, 'e3w_ps', e3wp )
+               !                                                        ! deduces the 3D scale factors
+               DO jk = 1, jpk
+                  e3t(:,:,jk) = e3t_0(jk)                                     ! set to the ref. factors
+                  e3u(:,:,jk) = e3t_0(jk)
+                  e3v(:,:,jk) = e3t_0(jk)
+                  e3w(:,:,jk) = e3w_0(jk)
+               END DO
+               DO jj = 1,jpj                                                  ! adjust the deepest values
+                  DO ji = 1,jpi
+                     ik = mbkt(ji,jj)
+                     e3t(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_0(1) * ( 1._wp - tmask(ji,jj,1) )
+                     e3w(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_0(1) * ( 1._wp - tmask(ji,jj,1) )
+                  END DO
+               END DO
+               DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+                  DO jj = 1, jpjm1
+                     DO ji = 1, jpim1
+                        e3u(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+                        e3v(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
+                     END DO
+                  END DO
+               END DO
+               CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+               CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
+               !
+               DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+                  WHERE( e3u(:,:,jk) == 0._wp )   e3u(:,:,jk) = e3t_0(jk)
+                  WHERE( e3v(:,:,jk) == 0._wp )   e3v(:,:,jk) = e3t_0(jk)
+               END DO
+            END IF
+
+            IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN   ! 3D depth of t- and w-level
+               CALL iom_get( inum4, jpdom_data, 'gdept', gdept )
+               CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw )
+            ELSE                                                           ! 2D bottom depth
+               CALL iom_get( inum4, jpdom_data, 'hdept', zprt )
+               CALL iom_get( inum4, jpdom_data, 'hdepw', zprw )
+               !
+               DO jk = 1, jpk                                              ! deduces the 3D depth
+                  gdept(:,:,jk) = gdept_0(jk)
+                  gdepw(:,:,jk) = gdepw_0(jk)
+               END DO
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     ik = mbkt(ji,jj)
+                     IF( ik > 0 ) THEN
+                        gdepw(ji,jj,ik+1) = zprw(ji,jj)
+                        gdept(ji,jj,ik  ) = zprt(ji,jj)
+                        gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+            !
+         ENDIF
+
+         IF( ln_zco ) THEN           ! Vertical coordinates and scales factors
+            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth
+            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 )
+            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   )
+            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   )
+            DO jk = 1, jpk
+               e3t  (:,:,jk) = e3t_0(jk)                                     ! set to the ref. factors
+               e3u  (:,:,jk) = e3t_0(jk)
+               e3v  (:,:,jk) = e3t_0(jk)
+               e3w  (:,:,jk) = e3w_0(jk)
+               gdept(:,:,jk) = gdept_0(jk)
+               gdepw(:,:,jk) = gdepw_0(jk)
+            END DO
+         ENDIF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_0) )                  ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      ! Control printing : Grid informations (if not restart)
+      ! ----------------
+
+      IF(lwp .AND. .NOT.ln_rstart ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), ji = 1, jpi,10)
+9300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
+            f19.10, 1x, f19.10, 1x, f19.10 )
+
+         WRITE(numout,*)
+         WRITE(numout,*) '          latitude and e2 scale factors'
+         WRITE(numout,*) '          -----------------------------'
+         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
+            &                     gphiv(1,jj), gphif(1,jj),   &
+            &                     e2t  (1,jj), e2u  (1,jj),   &
+            &                     e2v  (1,jj), jj = 1, jpj, 10 )
+      ENDIF
+
+
+      IF( nprint == 1 .AND. lwp ) THEN
+         WRITE(numout,*) '          e1u e2u '
+         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1v e2v  '
+         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
+      ENDIF
+
+      DO jk = 1, jpk
+         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' )
+         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' )
+      END DO
+      !                                     ! ============================
+      !                                     !        close the files 
+      !                                     ! ============================
+      SELECT CASE ( nmsh )
+         CASE ( 1 )                
+            CALL iom_close( inum0 )
+         CASE ( 2 )
+            CALL iom_close( inum1 )
+            CALL iom_close( inum2 )
+         CASE ( 3 )
+            CALL iom_close( inum2 )
+            CALL iom_close( inum3 )
+            CALL iom_close( inum4 )
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw )
+      !
+   END SUBROUTINE dom_rea
+
+
+   SUBROUTINE zgr_bot_level
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE zgr_bot_level  ***
+      !!
+      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays)
+      !!
+      !! ** Method  :   computes from mbathy with a minimum value of 1 over land
+      !!
+      !! ** Action  : - update mbathy: level bathymetry (in level index)
+      !!----------------------------------------------------------------------
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:) :: 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,*) '    ~~~~~~~~~~~~~'
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk )
+      !
+      mbkt(:,:) = MAX( mbathy(:,:) , 1 )    ! bottom k-index of T-level (=1 over land)
+      !
+      DO jj = 1, jpjm1                      ! bottom k-index of u- (v-) level
+         DO ji = 1, jpim1
+            mbku(ji,jj) = MIN(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )
+            mbkv(ji,jj) = MIN(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv  (:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk )
+      !
+   END SUBROUTINE zgr_bot_level
+
+   !!======================================================================
+END MODULE domrea
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90	(revision 3437)
@@ -0,0 +1,562 @@
+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 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 ldfeiv          ! eddy induced velocity coef. 
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE zdfmxl          ! vertical physics: mixed layer depth
+   USE eosbn2          ! equation of state - Brunt Vaisala frequency
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE zpshde          ! z-coord. with partial steps: horizontal derivatives
+   USE in_out_manager  ! I/O manager
+   USE 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   dta_dyn_init   ! called by opa.F90
+   PUBLIC   dta_dyn        ! called by step.F90
+
+   CHARACTER(len=100) ::   cn_dir     = './'    !: Root directory for location of ssr files
+   LOGICAL            ::   ln_dynwzv  = .true.  !: vertical velocity read in a file (T) or computed from u/v (F)
+   LOGICAL            ::   ln_dynbbl  = .true.  !: bbl coef read in a file (T) or computed (F)
+   LOGICAL            ::   ln_degrad  = .false. !: degradation option enabled or not 
+
+   INTEGER  , PARAMETER ::   jpfld = 19     ! maximum number of files to read
+   INTEGER  , SAVE      ::   jf_tem         ! index of temperature
+   INTEGER  , SAVE      ::   jf_sal         ! index of salinity
+   INTEGER  , SAVE      ::   jf_uwd         ! index of u-wind
+   INTEGER  , SAVE      ::   jf_vwd         ! index of v-wind
+   INTEGER  , SAVE      ::   jf_wwd         ! index of w-wind
+   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_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_ubl         ! index of u-bbl coef
+   INTEGER  , SAVE      ::   jf_vbl         ! index of v-bbl coef
+   INTEGER  , SAVE      ::   jf_ahu         ! index of u-diffusivity coef
+   INTEGER  , SAVE      ::   jf_ahv         ! index of v-diffusivity coef 
+   INTEGER  , SAVE      ::   jf_ahw         ! index of w-diffusivity coef
+   INTEGER  , SAVE      ::   jf_eiu         ! index of u-eiv
+   INTEGER  , SAVE      ::   jf_eiv         ! index of v-eiv
+   INTEGER  , SAVE      ::   jf_eiw         ! index of w-eiv
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn  ! structure of input fields (file informations, fields read)
+   !                                               ! 
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta       ! vertical velocity at 2 time step
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) :: wnow       ! vertical velocity at 2 time step
+   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
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: uslpnow    ! zonal isopycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: vslpnow    ! meridional isopycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpinow   ! zonal diapycnal slopes
+   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: wslpjnow   ! meridional diapycnal slopes
+
+   INTEGER :: nrecprev_tem , nrecprev_uwd
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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:  zts    => tsa 
+      USE oce, ONLY:  zuslp  => ua   , zvslp  => va
+      USE oce, ONLY:  zwslpi => rotb , zwslpj => rotn
+      USE oce, ONLY:  zu     => ub   , zv     => vb,  zw => hdivb
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj     ! dummy loop indices
+      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
+      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_tem, iswap_uwd    ! 
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'dta_dyn')
+      !
+      isecsbc = nsec_year + nsec1jan000 
+      !
+      IF( kt == nit000 ) THEN
+         nrecprev_tem = 0
+         nrecprev_uwd = 0
+         !
+         CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==!
+         !
+         IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                       
+            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 dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+            uslpdta (:,:,:,1) = zuslp (:,:,:) 
+            vslpdta (:,:,:,1) = zvslp (:,:,:) 
+            wslpidta(:,:,:,1) = zwslpi(:,:,:) 
+            wslpjdta(:,:,:,1) = zwslpj(:,:,:) 
+         ENDIF
+         IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint )  THEN    ! compute vertical velocity from u/v
+            zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1)
+            zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1)
+            CALL dta_dyn_wzv( zu, zv, zw )
+            wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:)
+         ENDIF
+      ELSE
+         nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2)
+         nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2)
+         !
+         CALL fld_read( kt, 1, sf_dyn )      !==   read data at kt time step   ==!
+         !
+      ENDIF
+      ! 
+      IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace)                       
+         iswap_tem = 0
+         IF(  kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 )  iswap_tem = 1
+         IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data
+            write(numout,*)
+            write(numout,*) ' Compute new slopes at kt = ', kt
+            IF( sf_dyn(jf_tem)%ln_tint ) THEN                 ! time interpolation of data
+               IF( kt /= nit000 ) THEN
+                  uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data
+                  vslpdta (:,:,:,1) =  vslpdta (:,:,:,2)  
+                  wslpidta(:,:,:,1) =  wslpidta(:,:,:,2) 
+                  wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2) 
+               ENDIF
+               !
+               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 dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+               !
+               uslpdta (:,:,:,2) = zuslp (:,:,:) 
+               vslpdta (:,:,:,2) = zvslp (:,:,:) 
+               wslpidta(:,:,:,2) = zwslpi(:,:,:) 
+               wslpjdta(:,:,:,2) = zwslpj(:,:,:) 
+            ELSE
+               zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)
+               zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)
+               avt(:,:,:)        = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)
+               CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
+               uslpnow (:,:,:)   = zuslp (:,:,:) 
+               vslpnow (:,:,:)   = zvslp (:,:,:) 
+               wslpinow(:,:,:)   = zwslpi(:,:,:) 
+               wslpjnow(:,:,:)   = zwslpj(:,:,:) 
+            ENDIF
+         ENDIF
+         IF( sf_dyn(jf_tem)%ln_tint )  THEN
+            ztinta =  REAL( isecsbc - 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
+            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)  
+         ELSE
+            uslp (:,:,:) = uslpnow (:,:,:)
+            vslp (:,:,:) = vslpnow (:,:,:)
+            wslpi(:,:,:) = wslpinow(:,:,:)
+            wslpj(:,:,:) = wslpjnow(:,:,:)
+         ENDIF
+      ENDIF
+      !
+      IF( ln_dynwzv )  THEN    ! compute vertical velocity from u/v
+         iswap_uwd = 0
+         IF(  kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 )  iswap_uwd = 1
+         IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 )  THEN    ! read/update the after data
+            write(numout,*)
+            write(numout,*) ' Compute new vertical velocity at kt = ', kt
+            write(numout,*)
+            IF( sf_dyn(jf_uwd)%ln_tint ) THEN                 ! time interpolation of data
+               IF( kt /= nit000 )  THEN
+                  wdta(:,:,:,1) =  wdta(:,:,:,2)     ! swap the data for initialisation
+               ENDIF
+               zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2)
+               zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2)
+               CALL dta_dyn_wzv( zu, zv, zw )
+               wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
+            ELSE
+               zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) 
+               zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:)
+               CALL dta_dyn_wzv( zu, zv, zw )
+               wnow(:,:,:)  = zw(:,:,:) * tmask(:,:,:)
+            ENDIF
+         ENDIF
+         IF( sf_dyn(jf_uwd)%ln_tint )  THEN
+            ztinta =  REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp )  &
+               &    / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp )
+            ztintb =  1. - ztinta
+            wn(:,:,:) = ztintb * wdta(:,:,:,1)  + ztinta * wdta(:,:,:,2)  
+         ELSE
+            wn(:,:,:) = wnow(:,:,:)
+         ENDIF
+      ENDIF
+      !
+      tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)    ! temperature
+      tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)    ! salinity
+      !
+      CALL eos    ( tsn, rhd, rhop )                                       ! In any case, we need rhop
+      CALL zdf_mxl( kt )                                                   ! In any case, we need mxl 
+      !
+      avt(:,:,:)       = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)    ! vertical diffusive coefficient 
+      un (:,:,:)       = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:)    ! u-velocity
+      vn (:,:,:)       = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:)    ! v-velocity 
+      IF( .NOT.ln_dynwzv ) &                                           ! w-velocity read in file 
+         wn (:,:,:)    = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)    
+      hmld(:,:)        = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1)    ! mixed layer depht
+      wndm(:,:)        = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1)    ! wind speed - needed for gas exchange
+      emp (:,:)        = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1)    ! E-P
+      emps(:,:)        = emp(:,:) 
+      fr_i(:,:)        = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1)     ! Sea-ice fraction
+      qsr (:,:)        = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1)    ! solar radiation
+
+      !                                                      ! bbl diffusive coef
+#if defined key_trabbl && ! defined key_c1d
+      IF( ln_dynbbl ) THEN                                        ! read in a file
+         ahu_bbl(:,:)  = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)
+         ahv_bbl(:,:)  = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1)
+      ELSE                                                        ! Compute bbl coefficients if needed
+         tsb(:,:,:,:) = tsn(:,:,:,:)
+         CALL bbl( kt, nit000, 'TRC')
+      END IF
+#endif
+#if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d 
+      aeiw(:,:)        = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1)    ! w-eiv
+      !                                                           ! Computes the horizontal values from the vertical value
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )  ! Average the diffusive coefficient at u- v- points
+            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )  ! at u- v- points
+         END DO
+      END DO
+      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition
+#endif
+      
+#if defined key_degrad && ! defined key_c1d 
+      !                                          ! degrad option : diffusive and eiv coef are 3D
+      ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)
+      ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)
+      ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)
+#  if defined key_traldf_eiv 
+      aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)
+      aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)
+      aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)
+#  endif
+#endif
+      !
+      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(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=emps             , clinfo1=' emps    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 )
+      ENDIF
+      !
+      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
+      !!
+      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_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd  ! informations about the fields to be read
+      TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl          !   "                                 "
+      TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw          !   "                                 "
+      !
+      NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad,    &
+         &                sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd,  &
+         &                sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl,          &
+         &                sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw
+
+      !!----------------------------------------------------------------------
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      ! (NB: frequency positive => hours, negative => months)
+      !                !   file      ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   !
+      !                !   name      !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      !
+      sn_tem  = FLD_N( 'dyna_grid_T' ,    120    , 'votemper' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_sal  = FLD_N( 'dyna_grid_T' ,    120    , 'vosaline' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_mld  = FLD_N( 'dyna_grid_T' ,    120    , 'somixght' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_emp  = FLD_N( 'dyna_grid_T' ,    120    , 'sowaflcd' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_ice  = FLD_N( 'dyna_grid_T' ,    120    , 'soicecov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_qsr  = FLD_N( 'dyna_grid_T' ,    120    , 'soshfldo' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_wnd  = FLD_N( 'dyna_grid_T' ,    120    , 'sowindsp' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_uwd  = FLD_N( 'dyna_grid_U' ,    120    , 'vozocrtx' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_vwd  = FLD_N( 'dyna_grid_V' ,    120    , 'vomecrty' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_wwd  = FLD_N( 'dyna_grid_W' ,    120    , 'vovecrtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_avt  = FLD_N( 'dyna_grid_W' ,    120    , 'votkeavt' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_ubl  = FLD_N( 'dyna_grid_U' ,    120    , 'sobblcox' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_vbl  = FLD_N( 'dyna_grid_V' ,    120    , 'sobblcoy' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_ahu  = FLD_N( 'dyna_grid_U' ,    120    , 'vozoahtu' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_ahv  = FLD_N( 'dyna_grid_V' ,    120    , 'vomeahtv' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_ahw  = FLD_N( 'dyna_grid_W' ,    120    , 'voveahtz' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_eiu  = FLD_N( 'dyna_grid_U' ,    120    , 'vozoaeiu' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_eiv  = FLD_N( 'dyna_grid_V' ,    120    , 'vomeaeiv' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_eiw  = FLD_N( 'dyna_grid_W' ,    120    , 'voveaeiw' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+      !
+      REWIND( numnam )                          ! read in namlist namdta_dyn
+      READ  ( numnam, 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,*) '      vertical velocity read from file (T) or computed (F) ln_dynwzv  = ', ln_dynwzv
+         WRITE(numout,*) '      bbl coef read from file (T) or computed (F)          ln_dynbbl  = ', ln_dynbbl
+         WRITE(numout,*) '      degradation option enabled (T) or not (F)            ln_degrad  = ', ln_degrad
+         WRITE(numout,*)
+      ENDIF
+      ! 
+      IF( ln_degrad .AND. .NOT.lk_degrad ) THEN
+         CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )
+         ln_degrad = .FALSE.
+      ENDIF
+      IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN
+         CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' )
+         ln_dynbbl = .FALSE.
+      ENDIF
+
+      jf_tem = 1   ;   jf_sal = 2   ;  jf_mld = 3   ;  jf_emp = 4   ;   jf_ice = 5   ;   jf_qsr = 6 
+      jf_wnd = 7   ;   jf_uwd = 8   ;  jf_vwd = 9   ;  jf_wwd = 10  ;   jf_avt = 11  ;   jfld  = 11
+      !
+      slf_d(jf_tem) = sn_tem   ;   slf_d(jf_sal) = sn_sal   ;   slf_d(jf_mld) = sn_mld
+      slf_d(jf_emp) = sn_emp   ;   slf_d(jf_ice) = sn_ice   ;   slf_d(jf_qsr) = sn_qsr
+      slf_d(jf_wnd) = sn_wnd   ;   slf_d(jf_uwd) = sn_uwd   ;   slf_d(jf_vwd) = sn_vwd
+      slf_d(jf_wwd) = sn_wwd   ;   slf_d(jf_avt) = sn_avt 
+      !
+      IF( .NOT.ln_degrad ) THEN     ! no degrad option
+         IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN        ! eiv & bbl
+                 jf_ubl  = 12      ;         jf_vbl  = 13      ;         jf_eiw  = 14   ;   jfld = 14
+           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  ;   slf_d(jf_eiw) = sn_eiw
+         ENDIF
+         IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN   ! no eiv & bbl
+                 jf_ubl  = 12      ;         jf_vbl  = 13      ;   jfld = 13
+           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
+         ENDIF
+         IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN   ! eiv & no bbl
+           jf_eiw = 12   ;   jfld = 12   ;   slf_d(jf_eiw) = sn_eiw
+         ENDIF
+      ELSE
+              jf_ahu  = 12      ;         jf_ahv  = 13      ;         jf_ahw  = 14   ;   jfld = 14
+        slf_d(jf_ahu) = sn_ahu  ;   slf_d(jf_ahv) = sn_ahv  ;   slf_d(jf_ahw) = sn_ahw
+        IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN         ! eiv & bbl
+                 jf_ubl  = 15      ;         jf_vbl  = 16      
+           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl  
+                 jf_eiu  = 17      ;         jf_eiv  = 18      ;          jf_eiw  = 19   ;   jfld = 19
+           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;    slf_d(jf_eiw) = sn_eiw
+        ENDIF
+        IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN    ! no eiv & bbl
+                 jf_ubl  = 15      ;         jf_vbl  = 16      ;   jfld = 16
+           slf_d(jf_ubl) = sn_ubl  ;   slf_d(jf_vbl) = sn_vbl
+        ENDIF
+        IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN    ! eiv & no bbl
+                 jf_eiu  = 15      ;         jf_eiv  = 16      ;         jf_eiw  = 17   ;   jfld = 17
+           slf_d(jf_eiu) = sn_eiu  ;   slf_d(jf_eiv) = sn_eiv  ;   slf_d(jf_eiw) = sn_eiw
+        ENDIF
+      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
+      ! Open file for each variable to get his number of dimension
+      DO ifpr = 1, jfld
+         CALL iom_open( slf_d(ifpr)%clname, inum )
+         idv   = iom_varid( inum , slf_d(ifpr)%clvar )  ! id of the variable sdjf%clvar
+         idimv = iom_file ( inum )%ndims(idv)             ! number of dimension for variable sdjf%clvar
+         IF( inum /= 0 )   CALL iom_close( inum )       ! close file if already open
+         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
+      !                                         ! fill sf with slf_i and control print
+      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
+      !
+      IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN                  ! slopes 
+         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 )
+         ELSE
+            ALLOCATE( uslpnow (jpi,jpj,jpk)  , vslpnow (jpi,jpj,jpk)  ,    &
+            &         wslpinow(jpi,jpj,jpk)  , wslpjnow(jpi,jpj,jpk)  , STAT=ierr2 )
+         ENDIF 
+         IF( ierr2 > 0 ) THEN
+            CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' )   ;   RETURN
+         ENDIF
+      ENDIF
+      IF( ln_dynwzv ) THEN                  ! slopes 
+         IF( sf_dyn(jf_uwd)%ln_tint ) THEN      ! time interpolation
+            ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 )
+         ELSE
+            ALLOCATE( wnow(jpi,jpj,jpk)  , STAT=ierr3 )
+         ENDIF 
+         IF( ierr3 > 0 ) THEN
+            CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' )   ;   RETURN
+         ENDIF
+      ENDIF
+      !
+      CALL dta_dyn( nit000 )
+      !
+   END SUBROUTINE dta_dyn_init
+
+   SUBROUTINE dta_dyn_wzv( pu, pv, pw )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE wzv  ***
+      !!
+      !! ** Purpose :   Compute the now vertical velocity after the array swap
+      !!
+      !! ** Method  : - compute the now divergence given by :
+      !!         * z-coordinate ONLY !!!!
+      !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ]
+      !!     - Using the incompressibility hypothesis, the vertical
+      !!      velocity is computed by integrating the horizontal divergence
+      !!      from the bottom to the surface.
+      !!        The boundary conditions are w=0 at the bottom (no flux).
+      !!----------------------------------------------------------------------
+      USE oce, ONLY:  zhdiv => hdivn
+      !
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  vertical velocity
+      !!
+      INTEGER  ::  ji, jj, jk
+      REAL(wp) ::  zu, zu1, zv, zv1, zet
+      !!----------------------------------------------------------------------
+      !
+      ! Computation of vertical velocity using horizontal divergence
+      zhdiv(:,:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk)
+               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk)
+               zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) * fse3v(ji  ,jj  ,jk)
+               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk)
+               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zhdiv, 'T', 1. )      ! Lateral boundary conditions on zhdiv
+      !
+      ! computation of vertical velocity from the bottom
+      pw(:,:,jpk) = 0._wp
+      DO jk = jpkm1, 1, -1
+         pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
+      END DO
+      !
+   END SUBROUTINE dta_dyn_wzv
+
+   SUBROUTINE dta_dyn_slp( 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 defined key_ldfslp && ! defined key_c1d
+      CALL eos( pts, rhd, rhop )   ! Time-filtered in situ density 
+      CALL bn2( pts, rn2 )         ! before Brunt-Vaisala frequency
+      IF( ln_zps )   &
+         &  CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv )  ! Partial steps: before Horizontal DErivative
+         !                                                            ! of t, s, rd at the bottom ocean level
+      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 dta_dyn_slp
+   !!======================================================================
+END MODULE dtadyn
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/istate.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/istate.F90	(revision 3437)
@@ -0,0 +1,51 @@
+MODULE istate
+   !!======================================================================
+   !!                     ***  MODULE  istate  ***
+   !! Ocean state   :  initial state setting, off-line case
+   !!=====================================================================
+   !! History :  3.3  ! 2010-10  (C. Ethe)  original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   istate_init   : initial state set to zero
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization to zero of the dynamics and tracers.
+      !!----------------------------------------------------------------------
+      !
+      !     now fields         !     after fields      !
+      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   !
+      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   !
+      wn   (:,:,:)   = 0._wp   !                       !
+      hdivn(:,:,:)   = 0._wp   !                       !
+      tsn  (:,:,:,:) = 0._wp   !                       !
+      !
+      rhd  (:,:,:) = 0.e0
+      rhop (:,:,:) = 0.e0
+      rn2  (:,:,:) = 0.e0 
+      !
+   END SUBROUTINE istate_init
+
+   !!=====================================================================
+END MODULE istate
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90	(revision 3437)
@@ -0,0 +1,649 @@
+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
+   !!            4.0  ! 2011-01  (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 c1d             ! 1D configuration
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE 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 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
+   USE stpctl          ! time stepping control            (stp_ctl routine)
+   !              ! I/O & MPP
+   USE iom             ! I/O library
+   USE in_out_manager  ! I/O manager
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE lib_mpp         ! distributed memory computing
+#if defined key_iomput
+   USE mod_ioclient
+#endif 
+   USE prtctl          ! Print control                    (prt_ctl_init routine)
+   USE timing          ! Timing
+
+   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: nemogcm.F90 2528 2010-12-27 17:33:53Z rblod $
+   !! 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
+
+      IF( lk_mpp )   CALL mpp_max( nstop )
+
+      ! 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
+         !
+      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping
+         !
+         IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init)
+                                CALL iom_setkt( istp )         ! say to iom that we are at time step kstp
+                                CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields
+                                CALL trc_stp  ( istp )         ! time-stepping
+                                CALL stp_ctl  ( istp, indic )  ! Time loop: control and print
+         istp = istp + 1
+         IF( lk_mpp )   CALL mpp_max( nstop )
+      END DO
+
+      !                            !------------------------!
+      !                            !==  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( lk_mpp )   CALL mppstop                          ! Close all files (mpp)
+      !
+   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
+      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
+      !!----------------------------------------------------------------------
+      !
+      !                             ! open Namelist file     
+      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection
+#else
+      ilocal_comm = 0
+      narea = mynode( cltxt, numnam, nstop )                 ! Nodes selection (control print return in cltxt)
+#endif
+
+      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print
+
+      ! If 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   ||   defined key_mpp_shmem
+         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.
+      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'
+         WRITE(numout,*) '                       NEMO team'
+         WRITE(numout,*) '            Ocean General Circulation Model'
+         WRITE(numout,*) '                  version 3.3  (2010) '
+         WRITE(numout,*)
+         WRITE(numout,*)
+         DO ji = 1, SIZE(cltxt) 
+            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
+         END DO
+         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
+         !
+      ENDIF
+
+      ! 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
+                            CALL     dom_cfg    ! Domain 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
+
+      !                                     ! Ocean physics
+                            CALL     sbc_init   ! Forcings : surface module
+#if ! defined key_degrad
+                            CALL ldf_tra_init   ! Lateral ocean tracer physics
+#endif
+      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing
+
+      !                                     ! Active tracers
+                            CALL tra_qsr_init   ! penetrative solar radiation qsr
+      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+
+      !                                     ! Passive tracers
+                            CALL     trc_init   ! Passive tracers initialization
+      !                                     ! Dynamics
+                            CALL dta_dyn_init   ! Initialization for the dynamics
+                            CALL     iom_init       ! iom_put initialization
+
+      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
+      !
+      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                  ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_flg: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+      ENDIF
+      !
+      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
+      nictls    = nn_ictls
+      nictle    = nn_ictle
+      njctls    = nn_jctls
+      njctle    = nn_jctle
+      isplt     = nn_isplt
+      jsplt     = nn_jsplt
+      nbench    = nn_bench
+      !                             ! Parameter control
+      !
+      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
+         IF( lk_mpp ) THEN
+            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain
+         ELSE
+            IF( isplt == 1 .AND. jsplt == 1  ) THEN
+               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
+                  &           ' - the print control will be done over the whole domain' )
+            ENDIF
+            ijsplt = isplt * jsplt            ! total number of processors ijsplt
+         ENDIF
+         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
+         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
+         !
+         !                              ! indices used for the SUM control
+         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
+            lsp_area = .FALSE.
+         ELSE                                             ! print control done over a specific  area
+            lsp_area = .TRUE.
+            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
+               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
+               nictls = 1
+            ENDIF
+            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
+               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
+               nictle = jpiglo
+            ENDIF
+            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
+               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
+               njctls = 1
+            ENDIF
+            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
+               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
+               njctle = jpjglo
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+      IF( nbench == 1 )   THEN            ! Benchmark 
+         SELECT CASE ( cp_cfg )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' key_gyre must be used or set nbench = 0' )
+         END SELECT
+      ENDIF
+      !
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '        ,   &
+         &                                               'Compile with key_iomput enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF ( lk_mpp ) CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file
+      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist
+      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file
+      numout = 6                                     ! redefine numout in case it is used after this point...
+      !
+   END SUBROUTINE 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 ldftra_oce,   ONLY: ldftra_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 + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
+      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.
+      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
+         &                            128,   64,   32,   16,    8,   4,   2  /
+      !!----------------------------------------------------------------------
+
+      ! 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 peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
+      !!----------------------------------------------------------------------
+
+      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
+      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
+      INTEGER ::   northcomms_alloc        ! allocate return status
+      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
+      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
+      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
+      IF( northcomms_alloc /= 0 ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
+         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
+      ENDIF
+      nsndto = 0
+      isendto = -1
+      ijpj   = 4
+      !
+      ! This routine has been called because ln_nnogather has been set true ( nammpp )
+      ! However, these first few exchanges have to use the mpi_allgather method to
+      ! establish the neighbour lists to use in subsequent peer to peer exchanges.
+      ! Consequently, set l_north_nogather to be false here and set it true only after
+      ! the lists have been established.
+      !
+      l_north_nogather = .FALSE.
+      !
+      ! Exchange and store ranks on northern rows
+
+      DO jtyp = 1,4
+
+         lrankset = .FALSE.
+         znnbrs = narea
+         SELECT CASE (jtyp)
+            CASE(1)
+               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
+            CASE(2)
+               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
+            CASE(3)
+               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
+            CASE(4)
+               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
+         END SELECT
+
+         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+            DO jj = nlcj-ijpj+1, nlcj
+               ij = jj - nlcj + ijpj
+               DO ji = 1,jpi
+                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+               &     lrankset(INT(znnbrs(ji,jj))) = .true.
+               END DO
+            END DO
+
+            DO jj = 1,jpnij
+               IF ( lrankset(jj) ) THEN
+                  nsndto(jtyp) = nsndto(jtyp) + 1
+                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+                  &                 ' jpmaxngh will need to be increased ')
+                  ENDIF
+                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+               ENDIF
+            END DO
+         ENDIF
+
+      END DO
+
+      !
+      ! Type 5: I-point
+      !
+      ! ICE point exchanges may involve some averaging. The neighbours list is
+      ! built up using two exchanges to ensure that the whole stencil is covered.
+      ! lrankset should not be reset between these 'J' and 'K' point exchanges
+
+      jtyp = 5
+      lrankset = .FALSE.
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+            &     lrankset(INT(znnbrs(ji,jj))) = .true.
+         END DO
+        END DO
+      ENDIF
+
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) &
+            &       lrankset( INT(znnbrs(ji,jj))) = .true.
+            END DO
+         END DO
+
+         DO jj = 1,jpnij
+            IF ( lrankset(jj) ) THEN
+               nsndto(jtyp) = nsndto(jtyp) + 1
+               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+               &                 ' jpmaxngh will need to be increased ')
+               ENDIF
+               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+            ENDIF
+         END DO
+         !
+         ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
+         ! can use peer to peer communications at the north fold
+         !
+         l_north_nogather = .TRUE.
+         !
+      ENDIF
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/stpctl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OFF_SRC/stpctl.F90	(revision 3437)
@@ -0,0 +1,62 @@
+MODULE stpctl
+   !!======================================================================
+   !!                       ***  MODULE  stpctl  ***
+   !! Ocean run control :  Off-line case, only save the time step in numstp
+   !!======================================================================
+   !! History :  OPA  ! 1991-03  (G. Madec) Original code
+   !!            6.0  ! 1992-06  (M. Imbard)
+   !!            8.0  ! 1997-06  (A.M. Treguier)
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp_ctl      : Control the run
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp_ctl    ! routine called by opa.F90
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OFF 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE stp_ctl( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE stp_ctl  ***
+      !!                     
+      !! ** Purpose :   Control the run
+      !!
+      !! ** Method  : - Save the time step in numstp
+      !!
+      !! ** Actions :   'time.step' file containing the last ocean time-step
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index
+      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'stp_ctl : time-stepping control'
+         WRITE(numout,*) '~~~~~~~'
+         ! open time.step file
+         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+      !
+      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp
+      IF(lwp) REWIND( numstp )                       !  --------------------------
+      !
+   END SUBROUTINE stp_ctl
+
+   !!======================================================================
+END MODULE stpctl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90	(revision 3437)
@@ -0,0 +1,905 @@
+MODULE asminc
+   !!======================================================================
+   !!                       ***  MODULE asminc  ***
+   !! Assimilation increment : Apply an increment generated by data
+   !!                          assimilation
+   !!======================================================================
+   !! History :       ! 2007-03  (M. Martin)  Met Office version
+   !!                 ! 2007-04  (A. Weaver)  calc_date original code
+   !!                 ! 2007-04  (A. Weaver)  Merge with OPAVAR/NEMOVAR
+   !!   NEMO     3.3  ! 2010-05  (D. Lea)  Update to work with NEMO v3.2
+   !!             -   ! 2010-05  (D. Lea)  add calc_month_len routine based on day_init 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_inc_init : Initialize the increment arrays and IAU weights
+   !!   calc_date    : Compute the calendar date YYYYMMDD on a given step
+   !!   tra_asm_inc  : Apply the tracer (T and S) increments
+   !!   dyn_asm_inc  : Apply the dynamic (u and v) increments
+   !!   ssh_asm_inc  : Apply the SSH increment
+   !!----------------------------------------------------------------------
+   USE wrk_nemo         ! Memory Allocation
+   USE par_oce          ! Ocean space and time domain variables
+   USE dom_oce          ! Ocean space and time domain
+   USE oce              ! Dynamics and active tracers defined in memory
+   USE divcur           ! Horizontal divergence and relative vorticity
+   USE ldfdyn_oce       ! ocean dynamics: lateral physics
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_inc_init   !: Initialize the increment arrays and IAU weights
+   PUBLIC   calc_date      !: Compute the calendar date YYYYMMDD on a given step
+   PUBLIC   tra_asm_inc    !: Apply the tracer (T and S) increments
+   PUBLIC   dyn_asm_inc    !: Apply the dynamic (u and v) increments
+   PUBLIC   ssh_asm_inc    !: Apply the SSH increment
+
+#if defined key_asminc
+    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .TRUE.   !: Logical switch for assimilation increment interface
+#else
+    LOGICAL, PUBLIC, PARAMETER :: lk_asminc = .FALSE.  !: No assimilation increments
+#endif
+   LOGICAL, PUBLIC :: ln_bkgwri = .FALSE. !: No output of the background state fields
+   LOGICAL, PUBLIC :: ln_trjwri = .FALSE. !: No output of the state trajectory fields
+   LOGICAL, PUBLIC :: ln_asmiau = .FALSE. !: No applying forcing with an assimilation increment
+   LOGICAL, PUBLIC :: ln_asmdin = .FALSE. !: No direct initialization
+   LOGICAL, PUBLIC :: ln_trainc = .FALSE. !: No tracer (T and S) assimilation increments
+   LOGICAL, PUBLIC :: ln_dyninc = .FALSE. !: No dynamics (u and v) assimilation increments
+   LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment
+   LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check
+   INTEGER, PUBLIC :: nn_divdmp = 0       !: 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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_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 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
+      INTEGER :: jt
+      INTEGER :: imid
+      INTEGER :: inum
+      INTEGER :: iiauper         ! Number of time steps in the IAU period
+      INTEGER :: icycper         ! Number of time steps in the cycle
+      INTEGER :: iitend_date     ! Date YYYYMMDD of final time step
+      INTEGER :: iitbkg_date     ! Date YYYYMMDD of background time step for Jb term
+      INTEGER :: iitdin_date     ! Date YYYYMMDD of background time step for DI
+      INTEGER :: iitiaustr_date  ! Date YYYYMMDD of IAU interval start time step
+      INTEGER :: iitiaufin_date  ! Date YYYYMMDD of IAU interval final time step
+
+      REAL(wp) :: znorm        ! Normalization factor for IAU weights
+      REAL(wp) :: ztotwgt      ! Value of time-integrated IAU weights 
+                               ! (should be equal to one)
+      REAL(wp) :: z_inc_dateb  ! Start date of interval on which increment is valid
+      REAL(wp) :: z_inc_datef  ! End date of interval on which increment is valid
+      REAL(wp) :: zdate_bkg    ! Date in background state file for DI
+      REAL(wp) :: zdate_inc    ! Time axis in increments file
+
+      REAL(wp), POINTER, DIMENSION(:,:) :: hdiv
+      !!
+      NAMELIST/nam_asminc/ ln_bkgwri, ln_trjwri,                           &
+         &                 ln_trainc, ln_dyninc, ln_sshinc,                &
+         &                 ln_asmdin, ln_asmiau,                           &
+         &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
+         &                 nittrjfrq, ln_salfix, salfixmin,                &
+         &                 nn_divdmp
+      !!----------------------------------------------------------------------
+
+      !-----------------------------------------------------------------------
+      ! Read Namelist nam_asminc : assimilation increment interface
+      !-----------------------------------------------------------------------
+
+      ! Set default values
+      ln_bkgwri = .FALSE.
+      ln_trjwri = .FALSE.
+      ln_trainc = .FALSE.
+      ln_dyninc = .FALSE.
+      ln_sshinc = .FALSE.
+      ln_asmdin = .FALSE.
+      ln_asmiau = .TRUE.
+      ln_salfix = .FALSE.
+      salfixmin = -9999
+      nitbkg    = 0
+      nitdin    = 0      
+      nitiaustr = 1
+      nitiaufin = 150      ! = 10 days with ORCA2
+      niaufn    = 0
+      nittrjfrq = 1
+
+      REWIND ( numnam )
+      READ   ( numnam, nam_asminc )
+
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namasm : set assimilation increment parameters'
+         WRITE(numout,*) '      Logical switch for writing out background state          ln_bkgwri = ', ln_bkgwri
+         WRITE(numout,*) '      Logical switch for writing out state trajectory          ln_trjwri = ', ln_trjwri
+         WRITE(numout,*) '      Logical switch for applying tracer increments            ln_trainc = ', ln_trainc
+         WRITE(numout,*) '      Logical switch for applying velocity increments          ln_dyninc = ', ln_dyninc
+         WRITE(numout,*) '      Logical switch for applying SSH increments               ln_sshinc = ', ln_sshinc
+         WRITE(numout,*) '      Logical switch for Direct Initialization (DI)            ln_asmdin = ', ln_asmdin
+         WRITE(numout,*) '      Logical switch for Incremental Analysis Updating (IAU)   ln_asmiau = ', ln_asmiau
+         WRITE(numout,*) '      Timestep of background in [0,nitend-nit000-1]            nitbkg    = ', nitbkg
+         WRITE(numout,*) '      Timestep of background for DI in [0,nitend-nit000-1]     nitdin    = ', nitdin
+         WRITE(numout,*) '      Timestep of start of IAU interval in [0,nitend-nit000-1] nitiaustr = ', nitiaustr
+         WRITE(numout,*) '      Timestep of end of IAU interval in [0,nitend-nit000-1]   nitiaufin = ', nitiaufin
+         WRITE(numout,*) '      Type of IAU weighting function                           niaufn    = ', niaufn
+         WRITE(numout,*) '      Frequency of trajectory output for 4D-VAR                nittrjfrq = ', nittrjfrq
+         WRITE(numout,*) '      Logical switch for ensuring that the sa > salfixmin      ln_salfix = ', ln_salfix
+         WRITE(numout,*) '      Minimum salinity after applying the increments           salfixmin = ', salfixmin
+      ENDIF
+
+      nitbkg_r    = nitbkg    + nit000 - 1  ! Background time referenced to nit000
+      nitdin_r    = nitdin    + nit000 - 1  ! Background time for DI referenced to nit000
+      nitiaustr_r = nitiaustr + nit000 - 1  ! Start of IAU interval referenced to nit000
+      nitiaufin_r = nitiaufin + nit000 - 1  ! End of IAU interval referenced to nit000
+
+      iiauper = nitiaufin_r - nitiaustr_r + 1  ! IAU interval length
+      icycper = nitend      - nit000      + 1  ! Cycle interval length
+
+      ! Date of final time step
+      CALL calc_date( nit000, nitend, ndate0, iitend_date )
+
+      ! Background time for Jb referenced to ndate0
+      CALL calc_date( nit000, nitbkg_r, ndate0, iitbkg_date )
+
+      ! Background time for DI referenced to ndate0
+      CALL calc_date( nit000, nitdin_r, ndate0, iitdin_date )
+
+      ! IAU start time referenced to ndate0
+      CALL calc_date( nit000, nitiaustr_r, ndate0, iitiaustr_date )
+
+      ! IAU end time referenced to ndate0
+      CALL calc_date( nit000, nitiaufin_r, ndate0, iitiaufin_date )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Time steps referenced to current cycle:'
+         WRITE(numout,*) '       iitrst      = ', nit000 - 1
+         WRITE(numout,*) '       nit000      = ', nit000
+         WRITE(numout,*) '       nitend      = ', nitend
+         WRITE(numout,*) '       nitbkg_r    = ', nitbkg_r
+         WRITE(numout,*) '       nitdin_r    = ', nitdin_r
+         WRITE(numout,*) '       nitiaustr_r = ', nitiaustr_r
+         WRITE(numout,*) '       nitiaufin_r = ', nitiaufin_r
+         WRITE(numout,*) '       nittrjfrq   = ', nittrjfrq
+         WRITE(numout,*)
+         WRITE(numout,*) '   Dates referenced to current cycle:'
+         WRITE(numout,*) '       ndastp         = ', ndastp
+         WRITE(numout,*) '       ndate0         = ', ndate0
+         WRITE(numout,*) '       iitend_date    = ', iitend_date
+         WRITE(numout,*) '       iitbkg_date    = ', iitbkg_date
+         WRITE(numout,*) '       iitdin_date    = ', iitdin_date
+         WRITE(numout,*) '       iitiaustr_date = ', iitiaustr_date
+         WRITE(numout,*) '       iitiaufin_date = ', iitiaufin_date
+      ENDIF
+
+      IF ( nacc /= 0 ) &
+         & CALL ctl_stop( ' nacc /= 0 and key_asminc :',  &
+         &                ' Assimilation increments have only been implemented', &
+         &                ' for synchronous time stepping' )
+
+      IF ( ( ln_asmdin ).AND.( ln_asmiau ) )   &
+         & CALL ctl_stop( ' ln_asmdin and ln_asmiau :', &
+         &                ' Choose Direct Initialization OR Incremental Analysis Updating')
+
+      IF (      ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) &
+           .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) ) &
+         & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc and ln_sshinc is set to .true.', &
+         &                ' but ln_asmdin and ln_asmiau are both set to .false. :', &
+         &                ' Inconsistent options')
+
+      IF ( ( ln_bkgwri ).AND.( ( ln_asmdin ).OR.( ln_asmiau ) ) )  &
+         & CALL ctl_stop( ' ln_bkgwri and either ln_asmdin or ln_asmiau are set to .true.:', &
+         &                ' The background state must be written before applying the increments')
+
+      IF ( ( niaufn /= 0 ).AND.( niaufn /= 1 ) ) &
+         & CALL ctl_stop( ' niaufn /= 0 or niaufn /=1 :',  &
+         &                ' Type IAU weighting function is invalid')
+
+      IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ) &
+         &                     )  &
+         & CALL ctl_warn( ' ln_trainc, ln_dyninc and ln_sshinc are set to .false. :', &
+         &                ' The assimilation increments are not applied')
+
+      IF ( ( ln_asmiau ).AND.( nitiaustr == nitiaufin ) ) &
+         & CALL ctl_stop( ' nitiaustr = nitiaufin :',  &
+         &                ' IAU interval is of zero length')
+
+      IF ( ( ln_asmiau ).AND.( ( nitiaustr_r < nit000 ).OR.( nitiaufin_r > nitend ) ) ) &
+         & CALL ctl_stop( ' nitiaustr or nitiaufin :',  &
+         &                ' IAU starting or final time step is outside the cycle interval', &
+         &                 ' Valid range nit000 to nitend')
+
+      IF ( ( nitbkg_r < nit000 - 1 ).OR.( nitbkg_r > nitend ) ) &
+         & CALL ctl_stop( ' nitbkg :',  &
+         &                ' Background time step is outside the cycle interval')
+
+      IF ( ( nitdin_r < nit000 - 1 ).OR.( nitdin_r > nitend ) ) &
+         & CALL ctl_stop( ' nitdin :',  &
+         &                ' Background time step for Direct Initialization is outside', &
+         &                ' the cycle interval')
+
+      IF ( nstop > 0 ) RETURN       ! if there are any errors then go no further
+
+      !--------------------------------------------------------------------
+      ! Initialize the Incremental Analysis Updating weighting function
+      !--------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         ALLOCATE( wgtiau( icycper ) )
+
+         wgtiau(:) = 0.0
+
+         IF ( niaufn == 0 ) THEN
+
+            !---------------------------------------------------------
+            ! Constant IAU forcing 
+            !---------------------------------------------------------
+
+            DO jt = 1, iiauper
+               wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper )
+            END DO
+
+         ELSEIF ( niaufn == 1 ) THEN
+
+            !---------------------------------------------------------
+            ! Linear hat-like, centred in middle of IAU interval 
+            !---------------------------------------------------------
+
+            ! Compute the normalization factor
+            znorm = 0.0
+            IF ( MOD( iiauper, 2 ) == 0 ) THEN  ! Even number of time steps in IAU interval
+               imid = iiauper / 2 
+               DO jt = 1, imid
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm
+            ELSE                               ! Odd number of time steps in IAU interval
+               imid = ( iiauper + 1 ) / 2        
+               DO jt = 1, imid - 1
+                  znorm = znorm + REAL( jt )
+               END DO
+               znorm = 2.0 * znorm + REAL( imid )
+            ENDIF
+            znorm = 1.0 / znorm
+
+            DO jt = 1, imid - 1
+               wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm
+            END DO
+            DO jt = imid, iiauper
+               wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm
+            END DO
+
+         ENDIF
+
+         ! Test that the integral of the weights over the weighting interval equals 1
+          IF(lwp) THEN
+             WRITE(numout,*)
+             WRITE(numout,*) 'asm_inc_init : IAU weights'
+             WRITE(numout,*) '~~~~~~~~~~~~'
+             WRITE(numout,*) '             time step         IAU  weight'
+             WRITE(numout,*) '             =========     ====================='
+             ztotwgt = 0.0
+             DO jt = 1, icycper
+                ztotwgt = ztotwgt + wgtiau(jt)
+                WRITE(numout,*) '         ', jt, '       ', wgtiau(jt) 
+             END DO   
+             WRITE(numout,*) '         ==================================='
+             WRITE(numout,*) '         Time-integrated weight = ', ztotwgt
+             WRITE(numout,*) '         ==================================='
+          ENDIF
+         
+      ENDIF
+
+      !--------------------------------------------------------------------
+      ! Allocate and initialize the increment arrays
+      !--------------------------------------------------------------------
+
+      ALLOCATE( t_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( s_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( u_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( v_bkginc(jpi,jpj,jpk) )
+      ALLOCATE( ssh_bkginc(jpi,jpj)   )
+#if defined key_asminc
+      ALLOCATE( ssh_iau(jpi,jpj)      )
+#endif
+      t_bkginc(:,:,:) = 0.0
+      s_bkginc(:,:,:) = 0.0
+      u_bkginc(:,:,:) = 0.0
+      v_bkginc(:,:,:) = 0.0
+      ssh_bkginc(:,:) = 0.0
+#if defined key_asminc
+      ssh_iau(:,:)    = 0.0
+#endif
+      IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) ) THEN
+
+         !--------------------------------------------------------------------
+         ! Read the increments from file
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asminc, inum )
+
+         CALL iom_get( inum, 'time', zdate_inc ) 
+
+         CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb )
+         CALL iom_get( inum, 'z_inc_datef', z_inc_datef )
+         z_inc_dateb = zdate_inc
+         z_inc_datef = zdate_inc
+
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', &
+               &            ' between dates ', NINT( z_inc_dateb ),' and ',  &
+               &            NINT( z_inc_datef )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF (     ( NINT( z_inc_dateb ) < ndastp      ) &
+            & .OR.( NINT( z_inc_datef ) > iitend_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments is ', &
+            &                ' outside the assimilation interval' )
+
+         IF ( ( ln_asmdin ).AND.( NINT( zdate_inc ) /= iitdin_date ) ) &
+            & CALL ctl_warn( ' Validity time of assimilation increments does ', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 )
+            CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 )
+            ! Apply the masks
+            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:)
+            s_bkginc(:,:,:) = s_bkginc(:,:,:) * tmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( t_bkginc(:,:,:) ) > 1.0e+10 ) t_bkginc(:,:,:) = 0.0
+            WHERE( ABS( s_bkginc(:,:,:) ) > 1.0e+10 ) s_bkginc(:,:,:) = 0.0
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 )              
+            CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 )              
+            ! Apply the masks
+            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:)
+            v_bkginc(:,:,:) = v_bkginc(:,:,:) * vmask(:,:,:)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( u_bkginc(:,:,:) ) > 1.0e+10 ) u_bkginc(:,:,:) = 0.0
+            WHERE( ABS( v_bkginc(:,:,:) ) > 1.0e+10 ) v_bkginc(:,:,:) = 0.0
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 )
+            ! Apply the masks
+            ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1)
+            ! Set missing increments to 0.0 rather than 1e+20
+            ! to allow for differences in masks
+            WHERE( ABS( ssh_bkginc(:,:) ) > 1.0e+10 ) ssh_bkginc(:,:) = 0.0
+         ENDIF
+
+         CALL iom_close( inum )
+ 
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! 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(:,:) = 0._wp
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  hdiv(ji,jj) =   &
+                     (  e2u(ji  ,jj)*fse3u(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)       &
+                      - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)       &
+                      + e1v(ji,jj  )*fse3v(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)       &
+                      - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  )    &
+                      / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(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 * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   &
+                                                                  - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) &
+                                                                / e1u(ji,jj) * umask(ji,jj,jk) 
+                  v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   &
+                                                                  - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) &
+                                                                / 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.0
+         s_bkg(:,:,:) = 0.0
+         u_bkg(:,:,:) = 0.0
+         v_bkg(:,:,:) = 0.0
+         ssh_bkg(:,:) = 0.0
+
+         !--------------------------------------------------------------------
+         ! Read from file the background state at analysis time
+         !--------------------------------------------------------------------
+
+         CALL iom_open( c_asmdin, inum )
+
+         CALL iom_get( inum, 'zdate', zdate_bkg ) 
+        
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', &
+               &  NINT( zdate_bkg )
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         IF ( NINT( zdate_bkg ) /= iitdin_date ) &
+            & CALL ctl_warn( ' Validity time of assimilation background state does', &
+            &                ' not agree with Direct Initialization time' )
+
+         IF ( ln_trainc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg )
+            t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:)
+            s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:)
+         ENDIF
+
+         IF ( ln_dyninc ) THEN   
+            CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg )
+            CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg )
+            u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:)
+            v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:)
+         ENDIF
+        
+         IF ( ln_sshinc ) THEN
+            CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg )
+            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1)
+         ENDIF
+
+         CALL iom_close( inum )
+
+      ENDIF
+      !
+   END SUBROUTINE asm_inc_init
+
+
+   SUBROUTINE calc_date( kit000, kt, kdate0, kdate )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_date  ***
+      !!          
+      !! ** Purpose : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Method  : Compute the calendar date YYYYMMDD at a given time step.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kit000  ! Initial time step
+      INTEGER, INTENT(IN) :: kt      ! Current time step referenced to kit000
+      INTEGER, INTENT(IN) :: kdate0  ! Initial date
+      INTEGER, INTENT(OUT) :: kdate  ! Current date reference to kdate0
+      !
+      INTEGER :: iyea0    ! Initial year
+      INTEGER :: imon0    ! Initial month
+      INTEGER :: iday0    ! Initial day
+      INTEGER :: iyea     ! Current year
+      INTEGER :: imon     ! Current month
+      INTEGER :: iday     ! Current day
+      INTEGER :: idaystp  ! Number of days between initial and current date
+      INTEGER :: idaycnt  ! Day counter
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !-----------------------------------------------------------------------
+      ! Compute the calendar date YYYYMMDD
+      !-----------------------------------------------------------------------
+
+      ! Initial date
+      iyea0 =   kdate0 / 10000
+      imon0 = ( kdate0 - ( iyea0 * 10000 ) ) / 100
+      iday0 =   kdate0 - ( iyea0 * 10000 ) - ( imon0 * 100 ) 
+
+      ! Check that kt >= kit000 - 1
+      IF ( kt < kit000 - 1 ) CALL ctl_stop( ' kt must be >= kit000 - 1')
+
+      ! If kt = kit000 - 1 then set the date to the restart date
+      IF ( kt == kit000 - 1 ) THEN
+
+         kdate = ndastp
+         RETURN
+
+      ENDIF
+
+      ! Compute the number of days from the initial date
+      idaystp = INT( REAL( kt - kit000 ) * rdt / 86400. )
+   
+      iday    = iday0
+      imon    = imon0
+      iyea    = iyea0
+      idaycnt = 0
+
+      CALL calc_month_len( iyea, imonth_len )
+
+      DO WHILE ( idaycnt < idaystp )
+         iday = iday + 1
+         IF ( iday > imonth_len(imon) )  THEN
+            iday = 1
+            imon = imon + 1
+         ENDIF
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF                 
+         idaycnt = idaycnt + 1
+      END DO
+      !
+      kdate = iyea * 10000 + imon * 100 + iday
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+      !!----------------------------------------------------------------------
+      !
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+      !
+   END SUBROUTINE
+
+
+   SUBROUTINE tra_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the tracer (T and S) assimilation increments
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt               ! Current time step
+      !
+      INTEGER :: ji,jj,jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the tracer tendencies
+            DO jk = 1, jpkm1
+               tsa(:,:,jk,jp_tem) = tsa(:,:,jk,jp_tem) + t_bkginc(:,:,jk) * zincwgt  
+               tsa(:,:,jk,jp_sal) = tsa(:,:,jk,jp_sal) + s_bkginc(:,:,jk) * zincwgt
+            END DO
+
+            ! Salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        tsa(ji,jj,jk,jp_sal) = MAX( tsa(ji,jj,jk,jp_sal), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+         ENDIF
+
+         IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+         ENDIF
+
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+            
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0  ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            tsn(:,:,:,jp_tem) = t_bkg(:,:,:) + t_bkginc(:,:,:)   
+            tsn(:,:,:,jp_sal) = s_bkg(:,:,:) + s_bkginc(:,:,:)   
+
+            ! Optional salinity fix
+            IF (ln_salfix) THEN
+               DO jk = 1, jpkm1
+                  DO jj = 1, jpj
+                     DO ji= 1, jpi
+                        tsn(ji,jj,jk,jp_sal) = MAX( tsn(ji,jj,jk,jp_sal), salfixmin )
+                     END DO
+                  END DO
+               END DO
+            ENDIF
+
+            tsb(:,:,:,:) = tsn(:,:,:,:)                        ! Update before fields
+
+            CALL eos( tsb, rhd, rhop )                ! Before potential and in situ densities
+         
+            IF( ln_zps .AND. .NOT. lk_c1d ) &
+               &  CALL zps_hde( nit000, jpts, tsb,   &  ! Partial steps: before horizontal derivative
+               &                gtsu, gtsv, rhd,        &  ! of T, S, rd at the bottom ocean level
+               &                gru , grv )
+
+            DEALLOCATE( t_bkginc )
+            DEALLOCATE( s_bkginc )
+            DEALLOCATE( t_bkg    )
+            DEALLOCATE( s_bkg    )
+         ENDIF
+         !  
+      ENDIF
+      !
+   END SUBROUTINE tra_asm_inc
+
+
+   SUBROUTINE dyn_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dyn_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the dynamics (u and v) assimilation increments.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+      !
+      INTEGER :: jk
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'dyn_asm_inc : Dynamics IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Update the dynamic tendencies
+            DO jk = 1, jpkm1
+               ua(:,:,jk) = ua(:,:,jk) + u_bkginc(:,:,jk) * zincwgt
+               va(:,:,jk) = va(:,:,jk) + v_bkginc(:,:,jk) * zincwgt
+            END DO
+           
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( u_bkginc )
+               DEALLOCATE( v_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN 
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+         
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields with the background + increment
+            un(:,:,:) = u_bkg(:,:,:) + u_bkginc(:,:,:)
+            vn(:,:,:) = v_bkg(:,:,:) + v_bkginc(:,:,:)  
+
+            ub(:,:,:) = un(:,:,:)         ! Update before fields
+            vb(:,:,:) = vn(:,:,:)
+ 
+            CALL div_cur( kt )            ! Compute divergence and curl for now fields
+
+            rotb (:,:,:) = rotn (:,:,:)   ! Update before fields
+            hdivb(:,:,:) = hdivn(:,:,:)
+
+            DEALLOCATE( u_bkg    )
+            DEALLOCATE( v_bkg    )
+            DEALLOCATE( u_bkginc )
+            DEALLOCATE( v_bkginc )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE dyn_asm_inc
+
+
+   SUBROUTINE ssh_asm_inc( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ssh_asm_inc  ***
+      !!          
+      !! ** Purpose : Apply the sea surface height assimilation increment.
+      !!
+      !! ** Method  : Direct initialization or Incremental Analysis Updating.
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(IN) :: kt   ! Current time step
+      !
+      INTEGER :: it
+      REAL(wp) :: zincwgt  ! IAU weight for current time step
+      !!----------------------------------------------------------------------
+
+      IF ( ln_asmiau ) THEN
+
+         !--------------------------------------------------------------------
+         ! Incremental Analysis Updating
+         !--------------------------------------------------------------------
+
+         IF ( ( kt >= nitiaustr_r ).AND.( kt <= nitiaufin_r ) ) THEN
+
+            it = kt - nit000 + 1
+            zincwgt = wgtiau(it) / rdt   ! IAU weight for the current time step
+
+            IF(lwp) THEN
+               WRITE(numout,*) 
+               WRITE(numout,*) 'ssh_asm_inc : SSH IAU at time step = ', &
+                  &  kt,' with IAU weight = ', wgtiau(it)
+               WRITE(numout,*) '~~~~~~~~~~~~'
+            ENDIF
+
+            ! Save the tendency associated with the IAU weighted SSH increment
+            ! (applied in dynspg.*)
+#if defined key_asminc
+            ssh_iau(:,:) = ssh_bkginc(:,:) * zincwgt
+#endif
+            IF ( kt == nitiaufin_r ) THEN
+               DEALLOCATE( ssh_bkginc )
+            ENDIF
+
+         ENDIF
+
+      ELSEIF ( ln_asmdin ) THEN
+
+         !--------------------------------------------------------------------
+         ! Direct Initialization
+         !--------------------------------------------------------------------
+
+         IF ( kt == nitdin_r ) THEN
+
+            neuler = 0                    ! Force Euler forward step
+
+            ! Initialize the now fields the background + increment
+            sshn(:,:) = ssh_bkg(:,:) + ssh_bkginc(:,:)  
+
+            sshb(:,:) = sshn(:,:)         ! Update before fields
+
+            DEALLOCATE( ssh_bkg    )
+            DEALLOCATE( ssh_bkginc )
+
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE ssh_asm_inc
+
+   !!======================================================================
+END MODULE asminc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90	(revision 3437)
@@ -0,0 +1,38 @@
+MODULE asmpar
+   !!======================================================================
+   !!                       ***  MODULE asmpar  ***
+   !! Assimilation increment : Parameters for assimilation interface
+   !!======================================================================
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   !! * Shared Modules variables
+   CHARACTER (LEN=40), PUBLIC, PARAMETER :: &
+      & c_asmbkg = 'assim_background_state_Jb',  & !: Filename for storing the 
+                                                   !: background state for use 
+                                                   !: in the Jb term
+      & c_asmdin = 'assim_background_state_DI',  & !: Filename for storing the 
+                                                   !: background state for direct 
+                                                   !: initialization
+      & c_asmtrj = 'assim_trj',                  & !: Filename for storing the 
+                                                   !: reference trajectory
+      & c_asminc = 'assim_background_increments'   !: Filename for storing the 
+                                                   !: increments to the background
+                                                   !: state
+
+   INTEGER, PUBLIC :: nitbkg_r      !: Background time step referenced to nit000
+   INTEGER, PUBLIC :: nitdin_r      !: Direct Initialization time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaustr_r   !: IAU starting time step referenced to nit000
+   INTEGER, PUBLIC :: nitiaufin_r   !: IAU final time step referenced to nit000
+   INTEGER, PUBLIC :: nittrjfrq     !: Frequency of trajectory output for 4D-VAR
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+END MODULE asmpar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90	(revision 3437)
@@ -0,0 +1,250 @@
+MODULE asmtrj
+   !!======================================================================
+   !!                       ***  MODULE asmtrj  ***
+   !! Assimilation trajectory interface: Write to file the background state and the model state trajectory
+   !!======================================================================
+   !! History :       ! 2007-03 (M. Martin)  Met. Office version
+   !!                 ! 2007-04 (A. Weaver)  asm_trj_wri, original code
+   !!                 ! 2007-03 (K. Mogensen)  Adapt to NEMOVAR and use IOM instead of IOIPSL
+   !!                 ! 2007-04 (A. Weaver)  Name change (formally asmbkg.F90). Distinguish
+   !!                                        background states in Jb term and at analysis time.
+   !!                                        Include state trajectory routine (currently empty)
+   !!                 ! 2007-07 (A. Weaver)  Add tke_rst and flt_rst for case nitbkg=0 
+   !!                 ! 2009-03 (F. Vigilant)  Add hmlp (zdfmxl) for no tracer nmldp=2 
+   !!                 ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1
+   !!                 ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_asminc' : Switch on the assimilation increment interface
+   !!----------------------------------------------------------------------
+   !!   asm_bkg_wri  : Write out the background state
+   !!   asm_trj_wri  : Write out the model state trajectory (used with 4D-Var)
+   !!----------------------------------------------------------------------
+   USE oce                ! Dynamics and active tracers defined in memory
+   USE sbc_oce            ! Ocean surface boundary conditions
+   USE zdf_oce            ! Vertical mixing variables
+   USE zdfddm             ! Double diffusion mixing parameterization
+   USE ldftra_oce         ! Lateral tracer mixing coefficient defined in memory
+   USE ldfslp             ! Slopes of neutral surfaces
+   USE tradmp             ! Tracer damping
+#if defined key_zdftke
+   USE zdftke             ! TKE vertical physics
+#endif
+   USE eosbn2             ! Equation of state (eos_bn2 routine)
+   USE zdfmxl             ! Mixed layer depth
+   USE dom_oce, ONLY :   ndastp
+   USE sol_oce, ONLY :   gcx   ! Solver variables defined in memory
+   USE in_out_manager     ! I/O manager
+   USE iom                ! I/O module
+   USE asmpar             ! Parameters for the assmilation interface
+   USE zdfmxl             ! mixed layer depth
+#if defined key_traldf_c2d
+   USE ldfeiv             ! eddy induced velocity coef.      (ldf_eiv routine)
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   asm_bkg_wri   !: Write out the background state
+   PUBLIC   asm_trj_wri   !: Write out the background state
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE asm_bkg_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE asm_bkg_wri ***
+      !!
+      !! ** Purpose : Write to file the background state for later use in the
+      !!              inner loop of data assimilation or for direct initialization
+      !!              in the outer loop.
+      !!
+      !! ** Method  : Write out the background state for use in the Jb term
+      !!              in the cost function and for use with direct initialization
+      !!              at analysis time.
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT( IN ) :: kt               ! Current time-step
+      !
+      CHARACTER (LEN=50) :: cl_asmbkg
+      CHARACTER (LEN=50) :: cl_asmdin
+      LOGICAL :: llok          ! Check if file exists
+      INTEGER :: inum          ! File unit number
+      REAL(wp) :: zdate        ! Date
+      !!-----------------------------------------------------------------------
+
+      !                                !-------------------------------------------
+      IF( kt == nitbkg_r ) THEN        ! Write out background at time step nitbkg_r
+         !                             !-----------------------------------========
+         !
+         WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg )
+         cl_asmbkg = TRIM( cl_asmbkg )
+         INQUIRE( FILE = cl_asmbkg, EXIST = llok )
+         !
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg )
+            !
+            !                                      ! Define the output file        
+            CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib)
+            !
+            IF( nitbkg_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+               zdate = REAL( ndastp )
+#if defined key_zdftke
+               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+               IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...'
+               CALL tke_rst( nit000, 'READ' )               ! lk_zdftke=T :   Read turbulent kinetic energy ( en )
+
+#endif
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+            !
+            !                                      ! Write the information
+            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                )
+            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , 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_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               )
+            !
+            CALL iom_close( inum )
+         ENDIF
+         !
+      ENDIF
+
+      !                                !-------------------------------------------
+      IF( kt == nitdin_r ) THEN        ! Write out background at time step nitdin_r
+         !                             !-----------------------------------========
+         !
+         WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin )
+         cl_asmdin = TRIM( cl_asmdin )
+         INQUIRE( FILE = cl_asmdin, EXIST = llok )
+         !
+         IF( .NOT. llok ) THEN
+            IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin )
+            !
+            !                                      ! Define the output file        
+            CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib)
+            !
+            IF( nitdin_r == nit000 - 1 ) THEN      ! Treat special case when nitbkg = 0
+
+               zdate = REAL( ndastp )
+            ELSE
+               zdate = REAL( ndastp )
+            ENDIF
+            !
+            !                                      ! Write the information
+            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             )
+            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                )
+            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                )
+            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) )
+            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              )
+            !
+            CALL iom_close( inum )
+         ENDIF
+         !
+      ENDIF
+      !                    
+   END SUBROUTINE asm_bkg_wri
+
+
+   SUBROUTINE asm_trj_wri( kt )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE asm_trj_wri ***
+      !!
+      !! ** Purpose :   Write to file the model state trajectory for use with 4D-Var.
+      !!-----------------------------------------------------------------------
+      INTEGER, INTENT( IN ) :: kt             ! Current time-step
+      !
+      INTEGER :: inum                  ! File unit number
+      INTEGER :: it
+      CHARACTER (LEN=50) :: cl_asmtrj
+      REAL(wp) :: zdate            ! Date
+      !!-----------------------------------------------------------------------
+
+      !------------------------------------------------------------------------
+      ! Write a single file for each trajectory time step
+      !------------------------------------------------------------------------
+      IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN
+         
+         IF( kt == nit000 - 1 ) THEN         ! Treat special case when kt = nit000-1
+            !
+#if defined key_zdftke
+            IF(lwp) WRITE(numout,*) ' Computing  zdf_tke coeff. form restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients
+            CALL zdf_tke( nit000 )
+#endif
+#if defined key_zdfddm
+            IF(lwp) WRITE(numout,*) ' Computing zdf_ddm coeff. from restart...'
+            ! Compute the vertical eddy viscosity and diffusivity coefficients (salt effect)
+            CALL zdf_ddm( nit000 )
+#endif
+            IF(lwp) WRITE(numout,*) ' Computing zdf_mxl coeff. from restart...'
+            ! Compute the turbocline depth and the mixed layer depth
+            CALL zdf_mxl( nit000 ) 
+#if defined key_ldfslp
+            IF(lwp) WRITE(numout,*) ' Compute the slopes of neutral surface...'
+            CALL bn2( tsb, rn2 ) 
+            CALL ldf_slp( nit000, rhd, rn2 )
+#endif
+#if defined key_traldf_c2d
+            IF(lwp) WRITE(numout,*) ' Computing ldf_eiv coeff. from restart...'
+            ! Compute eddy induced velocity coefficient
+            IF( lk_traldf_eiv )   CALL ldf_eiv( nit000 )
+#endif
+         ENDIF
+         !
+         it = kt - nit000 + 1
+         !
+         !                                   ! Define the output file        
+         WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it
+         cl_asmtrj = TRIM( cl_asmtrj )
+         CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
+         !
+         !                                   ! Output trajectory fields
+         CALL iom_rstput( it, it, inum, 'emp'   , emp    )
+         CALL iom_rstput( it, it, inum, 'emps'  , emps   )
+         CALL iom_rstput( it, it, inum, 'un'    , un     )
+         CALL iom_rstput( it, it, inum, 'vn'    , vn     )
+         CALL iom_rstput( it, it, inum, 'tn'    , tsn(:,:,:,jp_tem) )
+         CALL iom_rstput( it, it, inum, 'sn'    , tsn(:,:,:,jp_sal) )
+         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   )
+         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   )
+         CALL iom_rstput( it, it, inum, 'avt'   , avt    )
+#if defined key_ldfslp
+         CALL iom_rstput( it, it, inum, 'uslp'  , uslp   )
+         CALL iom_rstput( it, it, inum, 'vslp'  , vslp   )
+         CALL iom_rstput( it, it, inum, 'wslpi' , wslpi  )
+         CALL iom_rstput( it, it, inum, 'wslpj' , wslpj  )
+#endif
+#if defined key_zdfddm
+         CALL iom_rstput( it, it, inum, 'avs'   , avs    )
+#endif
+         CALL iom_rstput( it, it, inum, 'ta'    , tsa(:,:,:,jp_tem) )
+         CALL iom_rstput( it, it, inum, 'sa'    , tsa(:,:,:,jp_sal) )
+         CALL iom_rstput( it, it, inum, 'tb'    , tsb(:,:,:,jp_tem) )
+         CALL iom_rstput( it, it, inum, 'sb'    , tsb(:,:,:,jp_sal) )
+         IF( ln_tradmp ) THEN
+            CALL iom_rstput( it, it, inum, 'strdmp', strdmp )
+            CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   )
+         END IF
+         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   )
+         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   )
+         CALL iom_rstput( it, it, inum, 'aeiw'  , aeiw   )
+         !
+         CALL iom_close( inum )
+      ENDIF
+      !
+   END SUBROUTINE asm_trj_wri
+
+   !!======================================================================
+END MODULE asmtrj
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90	(revision 3437)
@@ -0,0 +1,138 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy 
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'                      Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+   USE bdy_par         ! Unstructured boundary parameters
+   USE lib_mpp         ! distributed memory computing
+
+   IMPLICIT NONE
+   PUBLIC
+
+   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   , POINTER, DIMENSION(:,:)   ::  nbw
+      REAL   , POINTER, DIMENSION(:)     ::  flagu
+      REAL   , POINTER, DIMENSION(:)     ::  flagv
+   END TYPE OBC_INDEX
+
+   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data
+      REAL, POINTER, DIMENSION(:)     ::  ssh
+      REAL, POINTER, DIMENSION(:)     ::  u2d
+      REAL, POINTER, DIMENSION(:)     ::  v2d
+      REAL, POINTER, DIMENSION(:,:)   ::  u3d
+      REAL, POINTER, DIMENSION(:,:)   ::  v3d
+      REAL, POINTER, DIMENSION(:,:)   ::  tem
+      REAL, POINTER, DIMENSION(:,:)   ::  sal
+#if defined key_lim2
+      REAL, POINTER, DIMENSION(:)     ::  frld
+      REAL, POINTER, DIMENSION(:)     ::  hicif
+      REAL, POINTER, DIMENSION(:)     ::  hsnif
+#endif
+   END TYPE OBC_DATA
+
+   !!----------------------------------------------------------------------
+   !! Namelist variables
+   !!----------------------------------------------------------------------
+   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, 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.
+   INTEGER, DIMENSION(jp_bdy) ::   nn_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
+   INTEGER, DIMENSION(jp_bdy) ::   nn_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
+   INTEGER, DIMENSION(jp_bdy) ::   nn_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
+#if defined key_lim2
+   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables 
+   INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ; 
+                                                            !: = 1 read it in a NetCDF file
+#endif
+   !
+   
+   !!----------------------------------------------------------------------
+   !! Global variables
+   !!----------------------------------------------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdytmask   !: Mask defining computational domain at T-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyumask   !: Mask defining computational domain at U-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points
+
+   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary
+
+   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh       !: 
+   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur       !: 
+   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr       !: Pointers for barotropic fields 
+   REAL(wp), POINTER, DIMENSION(:,:)           ::   pu2d       !: 
+   REAL(wp), POINTER, DIMENSION(:,:)           ::   pv2d       !: 
+
+   !!----------------------------------------------------------------------
+   !! 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
+   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process)
+   TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process)
+
+   !!----------------------------------------------------------------------
+   !! 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 )
+         !
+      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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                NO Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_tides = .false.  !: =T apply tidal harmonic forcing along open boundaries
+#endif
+
+   !!======================================================================
+END MODULE bdy_oce
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90	(revision 3437)
@@ -0,0 +1,48 @@
+MODULE bdy_par
+   !!======================================================================
+   !!                      ***  MODULE bdy_par   ***
+   !! Unstructured Open Boundary Cond. :   define related parameters
+   !!======================================================================
+   !! History :  1.0  !  2005-01  (J. Chanut, A. Sellar)  Original code
+   !!            3.0  !  2008-04  (NEMO team)  add in the reference version
+   !!            3.3  !  2010-09  (D. Storkey and E. O'Dea) update for Shelf configurations
+   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!----------------------------------------------------------------------
+#if defined   key_bdy
+   !!----------------------------------------------------------------------
+   !!   'key_bdy' :                    Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PUBLIC
+
+# if ! defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .TRUE.   !: Unstructured Ocean Boundary Condition flag
+# else
+   LOGICAL, PUBLIC            ::   lk_bdy  = .TRUE.   !: Unstructured Ocean Boundary Condition flag
+# endif
+   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets
+   INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file
+   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3	      !: Number of horizontal grid types used  (T, U, V)
+
+   !! Flags for choice of schemes
+   INTEGER, PUBLIC, PARAMETER ::   jp_none         = 0        !: Flag for no open boundary condition
+   INTEGER, PUBLIC, PARAMETER ::   jp_frs          = 1        !: Flag for Flow Relaxation Scheme
+   INTEGER, PUBLIC, PARAMETER ::   jp_flather      = 2        !: Flag for Flather
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :            NO Unstructured open boundary condition
+   !!----------------------------------------------------------------------
+# if ! defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_bdy  = .FALSE.   !: Unstructured Ocean Boundary Condition flag
+# else
+   LOGICAL, PUBLIC            ::   lk_bdy  = .FALSE.   !: Unstructured Ocean Boundary Condition flag
+# endif
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE bdy_par
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90	(revision 3437)
@@ -0,0 +1,698 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'                     Open Boundary Conditions
+   !!----------------------------------------------------------------------
+   !!    bdy_dta        : read external data along open boundaries from file
+   !!    bdy_dta_init   : initialise arrays etc for reading of external data
+   !!----------------------------------------------------------------------
+   USE wrk_nemo        ! Memory Allocation
+   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
+#endif
+
+   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
+
+   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET ::   bf        ! structure of input fields (file informations, fields read)
+
+   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap
+
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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  ! local indices
+      INTEGER,          DIMENSION(jpbgrd) ::   ilen1 
+      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts
+      !!
+      !!---------------------------------------------------------------------------
+      !!
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dta')
+
+      ! Initialise data arrays once for all from initial conditions where required
+      !---------------------------------------------------------------------------
+      IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN
+
+         ! Calculate depth-mean currents
+         !-----------------------------
+         CALL wrk_alloc(jpi,jpj,pu2d,pv2d) 
+
+         pu2d(:,:) = 0.e0
+         pv2d(:,:) = 0.e0
+
+         DO ik = 1, jpkm1   !! Vertically integrated momentum trends
+             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)
+             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)
+         END DO
+         pu2d(:,:) = pu2d(:,:) * hur(:,:)
+         pv2d(:,:) = pv2d(:,:) * hvr(:,:)
+         
+         DO ib_bdy = 1, nb_bdy
+
+            nblen => idx_bdy(ib_bdy)%nblen
+            nblenrim => idx_bdy(ib_bdy)%nblenrim
+
+            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 
+               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
+               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 
+               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) = pu2d(ii,ij) * umask(ii,ij,1)         
+               END DO 
+               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) = pv2d(ii,ij) * vmask(ii,ij,1)         
+               END DO 
+            ENDIF
+
+            IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
+               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) - pu2d(ii,ij) ) * umask(ii,ij,ik)         
+                  END DO
+               END DO 
+               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) - pv2d(ii,ij) ) * vmask(ii,ij,ik)         
+                     END DO
+               END DO 
+            ENDIF
+
+            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
+               igrd = 1                       ! Everything is at T-points here
+               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)         
+                     dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)         
+                  END DO
+               END DO 
+            ENDIF
+
+#if defined key_lim2
+            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(:) = nblen(:)
+               ELSE
+                  ilen1(:) = nblenrim(:)
+               ENDIF
+               igrd = 1                       ! Everything is at T-points here
+               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)         
+                  dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)         
+                  dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)         
+               END DO 
+            ENDIF
+#endif
+
+         ENDDO ! ib_bdy
+
+         CALL wrk_dealloc(jpi,jpj,pu2d,pv2d) 
+
+      ENDIF ! kt .eq. nit000
+
+      ! update external data from files
+      !--------------------------------
+     
+      jstart = 1
+      DO ib_bdy = 1, nb_bdy   
+         IF( nn_dta(ib_bdy) .eq. 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 tide_update
+               IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN
+                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                     dta_bdy(ib_bdy)%ssh(:) = 0.0
+                     dta_bdy(ib_bdy)%u2d(:) = 0.0
+                     dta_bdy(ib_bdy)%v2d(:) = 0.0
+                  ENDIF
+                  IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN ! update external data
+                     jend = jstart + 2
+                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),   &
+                     &              jit=jit, time_offset=time_offset )
+                  ENDIF
+                  IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                     CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   & 
+                     &                 jit=jit, time_offset=time_offset )
+                  ENDIF
+               ENDIF
+            ELSE
+               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays
+                  dta_bdy(ib_bdy)%ssh(:) = 0.0
+                  dta_bdy(ib_bdy)%u2d(:) = 0.0
+                  dta_bdy(ib_bdy)%v2d(:) = 0.0
+               ENDIF
+               IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data
+                  jend = jstart + nb_bdy_fld(ib_bdy) - 1
+                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), time_offset=time_offset )
+               ENDIF
+               IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing
+                  CALL tide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy), time_offset=time_offset )
+               ENDIF
+            ENDIF
+            jstart = jend+1
+
+            ! If full velocities in boundary data then split into barotropic and baroclinic data
+            ! (Note that we have already made sure that you can't use ln_full_vel = .true. at the same
+            ! time as the dynspg_ts option). 
+
+            IF( ln_full_vel_array(ib_bdy) .and.                                             & 
+           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 .or. nn_dyn3d_dta(ib_bdy) .eq. 1 ) ) THEN 
+
+               igrd = 2                      ! zonal velocity
+               dta_bdy(ib_bdy)%u2d(:) = 0.0
+               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_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &
+              &                                + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik)
+                  END DO
+                  dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
+                  END DO
+               END DO
+
+               igrd = 3                      ! meridional velocity
+               dta_bdy(ib_bdy)%v2d(:) = 0.0
+               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_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &
+              &                                + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik)
+                  END DO
+                  dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)
+                  DO ik = 1, jpkm1
+                     dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
+                  END DO
+               END DO
+    
+            ENDIF
+
+         END IF ! nn_dta(ib_bdy) = 1
+      END DO  ! ib_bdy
+
+      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  :   Use fldread.F90
+      !!                
+      !!----------------------------------------------------------------------
+      USE dynspg_oce, ONLY: lk_dynspg_ts
+      !!
+      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices
+      !!
+      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
+      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,              DIMENSION(jpbgrd) ::  ilen0         ! size of local 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(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      !
+#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
+#endif
+      NAMELIST/nambdy_dta/ ln_full_vel
+      !!---------------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dta_init')
+
+      ! 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
+                               ,nn_ice_lim2_dta(ib_bdy)    &
+#endif
+                              )
+         IF(nn_dta(ib_bdy) .gt. 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( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
+         ENDIF
+         IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
+         ENDIF
+         IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2
+         ENDIF
+#if defined key_lim2
+         IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN
+            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3
+         ENDIF
+#endif               
+      ENDDO            
+
+      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)
+      jfld = 0 
+      DO ib_bdy = 1, nb_bdy         
+         IF( nn_dta(ib_bdy) .eq. 1 ) THEN
+            ! set file information
+            cn_dir = './'        ! directory in which the model is executed
+            ln_full_vel = .false.
+            ! ... default values (NB: frequency positive => hours, negative => months)
+            !                    !  file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
+            !                    !  name       ! hours !   name     !  (T/F)  !  (T/F)  !  'monthly'  ! filename ! pairs     !
+            bn_ssh     = FLD_N(  'bdy_ssh'     ,  24   , 'sossheig' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_u2d     = FLD_N(  'bdy_vel2d_u' ,  24   , 'vobtcrtx' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_v2d     = FLD_N(  'bdy_vel2d_v' ,  24   , 'vobtcrty' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_u3d     = FLD_N(  'bdy_vel3d_u' ,  24   , 'vozocrtx' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_v3d     = FLD_N(  'bdy_vel3d_v' ,  24   , 'vomecrty' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_tem     = FLD_N(  'bdy_tem'     ,  24   , 'votemper' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_sal     = FLD_N(  'bdy_sal'     ,  24   , 'vosaline' , .false. , .false. ,   'yearly'  , ''       , ''        )
+#if defined key_lim2
+            bn_frld    = FLD_N(  'bdy_frld'    ,  24   , 'ildsconc' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_hicif   = FLD_N(  'bdy_hicif'   ,  24   , 'iicethic' , .false. , .false. ,   'yearly'  , ''       , ''        )
+            bn_hsnif   = FLD_N(  'bdy_hsnif'   ,  24   , 'isnothic' , .false. , .false. ,   'yearly'  , ''       , ''        )
+#endif
+
+            ! Important NOT to rewind here.
+            READ( numnam, nambdy_dta )
+
+            cn_dir_array(ib_bdy) = cn_dir
+            ln_full_vel_array(ib_bdy) = ln_full_vel
+
+            IF( ln_full_vel_array(ib_bdy) .and. lk_dynspg_ts )  THEN
+               CALL ctl_stop( 'bdy_dta_init: ERROR, cannot specify full velocities in boundary data',&
+            &                  'with dynspg_ts option' )   ;   RETURN  
+            ENDIF             
+
+            nblen => idx_bdy(ib_bdy)%nblen
+            nblenrim => idx_bdy(ib_bdy)%nblenrim
+
+            ! Only read in necessary fields for this set.
+            ! Important that barotropic variables come first.
+            IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
+
+               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_ssh
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 1
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+                  ilen3(jfld) = 1
+               ENDIF
+
+               IF( .not. ln_full_vel_array(ib_bdy) ) THEN
+
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_u2d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 2
+                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                     ilen1(jfld) = nblen(igrid(jfld))
+                  ELSE
+                     ilen1(jfld) = nblenrim(igrid(jfld))
+                  ENDIF
+                  ilen3(jfld) = 1
+
+                  jfld = jfld + 1
+                  blf_i(jfld) = bn_v2d
+                  ibdy(jfld) = ib_bdy
+                  igrid(jfld) = 3
+                  IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                     ilen1(jfld) = nblen(igrid(jfld))
+                  ELSE
+                     ilen1(jfld) = nblenrim(igrid(jfld))
+                  ENDIF
+                  ilen3(jfld) = 1
+
+               ENDIF
+
+            ENDIF
+
+            ! baroclinic velocities
+            IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. &
+           &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  &
+           &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_u3d
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 2
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = jpk
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_v3d
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 3
+               IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = jpk
+
+            ENDIF
+
+            ! temperature and salinity
+            IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_tem
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 1
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = jpk
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_sal
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 1
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = jpk
+
+            ENDIF
+
+#if defined key_lim2
+            ! sea ice
+            IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_frld
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 1
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = 1
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_hicif
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 1
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = 1
+
+               jfld = jfld + 1
+               blf_i(jfld) = bn_hsnif
+               ibdy(jfld) = ib_bdy
+               igrid(jfld) = 1
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen1(jfld) = nblen(igrid(jfld))
+               ELSE
+                  ilen1(jfld) = nblenrim(igrid(jfld))
+               ENDIF
+               ilen3(jfld) = 1
+
+            ENDIF
+#endif
+            ! Recalculate field counts
+            !-------------------------
+            nb_bdy_fld_sum = 0
+            IF( ib_bdy .eq. 1 ) THEN 
+               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
+
+         ENDIF ! nn_dta .eq. 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))
+      ENDDO
+
+      ! fill bf with blf_i and control print
+      !-------------------------------------
+      jstart = 1
+      DO ib_bdy = 1, nb_bdy
+         jend = jstart + nb_bdy_fld(ib_bdy) - 1
+         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
+         nblenrim => idx_bdy(ib_bdy)%nblenrim
+
+         IF (nn_dyn2d(ib_bdy) .gt. 0) THEN
+            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN
+               IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
+               ALLOCATE( dta_bdy(ib_bdy)%ssh(ilen0(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) )
+               ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) )
+            ELSE
+               IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN
+                  jfld = jfld + 1
+                  dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1)
+               ENDIF
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1)
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1)
+            ENDIF
+         ENDIF
+
+         IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN
+            IF( nn_dyn3d(ib_bdy) .eq. jp_frs ) THEN
+               ilen0(1:3) = nblen(1:3)
+            ELSE
+               ilen0(1:3) = nblenrim(1:3)
+            ENDIF
+            ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) )
+            ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) )
+         ENDIF
+         IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. &
+           &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   &
+           &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN
+            jfld = jfld + 1
+            dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:)
+            jfld = jfld + 1
+            dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:)
+         ENDIF
+
+         IF (nn_tra(ib_bdy) .gt. 0) THEN
+            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN
+               IF( nn_tra(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
+               ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) )
+               ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) )
+            ELSE
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:)
+               jfld = jfld + 1
+               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:)
+            ENDIF
+         ENDIF
+
+#if defined key_lim2
+         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN
+            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN
+               IF( nn_ice_lim2(ib_bdy) .eq. jp_frs ) THEN
+                  ilen0(1:3) = nblen(1:3)
+               ELSE
+                  ilen0(1:3) = nblenrim(1:3)
+               ENDIF
+               ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) )
+               ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(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
+#endif
+
+      ENDDO ! ib_bdy 
+
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dta_init')
+
+      END SUBROUTINE bdy_dta_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_dta( kt, jit, time_offset ) ! Empty routine
+      INTEGER, INTENT( in )           ::   kt    
+      INTEGER, INTENT( in ), OPTIONAL ::   jit   
+      INTEGER, INTENT( in ), OPTIONAL ::   time_offset
+      WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_dta
+   SUBROUTINE bdy_dta_init()                  ! Empty routine
+      WRITE(*,*) 'bdy_dta_init: You should not have seen this print! error?'
+   END SUBROUTINE bdy_dta_init
+#endif
+
+   !!==============================================================================
+END MODULE bdydta
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90	(revision 3437)
@@ -0,0 +1,132 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy 
+   !!----------------------------------------------------------------------
+   !!   'key_bdy' :                    Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !!   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 dynspg_oce      
+   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  !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or 
+                        ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp)
+
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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,igrd     ! Loop counter
+      LOGICAL               :: ll_dyn2d, ll_dyn3d  
+      !!
+
+      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
+
+      !-------------------------------------------------------
+      ! Set pointers
+      !-------------------------------------------------------
+
+      pssh => sshn
+      phur => hur
+      phvr => hvr
+      CALL wrk_alloc(jpi,jpj,pu2d,pv2d) 
+
+      !-------------------------------------------------------
+      ! Split velocities into barotropic and baroclinic parts
+      !-------------------------------------------------------
+
+      pu2d(:,:) = 0.e0
+      pv2d(:,:) = 0.e0
+      DO jk = 1, jpkm1   !! Vertically integrated momentum trends
+          pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)
+          pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)
+      END DO
+      pu2d(:,:) = pu2d(:,:) * phur(:,:)
+      pv2d(:,:) = pv2d(:,:) * phvr(:,:)
+      DO jk = 1 , jpkm1
+         ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:)
+         va(:,:,jk) = va(:,:,jk) - pv2d(:,:)
+      END DO
+
+      !-------------------------------------------------------
+      ! Apply boundary conditions to barotropic and baroclinic
+      ! parts separately
+      !-------------------------------------------------------
+
+      IF( ll_dyn2d ) CALL bdy_dyn2d( kt )
+
+      IF( ll_dyn3d ) CALL bdy_dyn3d( kt )
+
+      !-------------------------------------------------------
+      ! Recombine velocities
+      !-------------------------------------------------------
+
+      DO jk = 1 , jpkm1
+         ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk)
+         va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk)
+      END DO
+
+      CALL wrk_dealloc(jpi,jpj,pu2d,pv2d) 
+
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn')
+
+   END SUBROUTINE bdy_dyn
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_dyn( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_dyn
+#endif
+
+   !!======================================================================
+END MODULE bdydyn
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90	(revision 3437)
@@ -0,0 +1,196 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy 
+   !!----------------------------------------------------------------------
+   !!   'key_bdy' :                    Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !!   bdy_dyn2d      : Apply open boundary conditions to barotropic variables.
+   !!   bdy_dyn2d_fla    : Apply Flather condition
+   !!----------------------------------------------------------------------
+   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 dynspg_oce      ! for barotropic variables
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_dyn2d( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_dyn2d  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for barotropic variables
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER,                      INTENT(in) ::   kt   ! Main time step counter
+      !!
+      INTEGER                                  ::   ib_bdy ! Loop counter
+
+      DO ib_bdy=1, nb_bdy
+
+         SELECT CASE( nn_dyn2d(ib_bdy) )
+         CASE(jp_none)
+            CYCLE
+         CASE(jp_frs)
+            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
+         CASE(jp_flather)
+            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
+         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 )
+      !!----------------------------------------------------------------------
+      !!                  ***  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  ::   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)
+         pu2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(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)
+         pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1)
+      END DO 
+      CALL lbc_lnk( pu2d, 'U', -1. ) 
+      CALL lbc_lnk( pv2d, 'V', -1. )   ! 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 )
+      !!----------------------------------------------------------------------
+      !!                 ***  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  ::   jb, igrd                         ! dummy loop indices
+      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses
+      REAL(wp) ::   zcorr                            ! Flather correction
+      REAL(wp) ::   zforc                            ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_fla')
+
+      ! ---------------------------------!
+      ! 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
+      !
+      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) 
+         iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice inside the boundary
+         iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice outside the boundary 
+         !
+         zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )
+         zforc = dta%u2d(jb)
+         pu2d(ii,ij) = zforc + 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) 
+         ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice inside the boundary
+         ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice outside the boundary 
+         !
+         zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )
+         zforc = dta%v2d(jb)
+         pv2d(ii,ij) = zforc + zcorr * vmask(ii,ij,1)
+      END DO
+      CALL lbc_lnk( pu2d, 'U', -1. )   ! Boundary points should be updated
+      CALL lbc_lnk( pv2d, 'V', -1. )   !
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla')
+      !
+   END SUBROUTINE bdy_dyn2d_fla
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_dyn2d( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_dyn2d
+#endif
+
+   !!======================================================================
+END MODULE bdydyn2d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90	(revision 3437)
@@ -0,0 +1,125 @@
+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 
+   !!----------------------------------------------------------------------
+#if defined key_bdy 
+   !!----------------------------------------------------------------------
+   !!   'key_bdy' :                    Unstructured Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !!   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 lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  !
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_dyn3d     ! routine called by bdy_dyn
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: bdydyn.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! 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
+
+!!$         IF ( using Orlanski radiation conditions ) THEN 
+!!$            CALL bdy_rad( kt,  bdyidx(ib_bdy) )
+!!$         ENDIF
+
+         SELECT CASE( nn_dyn3d(ib_bdy) )
+         CASE(jp_none)
+            CYCLE
+         CASE(jp_frs)
+            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' )
+         END SELECT
+      ENDDO
+
+   END SUBROUTINE bdy_dyn3d
+
+   SUBROUTINE bdy_dyn3d_frs( idx, dta, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  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                     ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !!
+      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_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_frs')
+
+   END SUBROUTINE bdy_dyn3d_frs
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_dyn3d( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_dyn_frs: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_dyn3d
+#endif
+
+   !!======================================================================
+END MODULE bdydyn3d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90	(revision 3437)
@@ -0,0 +1,113 @@
+MODULE bdyice_lim2
+   !!======================================================================
+   !!                       ***  MODULE  bdyice_lim2  ***
+   !! Unstructured Open Boundary Cond. :  Open boundary conditions for sea-ice (LIM2)
+   !!======================================================================
+   !!  History :  3.3  !  2010-09 (D. Storkey)  Original code
+   !!             3.4  !  2011    (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!----------------------------------------------------------------------
+#if defined   key_bdy   &&   defined key_lim2
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'            and                 Unstructured Open Boundary Conditions
+   !!   'key_lim2'                                                 LIM-2 sea ice model
+   !!----------------------------------------------------------------------
+   !!   bdy_ice_lim_2      : Application of open boundaries to ice
+   !!   bdy_ice_frs        : Application of Flow Relaxation Scheme
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers variables
+   USE ice_2           ! LIM_2 ice variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE bdy_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! write to numout file
+   USE lib_mpp         ! distributed memory computing
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_ice_lim_2    ! routine called in sbcmod
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_ice_lim_2( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE bdy_ice_lim_2  ***
+      !!
+      !! ** Purpose : - Apply open boundary conditions for ice (LIM2)
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt     ! Main time step counter
+      !!
+      INTEGER               :: ib_bdy ! Loop index
+
+      DO ib_bdy=1, nb_bdy
+
+         SELECT CASE( nn_ice_lim2(ib_bdy) )
+         CASE(jp_none)
+            CYCLE
+         CASE(jp_frs)
+            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy) )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_ice_lim_2 : unrecognised option for open boundaries for ice fields' )
+         END SELECT
+      ENDDO
+
+   END SUBROUTINE bdy_ice_lim_2
+
+   SUBROUTINE bdy_ice_frs( idx, dta )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_ice_frs  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 
+      !!              of unstructured open boundaries. Currently only tested for LIM2.
+      !! 
+      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three-
+      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382.
+      !!------------------------------------------------------------------------------
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !!
+      INTEGER  ::   jb, jk, jgrd   ! dummy loop indices
+      INTEGER  ::   ii, ij         ! local scalar
+      REAL(wp) ::   zwgt, zwgt1    ! local scalar
+      !!------------------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs')
+      !
+      jgrd = 1      ! Everything is at T-points here
+      !
+      DO jb = 1, idx%nblen(jgrd)
+         DO jk = 1, jpkm1
+            ii    = idx%nbi(jb,jgrd)
+            ij    = idx%nbj(jb,jgrd)
+            zwgt  = idx%nbw(jb,jgrd)
+            zwgt1 = 1.e0 - idx%nbw(jb,jgrd)
+            frld (ii,ij) = ( frld (ii,ij) * zwgt1 + dta%frld (jb) * zwgt ) * tmask(ii,ij,1)     ! Leads fraction 
+            hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth 
+            hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth
+         END DO
+      END DO 
+      CALL lbc_lnk( frld, 'T', 1. )                                         ! lateral boundary conditions
+      CALL lbc_lnk( hicif, 'T', 1. )   ;   CALL lbc_lnk( hsnif, 'T', 1. )
+      !      
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs')
+      !
+   END SUBROUTINE bdy_ice_frs
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_ice_lim_2( kt )      ! Empty routine
+      WRITE(*,*) 'bdy_ice_frs_lim_2: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_ice_lim_2
+#endif
+
+   !!=================================================================================
+END MODULE bdyice_lim2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90	(revision 3437)
@@ -0,0 +1,818 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'                     Unstructured Open Boundary Conditions
+   !!----------------------------------------------------------------------
+   !!   bdy_init       : Initialization of unstructured open boundaries
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE bdy_oce         ! unstructured open boundary conditions
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   bdy_init   ! routine called in nemo_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $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 variables
+      !-------------------
+      INTEGER, PARAMETER          :: jp_nseg = 100
+      INTEGER                     :: nbdysege, nbdysegw, nbdysegn, nbdysegs 
+      INTEGER, DIMENSION(jp_nseg) :: jpieob, jpjedt, jpjeft
+      INTEGER, DIMENSION(jp_nseg) :: jpiwob, jpjwdt, jpjwft
+      INTEGER, DIMENSION(jp_nseg) :: jpjnob, jpindt, jpinft
+      INTEGER, DIMENSION(jp_nseg) :: jpjsob, jpisdt, jpisft
+
+      ! 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  ::   iw, ie, is, in, inum, id_dummy         !   -       -
+      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       -
+      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts
+      REAL   , POINTER  ::  flagu, flagv                   !    -   -
+      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
+      REAL(wp), DIMENSION(jpidta,jpjdta)    ::   zmask            ! global domain mask
+      CHARACTER(LEN=80),DIMENSION(jpbgrd)  ::   clfile
+      CHARACTER(LEN=1),DIMENSION(jpbgrd)   ::   cgrid
+      !!
+      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             &
+         &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, &
+         &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &  
+#if defined key_lim2
+         &             nn_ice_lim2, nn_ice_lim2_dta,                       &
+#endif
+         &             ln_vol, nn_volctl, nn_rimwidth
+      !!
+      NAMELIST/nambdy_index/ nbdysege, jpieob, jpjedt, jpjeft,             &
+                             nbdysegw, jpiwob, jpjwdt, jpjwft,             &
+                             nbdysegn, jpjnob, jpindt, jpinft,             &
+                             nbdysegs, jpjsob, jpisdt, jpisft
+
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('bdy_init')
+
+      IF( bdy_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'bdy_init : initialization of open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      !
+
+      IF( jperio /= 0 )   CALL ctl_stop( 'Cyclic or symmetric,',   &
+         &                               ' and general open boundary condition are not compatible' )
+
+      cgrid= (/'t','u','v'/)
+
+      ! -----------------------------------------
+      ! Initialise and read namelist parameters
+      ! -----------------------------------------
+
+      nb_bdy            = 0
+      ln_coords_file(:) = .false.
+      cn_coords_file(:) = ''
+      ln_mask_file      = .false.
+      cn_mask_file(:)   = ''
+      nn_dyn2d(:)       = 0
+      nn_dyn2d_dta(:)   = -1  ! uninitialised flag
+      nn_dyn3d(:)       = 0
+      nn_dyn3d_dta(:)   = -1  ! uninitialised flag
+      nn_tra(:)         = 0
+      nn_tra_dta(:)     = -1  ! uninitialised flag
+#if defined key_lim2
+      nn_ice_lim2(:)    = 0
+      nn_ice_lim2_dta(:)= -1  ! uninitialised flag
+#endif
+      ln_vol            = .false.
+      nn_volctl         = -1  ! uninitialised flag
+      nn_rimwidth(:)    = -1  ! uninitialised flag
+
+      REWIND( numnam )                    
+      READ  ( numnam, nambdy )
+
+      ! -----------------------------------------
+      ! Check and write out namelist parameters
+      ! -----------------------------------------
+
+      !                                   ! control prints
+      IF(lwp) WRITE(numout,*) '         nambdy'
+
+      IF( nb_bdy .eq. 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( nn_dyn2d(ib_bdy) )                  
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition'
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' )
+        END SELECT
+        IF( nn_dyn2d(ib_bdy) .gt. 0 ) 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
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  '
+        SELECT CASE( nn_dyn3d(ib_bdy) )                  
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' )
+        END SELECT
+        IF( nn_dyn3d(ib_bdy) .gt. 0 ) 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(lwp) WRITE(numout,*)
+
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  '
+        SELECT CASE( nn_tra(ib_bdy) )                  
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' )
+        END SELECT
+        IF( nn_tra(ib_bdy) .gt. 0 ) 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(lwp) WRITE(numout,*)
+
+#if defined key_lim2
+        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  '
+        SELECT CASE( nn_ice_lim2(ib_bdy) )                  
+          CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'        
+          CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme'
+          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' )
+        END SELECT
+        IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN 
+           SELECT CASE( nn_ice_lim2_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_lim2_dta must be 0 or 1' )
+           END SELECT
+        ENDIF
+        IF(lwp) WRITE(numout,*)
+#endif
+
+        IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS scheme = ', nn_rimwidth(ib_bdy)
+        IF(lwp) WRITE(numout,*)
+
+      ENDDO
+
+     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
+
+      ! -------------------------------------------------
+      ! Initialise indices arrays for open boundaries
+      ! -------------------------------------------------
+
+      ! Work out global dimensions of boundary data
+      ! ---------------------------------------------
+      REWIND( numnam )                    
+      DO ib_bdy = 1, nb_bdy
+
+         jpbdta = 1
+         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Work out size of global arrays from namelist parameters
+ 
+            ! No REWIND here because may need to read more than one nambdy_index namelist.
+            READ  ( numnam, nambdy_index )
+
+            ! Automatic boundary definition: if nbdysegX = -1
+            ! set boundary to whole side of model domain.
+            IF( nbdysege == -1 ) THEN
+               nbdysege = 1
+               jpieob(1) = jpiglo - 1
+               jpjedt(1) = 2
+               jpjeft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegw == -1 ) THEN
+               nbdysegw = 1
+               jpiwob(1) = 2
+               jpjwdt(1) = 2
+               jpjwft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegn == -1 ) THEN
+               nbdysegn = 1
+               jpjnob(1) = jpjglo - 1
+               jpindt(1) = 2
+               jpinft(1) = jpiglo - 1
+            ENDIF
+            IF( nbdysegs == -1 ) THEN
+               nbdysegs = 1
+               jpjsob(1) = 2
+               jpisdt(1) = 2
+               jpisft(1) = jpiglo - 1
+            ENDIF
+
+            nblendta(:,ib_bdy) = 0
+            DO iseg = 1, nbdysege
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1               
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg) + 1               
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjeft(iseg) - jpjedt(iseg)               
+            ENDDO
+            DO iseg = 1, nbdysegw
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1               
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg) + 1               
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpjwft(iseg) - jpjwdt(iseg)               
+            ENDDO
+            DO iseg = 1, nbdysegn
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1               
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg)               
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpinft(iseg) - jpindt(iseg) + 1
+            ENDDO
+            DO iseg = 1, nbdysegs
+               igrd = 1
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1               
+               igrd = 2
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg)
+               igrd = 3
+               nblendta(igrd,ib_bdy) = nblendta(igrd,ib_bdy) + jpisft(iseg) - jpisdt(iseg) + 1               
+            ENDDO
+
+            nblendta(:,ib_bdy) = nblendta(:,ib_bdy) * nn_rimwidth(ib_bdy)
+            jpbdta = MAXVAL(nblendta(:,ib_bdy))               
+
+
+         ELSE            ! Read size of arrays in boundary coordinates file.
+
+
+            CALL iom_open( cn_coords_file(ib_bdy), inum )
+            jpbdta = 1
+            DO igrd = 1, jpbgrd
+               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )  
+               nblendta(igrd,ib_bdy) = kdimsz(1)
+               jpbdta = MAX(jpbdta, kdimsz(1))
+            ENDDO
+
+         ENDIF 
+
+      ENDDO ! ib_bdy
+
+      ! Allocate arrays
+      !---------------
+      ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    &
+         &      nbrdta(jpbdta, jpbgrd, nb_bdy) )
+
+      ALLOCATE( dta_global(jpbdta, 1, jpk) )
+
+      ! Calculate global boundary index arrays or read in from file
+      !------------------------------------------------------------
+      REWIND( numnam )                    
+      DO ib_bdy = 1, nb_bdy
+
+         IF( .NOT. ln_coords_file(ib_bdy) ) THEN ! Calculate global index arrays from namelist parameters
+
+            ! No REWIND here because may need to read more than one nambdy_index namelist.
+            READ  ( numnam, nambdy_index )
+
+            ! Automatic boundary definition: if nbdysegX = -1
+            ! set boundary to whole side of model domain.
+            IF( nbdysege == -1 ) THEN
+               nbdysege = 1
+               jpieob(1) = jpiglo - 1
+               jpjedt(1) = 2
+               jpjeft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegw == -1 ) THEN
+               nbdysegw = 1
+               jpiwob(1) = 2
+               jpjwdt(1) = 2
+               jpjwft(1) = jpjglo - 1
+            ENDIF
+            IF( nbdysegn == -1 ) THEN
+               nbdysegn = 1
+               jpjnob(1) = jpjglo - 1
+               jpindt(1) = 2
+               jpinft(1) = jpiglo - 1
+            ENDIF
+            IF( nbdysegs == -1 ) THEN
+               nbdysegs = 1
+               jpjsob(1) = 2
+               jpisdt(1) = 2
+               jpisft(1) = jpiglo - 1
+            ENDIF
+
+            ! ------------ T points -------------
+            igrd = 1  
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  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
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  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
+
+            ! ------------ U points -------------
+            igrd = 2  
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  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
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir + 1
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  DO ii = jpisdt(iseg), jpisft(iseg) - 1
+                     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
+
+            ! ------------ V points -------------
+            igrd = 3  
+            icount = 0
+            DO ir = 1, nn_rimwidth(ib_bdy)
+               ! east
+               DO iseg = 1, nbdysege
+                  DO ij = jpjedt(iseg), jpjeft(iseg) - 1
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = jpieob(iseg) - ir + 1
+                     nbjdta(icount, igrd, ib_bdy) = ij
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! west
+               DO iseg = 1, nbdysegw
+                  DO ij = jpjwdt(iseg), jpjwft(iseg) - 1
+                     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
+               ! north
+               DO iseg = 1, nbdysegn
+                  DO ii = jpindt(iseg), jpinft(iseg)
+                     icount = icount + 1
+                     nbidta(icount, igrd, ib_bdy) = ii
+                     nbjdta(icount, igrd, ib_bdy) = jpjnob(iseg) - ir
+                     nbrdta(icount, igrd, ib_bdy) = ir
+                  ENDDO
+               ENDDO
+               ! south
+               DO iseg = 1, nbdysegs
+                  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
+
+         ELSE            ! Read global index arrays from boundary coordinates file.
+
+            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 
+
+      ENDDO 
+
+      ! Work out dimensions of boundary data on each processor
+      ! ------------------------------------------------------
+     
+      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
+
+      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_init : 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) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
+                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) 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)%nbmap(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) )
+         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) )
+
+         ! Dispatch mapping indices and discrete distances on each processor
+         ! -----------------------------------------------------------------
+
+         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) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   &
+                     & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   &
+                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN
+                     !
+                     icount = icount  + 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
+                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy)
+                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO 
+
+         ! 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( FLOAT( nbr - 1 ) *0.5 )      ! tanh formulation
+!              idx_bdy(ib_bdy)%nbw(ib,igrd) = (FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth))**2      ! quadratic
+!              idx_bdy(ib_bdy)%nbw(ib,igrd) =  FLOAT(nn_rimwidth+1-nbr)/FLOAT(nn_rimwidth)          ! linear
+            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   
+ 
+      IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN          ! EEL configuration at 5km resolution
+         zmask(         :                ,:) = 0.e0
+         zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0          
+      ELSE IF( ln_mask_file ) THEN
+         CALL iom_open( cn_mask_file, inum )
+         CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) )
+         CALL iom_close( inum )
+      ELSE
+         zmask(:,:) = 1.e0
+      ENDIF
+
+      DO ij = 1, nlcj      ! Save mask over local domain      
+         DO ii = 1, nlci
+            bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) )
+         END DO
+      END DO
+
+      ! Derive mask on U and V grid from mask on T grid
+      bdyumask(:,:) = 0.e0
+      bdyvmask(:,:) = 0.e0
+      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.
+
+
+      ! Mask corrections
+      ! ----------------
+      DO ik = 1, jpkm1
+         DO ij = 1, jpj
+            DO ii = 1, jpi
+               tmask(ii,ij,ik) = tmask(ii,ij,ik) * bdytmask(ii,ij)
+               umask(ii,ij,ik) = umask(ii,ij,ik) * bdyumask(ii,ij)
+               vmask(ii,ij,ik) = vmask(ii,ij,ik) * bdyvmask(ii,ij)
+               bmask(ii,ij)    = bmask(ii,ij)    * bdytmask(ii,ij)
+            END DO      
+         END DO
+      END DO
+
+      DO ik = 1, jpkm1
+         DO ij = 2, jpjm1
+            DO ii = 2, jpim1
+               fmask(ii,ij,ik) = fmask(ii,ij,ik) * bdytmask(ii,ij  ) * bdytmask(ii+1,ij  )   &
+                  &                              * bdytmask(ii,ij+1) * bdytmask(ii+1,ij+1)
+            END DO      
+         END DO
+      END DO
+
+      tmask_i (:,:) = tmask(:,:,1) * tmask_i(:,:)             
+      bdytmask(:,:) = tmask(:,:,1)
+
+      ! bdy masks and bmask are now set to zero on boundary points:
+      igrd = 1       ! In the free surface case, bmask is at T-points
+      DO ib_bdy = 1, nb_bdy
+        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)     
+          bmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0.e0
+        ENDDO
+      ENDDO
+      !
+      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.e0
+        ENDDO
+      ENDDO
+      !
+      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.e0
+        ENDDO
+      ENDDO
+      !
+      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.e0
+        ENDDO
+      ENDDO
+
+      ! Lateral boundary conditions
+      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. )
+      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )
+
+      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components
+
+         idx_bdy(ib_bdy)%flagu(:) = 0.e0
+         idx_bdy(ib_bdy)%flagv(:) = 0.e0
+         icount = 0 
+
+         !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward
+         !flagu =  0 : u is tangential
+         !flagu =  1 : u is normal to the boundary and is direction is inward
+  
+         igrd = 2      ! u-component 
+         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 = bdytmask(nbi  ,nbj)
+            zwfl = bdytmask(nbi+1,nbj)
+            IF( zefl + zwfl == 2 ) THEN
+               icount = icount + 1
+            ELSE
+               idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl
+            ENDIF
+         END DO
+
+         !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward
+         !flagv =  0 : u is tangential
+         !flagv =  1 : u is normal to the boundary and is direction is inward
+
+         igrd = 3      ! v-component
+         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 = bdytmask(nbi,nbj  )
+            zsfl = bdytmask(nbi,nbj+1)
+            IF( znfl + zsfl == 2 ) THEN
+               icount = icount + 1
+            ELSE
+               idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl
+            END IF
+         END DO
+ 
+         IF( icount /= 0 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   &
+               ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy
+            IF(lwp) WRITE(numout,*) ' ========== '
+            IF(lwp) WRITE(numout,*)
+            nstop = nstop + 1
+         ENDIF 
+    
+      ENDDO
+
+      ! Compute total lateral surface for volume correction:
+      ! ----------------------------------------------------
+      bdysurftot = 0.e0 
+      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)
+               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           &
+                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) &
+                  &                    * tmask_i(nbi  , nbj)                           &
+                  &                    * tmask_i(nbi+1, nbj)                   
+            ENDDO
+         ENDDO
+
+         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)
+               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           &
+                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) &
+                  &                    * tmask_i(nbi, nbj  )                           &
+                  &                    * tmask_i(nbi, nbj+1)
+            ENDDO
+         ENDDO
+         !
+         IF( lk_mpp )   CALL mpp_sum( bdysurftot )      ! sum over the global domain
+      END IF   
+      !
+      ! Tidy up
+      !--------
+      DEALLOCATE(nbidta, nbjdta, nbrdta)
+
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_init')
+
+   END SUBROUTINE bdy_init
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Dummy module                                   NO open boundaries
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_init      ! Dummy routine
+   END SUBROUTINE bdy_init
+#endif
+
+   !!=================================================================================
+END MODULE bdyini
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90	(revision 3437)
@@ -0,0 +1,736 @@
+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  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge
+   !!----------------------------------------------------------------------
+#if defined key_bdy
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'     Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !!   PUBLIC
+   !!      tide_init     : read of namelist and initialisation of tidal harmonics data
+   !!      tide_update   : calculation of tidal forcing at each timestep
+   !!   PRIVATE
+   !!      uvset         :\
+   !!      vday          : | Routines to correct tidal harmonics forcing for
+   !!      shpen         : | start time of integration
+   !!      ufset         : |
+   !!      vset          :/
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE iom
+   USE in_out_manager  ! I/O units
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE bdy_par         ! Unstructured boundary parameters
+   USE bdy_oce         ! ocean open boundary conditions
+   USE daymod          ! calendar
+   USE fldread, ONLY: fld_map
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tide_init     ! routine called in nemo_init
+   PUBLIC   tide_update   ! routine called in bdydyn
+
+   TYPE, PUBLIC ::   TIDES_DATA     !: Storage for external tidal harmonics data
+      INTEGER                                ::   ncpt       !: Actual number of tidal components
+      REAL(wp), POINTER, DIMENSION(:)        ::   speed      !: Phase speed of tidal constituent (deg/hr)
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   ssh        !: Tidal constituents : SSH
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   u          !: Tidal constituents : U
+      REAL(wp), POINTER, DIMENSION(:,:,:)    ::   v          !: Tidal constituents : V
+   END TYPE TIDES_DATA
+
+   INTEGER, PUBLIC, PARAMETER                  ::   jptides_max = 15      !: Max number of tidal contituents
+
+   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET ::   tides                 !: External tidal harmonics data
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tide_init
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE tide_init  ***
+      !!                     
+      !! ** Purpose : - Read in namelist for tides and initialise external
+      !!                tidal harmonics data
+      !!
+      !!----------------------------------------------------------------------
+      !! namelist variables
+      !!-------------------
+      LOGICAL                                   ::   ln_tide_date !: =T correct tide phases and amplitude for model start date
+      CHARACTER(len=80)                         ::   filtide      !: Filename root for tidal input files
+      CHARACTER(len= 4), DIMENSION(jptides_max) ::   tide_cpt     !: Names of tidal components used.
+      REAL(wp),          DIMENSION(jptides_max) ::   tide_speed   !: Phase speed of tidal constituent (deg/hr)
+      !!
+      INTEGER, DIMENSION(jptides_max)           ::   nindx              !: index of pre-set tidal components
+      INTEGER                                   ::   ib_bdy, itide, ib  !: dummy loop indices
+      INTEGER                                   ::   inum, igrd
+      INTEGER, DIMENSION(3)                     ::   ilen0              !: length of boundary data (from OBC arrays)
+      CHARACTER(len=80)                         ::   clfile             !: full file name for tidal input file 
+      REAL(wp)                                  ::   z_arg, z_atde, z_btde, z1t, z2t           
+      REAL(wp),DIMENSION(jptides_max)           ::   z_vplu, z_ftc
+      REAL(wp),ALLOCATABLE, DIMENSION(:,:,:)    ::   dta_read           !: work space to read in tidal harmonics data
+      !!
+      TYPE(TIDES_DATA),  POINTER                ::   td                 !: local short cut   
+      !!
+      NAMELIST/nambdy_tide/ln_tide_date, filtide, tide_cpt, tide_speed
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('tide_init')
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'tide_init : initialization of tidal harmonic forcing at open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+
+      REWIND(numnam)
+      DO ib_bdy = 1, nb_bdy
+         IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN
+
+            td => tides(ib_bdy)
+
+            ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries
+            ln_tide_date = .false.
+            filtide(:) = ''
+            tide_speed(:) = 0.0
+            tide_cpt(:) = ''
+
+            ! Don't REWIND here - may need to read more than one of these namelists.
+            READ  ( numnam, nambdy_tide )
+            !                                               ! Count number of components specified
+            td%ncpt = 0
+            DO itide = 1, jptides_max
+              IF( tide_cpt(itide) /= '' ) THEN
+                 td%ncpt = td%ncpt + 1
+              ENDIF
+            END DO
+
+            ! Fill in phase speeds from namelist
+            ALLOCATE( td%speed(td%ncpt) )
+            td%speed = tide_speed(1:td%ncpt)
+
+            ! Find constituents in standard list
+            DO itide = 1, td%ncpt
+               nindx(itide) = 0
+               IF( TRIM( tide_cpt(itide) ) == 'Q1'  )   nindx(itide) =  1
+               IF( TRIM( tide_cpt(itide) ) == 'O1'  )   nindx(itide) =  2
+               IF( TRIM( tide_cpt(itide) ) == 'P1'  )   nindx(itide) =  3
+               IF( TRIM( tide_cpt(itide) ) == 'S1'  )   nindx(itide) =  4
+               IF( TRIM( tide_cpt(itide) ) == 'K1'  )   nindx(itide) =  5
+               IF( TRIM( tide_cpt(itide) ) == '2N2' )   nindx(itide) =  6
+               IF( TRIM( tide_cpt(itide) ) == 'MU2' )   nindx(itide) =  7
+               IF( TRIM( tide_cpt(itide) ) == 'N2'  )   nindx(itide) =  8
+               IF( TRIM( tide_cpt(itide) ) == 'NU2' )   nindx(itide) =  9
+               IF( TRIM( tide_cpt(itide) ) == 'M2'  )   nindx(itide) = 10
+               IF( TRIM( tide_cpt(itide) ) == 'L2'  )   nindx(itide) = 11
+               IF( TRIM( tide_cpt(itide) ) == 'T2'  )   nindx(itide) = 12
+               IF( TRIM( tide_cpt(itide) ) == 'S2'  )   nindx(itide) = 13
+               IF( TRIM( tide_cpt(itide) ) == 'K2'  )   nindx(itide) = 14
+               IF( TRIM( tide_cpt(itide) ) == 'M4'  )   nindx(itide) = 15
+               IF( nindx(itide) == 0  .AND. lwp ) THEN
+                  WRITE(ctmp1,*) 'constitunent', itide,':', tide_cpt(itide), 'not in standard list'
+                  CALL ctl_warn( ctmp1 )
+               ENDIF
+            END DO
+            !                                               ! Parameter control and print
+            IF( td%ncpt < 1 ) THEN 
+               CALL ctl_stop( '          Did not find any tidal components in namelist nambdy_tide' )
+            ELSE
+               IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries'
+               IF(lwp) WRITE(numout,*) '             tidal components specified ', td%ncpt
+               IF(lwp) WRITE(numout,*) '                ', tide_cpt(1:td%ncpt)
+               IF(lwp) WRITE(numout,*) '             associated phase speeds (deg/hr) : '
+               IF(lwp) WRITE(numout,*) '                ', tide_speed(1:td%ncpt)
+            ENDIF
+
+
+            ! Allocate space for tidal harmonics data - 
+            ! get size from OBC data arrays
+            ! ---------------------------------------
+
+            ilen0(1) = SIZE( dta_bdy(ib_bdy)%ssh ) 
+            ALLOCATE( td%ssh( ilen0(1), td%ncpt, 2 ) )
+
+            ilen0(2) = SIZE( dta_bdy(ib_bdy)%u2d ) 
+            ALLOCATE( td%u( ilen0(2), td%ncpt, 2 ) )
+
+            ilen0(3) = SIZE( dta_bdy(ib_bdy)%v2d ) 
+            ALLOCATE( td%v( ilen0(3), td%ncpt, 2 ) )
+
+            ALLOCATE( dta_read( MAXVAL(ilen0), 1, 1 ) )
+
+
+            ! Open files and read in tidal forcing data
+            ! -----------------------------------------
+
+            DO itide = 1, td%ncpt
+               !                                                              ! SSH fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_T.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+               td%ssh(:,itide,1) = dta_read(1:ilen0(1),1,1)
+               CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) )
+               td%ssh(:,itide,2) = dta_read(1:ilen0(1),1,1)
+               CALL iom_close( inum )
+               !                                                              ! U fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_U.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+               td%u(:,itide,1) = dta_read(1:ilen0(2),1,1)
+               CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) )
+               td%u(:,itide,2) = dta_read(1:ilen0(2),1,1)
+               CALL iom_close( inum )
+               !                                                              ! V fields
+               clfile = TRIM(filtide)//TRIM(tide_cpt(itide))//'_grid_V.nc'
+               IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile
+               CALL iom_open( clfile, inum )
+               CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+               td%v(:,itide,1) = dta_read(1:ilen0(3),1,1)
+               CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) )
+               td%v(:,itide,2) = dta_read(1:ilen0(3),1,1)
+               CALL iom_close( inum )
+               !
+            END DO ! end loop on tidal components
+
+            IF( ln_tide_date ) THEN      ! correct for date factors
+
+!! used nmonth, nyear and nday from daymod....
+               ! Calculate date corrects for 15 standard consituents
+               ! This is the initialisation step, so nday, nmonth, nyear are the 
+               ! initial date/time of the integration.
+                 print *, nday,nmonth,nyear
+                 nyear  = int(ndate0 / 10000  )                          ! initial year
+                 nmonth = int((ndate0 - nyear * 10000 ) / 100 )          ! initial month
+                 nday   = int(ndate0 - nyear * 10000 - nmonth * 100)
+
+               CALL uvset( 0, nday, nmonth, nyear, z_ftc, z_vplu )
+
+               IF(lwp) WRITE(numout,*) 'Correcting tide for date:', nday, nmonth, nyear
+
+               DO itide = 1, td%ncpt       ! loop on tidal components
+                  !
+                  IF( nindx(itide) /= 0 ) THEN
+!!gm use rpi  and rad global variable  
+                     z_arg = 3.14159265d0 * z_vplu(nindx(itide)) / 180.0d0
+                     z_atde=z_ftc(nindx(itide))*cos(z_arg)
+                     z_btde=z_ftc(nindx(itide))*sin(z_arg)
+                     IF(lwp) WRITE(numout,'(2i5,8f10.6)') itide, nindx(itide), td%speed(itide),   &
+                        &                                 z_ftc(nindx(itide)), z_vplu(nindx(itide))
+                  ELSE
+                     z_atde = 1.0_wp
+                     z_btde = 0.0_wp
+                  ENDIF
+                  !                                         !  elevation         
+                  igrd = 1
+                  DO ib = 1, ilen0(igrd)                
+                     z1t = z_atde * td%ssh(ib,itide,1) + z_btde * td%ssh(ib,itide,2)
+                     z2t = z_atde * td%ssh(ib,itide,2) - z_btde * td%ssh(ib,itide,1)
+                     td%ssh(ib,itide,1) = z1t
+                     td%ssh(ib,itide,2) = z2t
+                  END DO
+                  !                                         !  u       
+                  igrd = 2
+                  DO ib = 1, ilen0(igrd)                
+                     z1t = z_atde * td%u(ib,itide,1) + z_btde * td%u(ib,itide,2)
+                     z2t = z_atde * td%u(ib,itide,2) - z_btde * td%u(ib,itide,1)
+                     td%u(ib,itide,1) = z1t
+                     td%u(ib,itide,2) = z2t
+                  END DO
+                  !                                         !  v       
+                  igrd = 3
+                  DO ib = 1, ilen0(igrd)                
+                     z1t = z_atde * td%v(ib,itide,1) + z_btde * td%v(ib,itide,2)
+                     z2t = z_atde * td%v(ib,itide,2) - z_btde * td%v(ib,itide,1)
+                     td%v(ib,itide,1) = z1t
+                     td%v(ib,itide,2) = z2t
+                  END DO
+                  !
+               END DO   ! end loop on tidal components
+               !
+            ENDIF ! date correction
+            !
+         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2
+         !
+      END DO ! loop on ib_bdy
+
+      IF( nn_timing == 1 ) CALL timing_stop('tide_init')
+
+   END SUBROUTINE tide_init
+
+
+   SUBROUTINE tide_update ( kt, idx, dta, td, jit, time_offset )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE tide_update  ***
+      !!                
+      !! ** Purpose : - Add tidal forcing to ssh, u2d and v2d OBC data arrays. 
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )          ::   kt      ! Main timestep counter
+!!gm doctor jit ==> kit
+      TYPE(OBC_INDEX), INTENT( in )  ::   idx     ! OBC indices
+      TYPE(OBC_DATA),  INTENT(inout) ::   dta     ! OBC external data
+      TYPE(TIDES_DATA),INTENT( in )  ::   td      ! tidal harmonics data
+      INTEGER,INTENT(in),OPTIONAL    ::   jit     ! Barotropic timestep counter (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                          :: itide, igrd, ib      ! dummy loop indices
+      INTEGER                          :: time_add             ! time offset in units of timesteps
+      REAL(wp)                         :: z_arg, z_sarg      
+      REAL(wp), DIMENSION(jptides_max) :: z_sist, z_cost
+      !!----------------------------------------------------------------------
+
+      IF( nn_timing == 1 ) CALL timing_start('tide_update')
+
+      time_add = 0
+      IF( PRESENT(time_offset) ) THEN
+         time_add = time_offset
+      ENDIF
+         
+      ! Note tide phase speeds are in deg/hour, so we need to convert the
+      ! elapsed time in seconds to hours by dividing by 3600.0
+      IF( PRESENT(jit) ) THEN  
+         z_arg = ( (kt-1) * rdt + (jit+time_add) * rdt / REAL(nn_baro,wp) ) * rad / 3600.0
+      ELSE                              
+         z_arg = (kt+time_add) * rdt * rad / 3600.0
+      ENDIF
+
+      DO itide = 1, td%ncpt
+         z_sarg = z_arg * td%speed(itide)
+         z_cost(itide) = COS( z_sarg )
+         z_sist(itide) = SIN( z_sarg )
+      END DO
+
+      DO itide = 1, td%ncpt
+         igrd=1                              ! SSH on tracer grid.
+         DO ib = 1, idx%nblenrim(igrd)
+            dta%ssh(ib) = dta%ssh(ib) + td%ssh(ib,itide,1)*z_cost(itide) + td%ssh(ib,itide,2)*z_sist(itide)
+            !    if(lwp) write(numout,*) 'z', ib, itide, dta%ssh(ib), td%ssh(ib,itide,1),td%ssh(ib,itide,2)
+         END DO
+         igrd=2                              ! U grid
+         DO ib=1, idx%nblenrim(igrd)
+            dta%u2d(ib) = dta%u2d(ib) + td%u(ib,itide,1)*z_cost(itide) + td%u(ib,itide,2)*z_sist(itide)
+            !    if(lwp) write(numout,*) 'u',ib,itide,utide(ib), td%u(ib,itide,1),td%u(ib,itide,2)
+         END DO
+         igrd=3                              ! V grid
+         DO ib=1, idx%nblenrim(igrd)
+            dta%v2d(ib) = dta%v2d(ib) + td%v(ib,itide,1)*z_cost(itide) + td%v(ib,itide,2)*z_sist(itide)
+            !    if(lwp) write(numout,*) 'v',ib,itide,vtide(ib), td%v(ib,itide,1),td%v(ib,itide,2)
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('tide_update')
+      !
+   END SUBROUTINE tide_update
+
+!!gm  doctor naming of dummy argument variables!!!   and all local variables
+
+   SUBROUTINE uvset( ihs, iday, imnth, iyr, f, z_vplu )
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE uvset  ***
+      !!                     
+      !! ** Purpose : - adjust tidal forcing for date factors
+      !!                
+      !!----------------------------------------------------------------------
+      implicit none
+      INTEGER, INTENT( in ) ::   ihs     ! Start time hours
+      INTEGER, INTENT( in ) ::   iday    ! start time days
+      INTEGER, INTENT( in ) ::   imnth   ! start time month
+      INTEGER, INTENT( in ) ::   iyr     ! start time year
+      !!
+!!gm  nc is jptides_max ????
+      INTEGER , PARAMETER     ::  nc =15    ! maximum number of constituents
+      CHARACTER(len=8), DIMENSION(nc) :: cname
+      INTEGER                 ::   year, vd, ivdy, ndc, i, k
+      REAL(wp)                ::   ss, h, p, en, p1, rtd
+      REAL(wp), DIMENSION(nc) ::   f                          ! nodal correction
+      REAL(wp), DIMENSION(nc) ::   z_vplu                     ! phase correction
+      REAL(wp), DIMENSION(nc) ::   u, v, zig
+      !!
+      DATA cname/  'q1'    ,    'o1'    ,     'p1'   ,    's1'    ,     'k1'    ,   &
+         &         '2n2'   ,    'mu2'   ,     'n2'   ,    'nu2'   ,     'm2'    ,   &
+         &         'l2'    ,    't2'    ,     's2'   ,    'k2'    ,     'm4'      /
+      DATA zig/ .2338507481, .2433518789, .2610826055, .2617993878,  .2625161701,   &
+         &      .4868657873, .4881373225, .4963669182, .4976384533,  .5058680490,   &
+         &      .5153691799, .5228820265, .5235987756, .5250323419, 1.011736098   /
+      !!----------------------------------------------------------------------
+!
+!     ihs             -  start time gmt on ...
+!     iday/imnth/iyr  -  date   e.g.   12/10/87
+!
+      CALL vday(iday,imnth,iyr,ivdy)
+      vd = ivdy
+!
+!rp   note change of year number for d. blackman shpen
+!rp   if(iyr.ge.1000) year=iyr-1900
+!rp   if(iyr.lt.1000) year=iyr
+      year = iyr
+!
+!.....year  =  year of required data
+!.....vd    =  day of required data..set up for 0000gmt day year
+      ndc = nc
+!.....ndc   =  number of constituents allowed
+!!gm use rpi ?
+      rtd = 360.0 / 6.2831852
+      DO i = 1, ndc
+         zig(i) = zig(i)*rtd
+         ! sigo(i)= zig(i)
+      END DO
+
+!!gm try to avoid RETURN  in F90
+      IF( year == 0 )   RETURN
+      
+         CALL shpen( year, vd, ss, h , p , en, p1 )
+         CALL ufset( p   , en, u , f )
+         CALL vset ( ss  , h , p , en, p1, v )
+         !
+         DO k = 1, nc
+            z_vplu(k) = v(k) + u(k)
+            z_vplu(k) = z_vplu(k) + dble(ihs) * zig(k)
+            DO WHILE( z_vplu(k) < 0    )
+               z_vplu(k) = z_vplu(k) + 360.0
+            END DO
+            DO WHILE( z_vplu(k) > 360. )
+               z_vplu(k) = z_vplu(k) - 360.0
+            END DO
+         END DO
+         !
+      END SUBROUTINE uvset
+
+
+      SUBROUTINE vday( iday, imnth, iy, ivdy )
+      !!----------------------------------------------------------------------
+      !!                   *** SUBROUTINE vday  ***
+      !!                  
+      !! ** Purpose : - adjust tidal forcing for date factors
+      !!                
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   iday, imnth, iy   ! ????
+      INTEGER, INTENT(  out) ::   ivdy              ! ???
+      !! 
+      INTEGER ::   iyr
+      !!------------------------------------------------------------------------------
+
+!!gm   nday_year in day mode is the variable compiuted here, no?
+!!gm      nday_year ,   &  !: curent day counted from jan 1st of the current year
+
+      !calculate day number in year from day/month/year
+       if(imnth.eq.1) ivdy=iday
+       if(imnth.eq.2) ivdy=iday+31
+       if(imnth.eq.3) ivdy=iday+59
+       if(imnth.eq.4) ivdy=iday+90
+       if(imnth.eq.5) ivdy=iday+120
+       if(imnth.eq.6) ivdy=iday+151
+       if(imnth.eq.7) ivdy=iday+181
+       if(imnth.eq.8) ivdy=iday+212
+       if(imnth.eq.9) ivdy=iday+243
+       if(imnth.eq.10) ivdy=iday+273
+       if(imnth.eq.11) ivdy=iday+304
+       if(imnth.eq.12) ivdy=iday+334
+       iyr=iy
+       if(mod(iyr,4).eq.0.and.imnth.gt.2) ivdy=ivdy+1
+       if(mod(iyr,100).eq.0.and.imnth.gt.2) ivdy=ivdy-1
+       if(mod(iyr,400).eq.0.and.imnth.gt.2) ivdy=ivdy+1
+      !
+   END SUBROUTINE vday
+
+!!doctor norme for dummy arguments
+
+   SUBROUTINE shpen( year, vd, s, h, p, en, p1 )
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE shpen  ***
+      !!                   
+      !! ** Purpose : - calculate astronomical arguments for tides
+      !!                this version from d. blackman 30 nove 1990
+      !!
+      !!----------------------------------------------------------------------
+!!gm add INTENT in, out or inout....    DOCTOR name....
+!!gm please do not use variable name with a single letter:  impossible to search in a code
+      INTEGER  ::   year,vd
+      REAL(wp) ::   s,h,p,en,p1
+      !!
+      INTEGER  ::   yr,ilc,icent,it,iday,ild,ipos,nn,iyd
+      REAL(wp) ::   cycle,t,td,delt(84),delta,deltat
+      !!
+      DATA delt /-5.04, -3.90, -2.87, -0.58,  0.71,  1.80,           &
+         &        3.08,  4.63,  5.86,  7.21,  8.58, 10.50, 12.10,    &
+         &       12.49, 14.41, 15.59, 15.81, 17.52, 19.01, 18.39,    &
+         &       19.55, 20.36, 21.01, 21.81, 21.76, 22.35, 22.68,    &
+         &       22.94, 22.93, 22.69, 22.94, 23.20, 23.31, 23.63,    &
+         &       23.47, 23.68, 23.62, 23.53, 23.59, 23.99, 23.80,    &
+         &       24.20, 24.99, 24.97, 25.72, 26.21, 26.37, 26.89,    &
+         &       27.68, 28.13, 28.94, 29.42, 29.66, 30.29, 30.96,    &
+         &       31.09, 31.59, 31.52, 31.92, 32.45, 32.91, 33.39,    &
+         &       33.80, 34.23, 34.73, 35.40, 36.14, 36.99, 37.87,    &
+         &       38.75, 39.70, 40.70, 41.68, 42.82, 43.96, 45.00,    &
+         &       45.98, 47.00, 48.03, 49.10, 50.10, 50.97, 51.81,    &
+         &       52.57 /
+      !!----------------------------------------------------------------------
+
+      cycle = 360.0
+      ilc = 0
+      icent = year / 100
+      yr = year - icent * 100
+      t = icent - 20
+!
+!     for the following equations
+!     time origin is fixed at 00 hr of jan 1st,2000.
+!     see notes by cartwright
+!
+!!gm  old coding style, use CASE instead  and avoid GOTO (obsolescence in fortran 90)
+!!gm obsol(   1): Arithmetic IF statement is used   ===>  remove this in Fortran 90
+      it = icent - 20
+      if (it) 1,2,2
+    1 iday = it/4 -it
+      go to 3
+    2 iday = (it+3)/4 - it
+!
+!     t is in julian century
+!     correction in gegorian calander where only century year divisible
+!     by 4 is leap year.
+!
+    3 continue
+!
+      td = 0.0
+!
+!!gm obsol(   1): Arithmetic IF statement is used   ===>  remove this in Fortran 90
+      if (yr) 4,5,4
+!
+    4 iyd = 365*yr
+      ild = (yr-1)/4
+      if((icent - (icent/4)*4) .eq. 0) ilc = 1
+      td = iyd + ild + ilc
+!
+    5 td = td + iday + vd -1.0 - 0.5
+      t = t + (td/36525.0)
+!
+      ipos=year-1899
+      if (ipos .lt. 0) go to 7
+      if (ipos .gt. 83) go to 6
+!
+      delta = (delt(ipos+1)+delt(ipos))/2.0
+      go to 7
+!
+    6 delta= (65.0-50.5)/20.0*(year-1980)+50.5
+!
+    7 deltat = delta * 1.0e-6
+!
+!!gm   precision of the computation   :  example for s it should be replace by:
+!!gm  s   = 218.3165 + (481267.8813 - 0.0016*t)*t + 152.0*deltat   ==>  more precise  modify the last digits results
+      s   = 218.3165 + 481267.8813*t - 0.0016*t*t + 152.0*deltat
+      h   = 280.4661 + 36000.7698 *t + 0.0003*t*t +  11.0*deltat
+      p   =  83.3535 + 4069.0139  *t - 0.0103*t*t +       deltat
+      en  = 234.9555 + 1934.1363  *t - 0.0021*t*t +       deltat
+      p1  = 282.9384 + 1.7195     *t + 0.0005*t*t
+      !
+      nn = s / cycle
+      s = s - nn * cycle
+      IF( s < 0.e0 )   s = s + cycle
+      !
+      nn = h / cycle
+      h = h - cycle * nn
+      IF( h < 0.e0 )   h = h + cycle
+      !
+      nn = p / cycle
+      p = p - cycle * nn
+      IF( p < 0.e0)   p = p + cycle
+      !
+      nn = en / cycle
+      en = en - cycle * nn
+      IF( en < 0.e0 )   en = en + cycle
+      en = cycle - en
+      !
+      nn = p1 / cycle
+      p1 = p1 - nn * cycle
+      !
+   END SUBROUTINE shpen
+
+
+   SUBROUTINE ufset( p, cn, b, a )
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE ufset  ***
+      !!                    
+      !! ** Purpose : - calculate nodal parameters for the tides
+      !!                
+      !!----------------------------------------------------------------------
+!!gm  doctor naming of dummy argument variables!!!   and all local variables
+!!gm  nc is jptides_max ????
+      integer nc
+      parameter (nc=15)
+      REAL(wp) p,cn
+      !!
+      
+!!gm  rad is already a public variable defined in phycst.F90 ....   ==> doctor norme  local real start with "z"
+      REAL(wp) ::   w1, w2, w3, w4, w5, w6, w7, w8, nw, pw, rad
+      REAL(wp) ::   a(nc), b(nc)
+      INTEGER  ::   ndc, k
+      !!----------------------------------------------------------------------
+
+      ndc = nc
+
+!    a=f       ,  b =u
+!    t is  zero as compared to tifa.
+!! use rad defined in phycst   (i.e.  add a USE phycst at the begining of the module
+      rad = 6.2831852d0/360.0
+      pw = p  * rad
+      nw = cn * rad
+      w1 = cos(   nw )
+      w2 = cos( 2*nw )
+      w3 = cos( 3*nw )
+      w4 = sin(   nw )
+      w5 = sin( 2*nw )
+      w6 = sin( 3*nw )
+      w7 = 1. - 0.2505 * COS( 2*pw      ) - 0.1102 * COS(2*pw-nw )   &
+         &    - 0.156  * COS( 2*pw-2*nw ) - 0.037  * COS(     nw )
+      w8 =    - 0.2505 * SIN( 2*pw      ) - 0.1102 * SIN(2*pw-nw )   &
+         &    - 0.0156 * SIN( 2*pw-2*nw ) - 0.037  * SIN(     nw )
+      !
+      a(1) = 1.0089 + 0.1871 * w1 - 0.0147 * w2 + 0.0014 * w3
+      b(1) =          0.1885 * w4 - 0.0234 * w5 + 0.0033 * w6
+      !   q1
+      a(2) = a(1)
+      b(2) = b(1)
+      !   o1
+      a(3) = 1.0
+      b(3) = 0.0
+      !   p1
+      a(4) = 1.0
+      b(4) = 0.0
+      !   s1
+      a(5) = 1.0060+0.1150*w1- 0.0088*w2 +0.0006*w3
+      b(5) = -0.1546*w4 + 0.0119*w5 -0.0012*w6
+      !   k1
+      a(6) =1.0004 -0.0373*w1+ 0.0002*w2
+      b(6) = -0.0374*w4
+      !  2n2
+      a(7) = a(6)
+      b(7) = b(6)
+      !  mu2
+      a(8) = a(6)
+      b(8) = b(6)
+      !   n2
+      a(9) = a(6)
+      b(9) = b(6)
+      !  nu2
+      a(10) = a(6)
+      b(10) = b(6)
+      !   m2
+      a(11) = SQRT( w7 * w7 + w8 * w8 )
+      b(11) = ATAN( w8 / w7 )
+!!gmuse rpi  instead of 3.141992 ???   true pi is rpi=3.141592653589793_wp  .....   ????
+      IF( w7 < 0.e0 )   b(11) = b(11) + 3.141992
+      !   l2
+      a(12) = 1.0
+      b(12) = 0.0
+      !   t2
+      a(13)= a(12)
+      b(13)= b(12)
+      !   s2
+      a(14) = 1.0241+0.2863*w1+0.0083*w2 -0.0015*w3
+      b(14) = -0.3096*w4 + 0.0119*w5 - 0.0007*w6
+      !   k2
+      a(15) = a(6)*a(6)
+      b(15) = 2*b(6)
+      !   m4
+!!gm  old coding,  remove GOTO and label of lines
+!!gm obsol(   1): Arithmetic IF statement is used   ===>  remove this in Fortran 90
+      DO 40 k = 1,ndc
+         b(k) = b(k)/rad
+32       if (b(k)) 34,35,35
+34       b(k) = b(k) + 360.0
+         go to 32
+35       if (b(k)-360.0) 40,37,37
+37       b(k) = b(k)-360.0
+         go to 35
+40    continue
+      !
+   END SUBROUTINE ufset
+   
+
+   SUBROUTINE vset( s,h,p,en,p1,v)
+      !!----------------------------------------------------------------------
+      !!                    ***  SUBROUTINE vset  ***
+      !!                   
+      !! ** Purpose : - calculate tidal phases for 0000gmt on start day of run
+      !!                
+      !!----------------------------------------------------------------------
+!!gm  doctor naming of dummy argument variables!!!   and all local variables
+!!gm  nc is jptides_max ????
+!!gm  en argument is not used: suppress it ?
+      integer nc
+      parameter (nc=15)
+      real(wp) s,h,p,en,p1
+      real(wp)   v(nc)
+      !!
+      integer ndc, k
+      !!----------------------------------------------------------------------
+
+      ndc = nc
+      !   v s  are computed here.
+      v(1) =-3*s +h +p +270      ! Q1
+      v(2) =-2*s +h +270.0       ! O1
+      v(3) =-h +270              ! P1
+      v(4) =180                  ! S1
+      v(5) =h +90.0              ! K1
+      v(6) =-4*s +2*h +2*p       ! 2N2
+      v(7) =-4*(s-h)             ! MU2
+      v(8) =-3*s +2*h +p         ! N2
+      v(9) =-3*s +4*h -p         ! MU2
+      v(10) =-2*s +2*h           ! M2
+      v(11) =-s +2*h -p +180     ! L2 
+      v(12) =-h +p1              ! T2
+      v(13) =0                   ! S2
+      v(14) =h+h                 ! K2
+      v(15) =2*v(10)             ! M4
+!
+!!gm  old coding,  remove GOTO and label of lines
+!!gm obsol(   1): Arithmetic IF statement is used   ===>  remove this in Fortran 90
+      do 72 k = 1, ndc
+69       if( v(k) )   70,71,71
+70       v(k) = v(k)+360.0
+         go to 69
+71       if( v(k) - 360.0 )   72,73,73
+73       v(k) = v(k)-360.0
+         go to 71
+72    continue
+      !
+   END SUBROUTINE vset
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module         NO Unstruct Open Boundary Conditions for tides
+   !!----------------------------------------------------------------------
+!!gm  are you sure we need to define filtide and tide_cpt ?
+   CHARACTER(len=80), PUBLIC               ::   filtide                !: Filename root for tidal input files
+   CHARACTER(len=4 ), PUBLIC, DIMENSION(1) ::   tide_cpt               !: Names of tidal components used.
+
+CONTAINS
+   SUBROUTINE tide_init                ! Empty routine
+   END SUBROUTINE tide_init
+   SUBROUTINE tide_data                ! Empty routine
+   END SUBROUTINE tide_data
+   SUBROUTINE tide_update( kt, kit )   ! Empty routine
+      WRITE(*,*) 'tide_update: You should not have seen this print! error?', kt, kit
+   END SUBROUTINE tide_update
+#endif
+
+   !!======================================================================
+END MODULE bdytides
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90	(revision 3437)
@@ -0,0 +1,111 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_bdy
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'                     Unstructured Open Boundary Conditions
+   !!----------------------------------------------------------------------
+   !!   bdy_tra            : Apply open boundary conditions to T and S
+   !!   bdy_tra_frs        : Apply Flow Relaxation Scheme
+   !!----------------------------------------------------------------------
+   USE timing          ! Timing
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdydta, ONLY:   bf
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC bdy_tra      ! routine called in tranxt.F90 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $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 ! Loop index
+
+      DO ib_bdy=1, nb_bdy
+
+         SELECT CASE( nn_tra(ib_bdy) )
+         CASE(jp_none)
+            CYCLE
+         CASE(jp_frs)
+            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt )
+         CASE DEFAULT
+            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
+         END SELECT
+      ENDDO
+
+   END SUBROUTINE bdy_tra
+
+   SUBROUTINE bdy_tra_frs( idx, dta, kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE bdy_tra_frs  ***
+      !!                    
+      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries.
+      !! 
+      !! Reference : Engedahl H., 1995, Tellus, 365-382.
+      !!----------------------------------------------------------------------
+      INTEGER,         INTENT(in) ::   kt
+      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices
+      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data
+      !! 
+      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_tra_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)
+            tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)         
+            tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik)
+         END DO
+      END DO 
+      !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )    ! Boundary points should be updated
+      !
+      IF( kt .eq. nit000 ) CLOSE( unit = 102 )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')
+      !
+   END SUBROUTINE bdy_tra_frs
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_tra(kt)      ! Empty routine
+      WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_tra
+#endif
+
+   !!======================================================================
+END MODULE bdytra
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90	(revision 3437)
@@ -0,0 +1,184 @@
+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
+   !!----------------------------------------------------------------------
+#if   defined key_bdy   &&   defined key_dynspg_flt
+   !!----------------------------------------------------------------------
+   !!   'key_bdy'            AND      unstructured open boundary conditions
+   !!   'key_dynspg_flt'                              filtered free surface
+   !!----------------------------------------------------------------------
+   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 lib_mpp         ! for mppsum
+   USE in_out_manager  ! I/O manager
+   USE sbc_oce         ! ocean surface boundary conditions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC bdy_vol        ! routine called by dynspg_flt.h90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE bdy_vol( kt )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE bdyvol  ***
+      !!
+      !! ** Purpose :   This routine is called in dynspg_flt to control 
+      !!      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
+      !!
+      !! ** 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
+      ! -----------------------------------------------------------------------
+      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0
+      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain
+
+      ! Transport through the unstructured open boundary
+      ! ------------------------------------------------
+      zubtpecor = 0.e0
+      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) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(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) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(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.e0
+      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) * zubtpecor * umask(ii,ij,jk)
+               ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(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) * zubtpecor * vmask(ii,ij,jk)
+               ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                   NO Unstruct Open Boundary Conditions
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE bdy_vol( kt )        ! Empty routine
+      WRITE(*,*) 'bdy_vol: You should not have seen this print! error?', kt
+   END SUBROUTINE bdy_vol
+#endif
+
+   !!======================================================================
+END MODULE bdyvol
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90	(revision 3437)
@@ -0,0 +1,24 @@
+MODULE c1d
+   !!======================================================================
+   !!                     ***  MODULE  c1d  ***
+   !! Ocean domain  :  1D configuration
+   !!=====================================================================
+   !! History :   2.0  !  2004-09  (C. Ethe)  Original code
+   !!             3.0  !  2008-04 (G. Madec)  adaptation to SBC
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+#if defined key_c1d
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .TRUE.    !: 1D config. flag activated
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c1d = .FALSE.   !: 1D config. flag de-activated
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90	(revision 3437)
@@ -0,0 +1,125 @@
+MODULE dyncor_c1d
+   !!======================================================================
+   !!                     ***  MODULE  dyncor_c1d  ***
+   !! Ocean Dynamics :   Coriolis term in 1D configuration
+   !!=====================================================================
+   !! History :  2.0  !  2004-09  (C. Ethe)  Original code
+   !!            3.0  !  2008-04  (G. Madec)  style only
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D Configuration
+   !!----------------------------------------------------------------------
+   !!   cor_c1d      : Coriolis factor at T-point (1D configuration)
+   !!   dyn_cor_c1d  : vorticity trend due to Coriolis at T-point
+   !!----------------------------------------------------------------------
+   USE oce               ! ocean dynamics and tracers
+   USE dom_oce           ! ocean space and time domain
+   USE phycst            ! physical constants
+   USE in_out_manager    ! I/O manager
+   USE prtctl            ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   cor_c1d      ! routine called by OPA.F90
+   PUBLIC   dyn_cor_c1d  ! routine called by step1d.F90
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cor_c1d
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE cor_c1d  ***
+      !! 
+      !! ** Purpose : set the Coriolis factor at T-point
+      !!----------------------------------------------------------------------
+      REAL(wp) ::   zphi0, zbeta, zf0         !  temporary scalars
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cor_c1d : Coriolis factor at T-point'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+      !
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+         ff(:,:) = 2. * omega * SIN( rad * gphit(:,:) ) 
+         !
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
+         !
+      CASE ( 3 )                     ! beta-plane
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points
+         zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         ff(:,:) = ( zf0  + zbeta * gphit(:,:) * 1.e+3 )                      ! f = f0 +beta* y ( y=0 at south)
+         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
+         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
+         !
+      CASE ( 5 )                     ! beta-plane and rotated domain
+         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
+         zphi0 = 15.e0                                                      ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+         ff(:,:) = ( zf0 + zbeta * ABS( gphit(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
+         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
+         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
+         !
+      END SELECT
+      !
+   END SUBROUTINE cor_c1d
+
+
+   SUBROUTINE dyn_cor_c1d( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_cor_c1d  ***
+      !! 
+      !! ** Purpose :   Compute the now Coriolis trend and add it to 
+      !!               the general trend of the momentum equation in 1D case.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER ::   ji, jj, jk         ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_cor_c1d : total vorticity trend in 1D'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ua(ji,jj,jk) + ff(ji,jj) * vn(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) - ff(ji,jj) * un(ji,jj,jk)
+            END DO
+         END DO
+      END DO   
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cor  - Ua: ', mask1=umask,  &
+         &                       tab3d_2=va, clinfo2=' Va: '       , mask2=vmask )
+      !
+   END SUBROUTINE dyn_cor_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO 1D Configuration
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE cor_c1d              ! Empty routine
+   END SUBROUTINE cor_c1d   
+   SUBROUTINE dyn_cor_c1d ( kt )      ! Empty routine
+      WRITE(*,*) 'dyn_cor_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_cor_c1d
+#endif
+
+   !!=====================================================================
+END MODULE dyncor_c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90	(revision 3437)
@@ -0,0 +1,103 @@
+MODULE dynnxt_c1d
+   !!======================================================================
+   !!                       ***  MODULE  dynnxt_c1d  ***
+   !! Ocean dynamics: time stepping in 1D configuration
+   !!======================================================================
+   !! History :  2.0  !  2004-10  (C. Ethe)  Original code from dynnxt.F90
+   !!            3.0  !  2008-04  (G.madec)  Style only
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                          1D Configuration
+   !!----------------------------------------------------------------------  
+   !!   dyn_nxt_c1d : update the horizontal velocity from the momentum trend
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition (or mpp link)
+   USE prtctl          ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_nxt_c1d                ! routine called by step.F90
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt_c1d  ***
+      !!                   
+      !! ** Purpose :   Compute the after horizontal velocity from the momentum trend.
+      !!
+      !! ** Method  :   Apply lateral boundary conditions on the trends (ua,va) 
+      !!      through calls to routine lbc_lnk.
+      !!      After velocity is compute using a leap-frog scheme environment:
+      !!         (ua,va) = (ub,vb) + 2 rdt (ua,va)
+      !!      Time filter applied on now horizontal velocity to avoid the
+      !!      divergence of two consecutive time-steps and swap of dynamics
+      !!      arrays to start the next time step:
+      !!         (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
+      !!         (un,vn) = (ua,va) 
+      !!
+      !! ** Action : - Update ub,vb arrays, the before horizontal velocity
+      !!             - Update un,vn arrays, the now horizontal velocity
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   z2dt         ! temporary scalar
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      z2dt = 2._wp * rdt                                                   ! Local constant initialization
+      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )      ! Lateral boundary conditions
+
+      DO jk = 1, jpkm1                                                     ! Next Velocity
+         ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
+         va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
+      END DO 
+ 
+      DO jk = 1, jpkm1                                                     ! Time filter and swap of dynamics arrays
+         IF( neuler == 0 .AND. kt == nit000 ) THEN                               ! Euler (forward) time stepping
+             ub(:,:,jk) = un(:,:,jk)
+             vb(:,:,jk) = vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ELSE                                                                    ! Leap-frog time stepping
+             ub(:,:,jk) = atfp * ( ub(:,:,jk) + ua(:,:,jk) ) + atfp1 * un(:,:,jk)
+             vb(:,:,jk) = atfp * ( vb(:,:,jk) + va(:,:,jk) ) + atfp1 * vn(:,:,jk)
+             un(:,:,jk) = ua(:,:,jk)
+             vn(:,:,jk) = va(:,:,jk)
+         ENDIF
+      END DO
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d  - Un: ', mask1=umask,   &
+         &                       tab3d_2=vn, clinfo2=' Vn: '           , mask2=vmask )
+      !
+   END SUBROUTINE dyn_nxt_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO 1D Config
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_nxt_c1d ( kt )
+      WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_nxt_c1d
+#endif
+
+   !!======================================================================
+END MODULE dynnxt_c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90	(revision 3437)
@@ -0,0 +1,158 @@
+MODULE step_c1d
+   !!======================================================================
+   !!                       ***  MODULE step_c1d  ***
+   !! Time-stepping    : manager of the ocean, tracer and ice time stepping - c1d case
+   !!======================================================================
+   !! History :   2.0  !  2004-04  (C. Ethe)  adapted from step.F90 for C1D
+   !!             3.0  !  2008-04  (G. Madec)  redo the adaptation to include SBC
+   !!----------------------------------------------------------------------
+#if defined key_c1d
+   !!----------------------------------------------------------------------
+   !!   'key_c1d'                                       1D Configuration
+   !!----------------------------------------------------------------------  
+   !!   stp_c1d        : NEMO system time-stepping in c1d case
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules 
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+   USE dyncor_c1d      ! Coriolis term (c1d case)         (dyn_cor_1d     )
+   USE dynnxt_c1d      ! time-stepping                    (dyn_nxt routine)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC stp_c1d      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/C1D 3.3 , NEMO Consortium (2010)
+   !! $Id: step_c1d.F90 2382 2010-11-13 13:08:12Z gm $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE stp_c1d( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE stp_c1d  ***
+      !!                      
+      !! ** Purpose :  - Time stepping of SBC including LIM (dynamic and thermodynamic eqs.)
+      !!               - Time stepping of OPA (momentum and active tracer eqs.)
+      !!               - Time stepping of TOP (passive tracer eqs.)
+      !! 
+      !! ** Method  : -1- Update forcings and data  
+      !!              -2- Update vertical ocean physics 
+      !!              -3- Compute the t and s trends 
+      !!              -4- Update t and s 
+      !!              -5- Compute the momentum trends
+      !!              -6- Update the horizontal velocity
+      !!              -7- Compute the diagnostics variables (rd,N2, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kstp   ! ocean time-step index
+      INTEGER ::   jk       ! dummy loop indice
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+                             indic = 0                ! reset to no error condition
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries, surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency
+      !  VERTICAL PHYSICS   
+                         CALL zdf_bfr( kstp )         ! bottom friction
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
+         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+      ENDIF
+
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:)   ;   END DO
+      ENDIF
+      IF( ln_zdfevd  )   CALL zdf_evd( kstp )         ! enhanced vertical eddy diffusivity
+
+      IF( lk_zdftmx  )   CALL zdf_tmx( kstp )         ! tidal vertical mixing
+
+      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   &
+         &               CALL zdf_ddm( kstp )         ! double diffusive mixing
+         
+                         CALL zdf_mxl( kstp )         ! mixed layer depth
+
+                                                      ! write tke information in the restart file
+      IF( lrst_oce .AND. lk_zdftke )   CALL tke_rst( kstp, 'WRITE' )
+                                                      ! write gls information in the restart file
+      IF( lrst_oce .AND. lk_zdfgls )   CALL gls_rst( kstp, 'WRITE' )
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs             (ua, va, ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL dia_wri( kstp )       ! ocean model: outputs
+
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL trc_stp( kstp )            ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              (ua, va used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             tsa(:,:,:,:) = 0.e0                ! set tracer trends to zero
+
+                             CALL tra_sbc    ( kstp )        ! surface boundary condition
+      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )        ! penetrative solar radiation qsr
+      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )        ! KPP non-local tracer fluxes
+                             CALL tra_zdf    ( kstp )        ! vertical mixing
+                             CALL tra_nxt    ( kstp )        ! tracer fields at next time step
+      IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s)
+                             CALL eos( tsb, rhd, rhop )      ! now (swap=before) in situ density for dynhpg module
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics                                    (ta, sa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               ua(:,:,:) = 0.e0               ! set dynamics trends to zero
+                               va(:,:,:) = 0.e0
+
+                               CALL dyn_cor_c1d( kstp )       ! vorticity term including Coriolis
+                               CALL dyn_zdf    ( kstp )       ! vertical diffusion
+                               CALL dyn_nxt_c1d( kstp )       ! lateral velocity at next time step
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control and restarts
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                                 CALL stp_ctl( kstp, indic )
+      IF( kstp == nit000     )   CALL iom_close( numror )             ! close input  ocean restart file
+      IF( lrst_oce           )   CALL rst_write  ( kstp )             ! write output ocean restart file
+      !
+   END SUBROUTINE stp_c1d
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            NO 1D Config
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE stp_c1d ( kt )      ! dummy routine
+      WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kt
+   END SUBROUTINE stp_c1d
+#endif
+
+   !!======================================================================
+END MODULE step_c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90	(revision 3437)
@@ -0,0 +1,242 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_diaar5   || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_diaar5'  :                           activate ar5 diagnotics
+   !!----------------------------------------------------------------------
+   !!   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_ar5        ! routine called in step.F90 module
+   PUBLIC   dia_ar5_init   ! routine called in opa.F90 module
+   PUBLIC   dia_ar5_alloc  ! routine called in nemogcm.F90 module
+
+   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .TRUE.   ! coupled flag
+
+   REAL(wp)                         ::   vol0         ! ocean volume (interior domain)
+   REAL(wp)                         ::   area_tot     ! total ocean surface (interior domain)
+   REAL(wp), 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
+      
+   !! * Substitutions
+#  include "domzgr_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), POINTER, DIMENSION(:,:)     :: zarea_ssh , zbotpres       ! 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')
+ 
+      CALL wrk_alloc( jpi , jpj              , zarea_ssh , zbotpres )
+      CALL wrk_alloc( jpi , jpj , jpk        , zrhd      , zrhop    )
+      CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn                 )
+
+      CALL iom_put( 'cellthc', fse3t(:,:,:) )
+
+      zarea_ssh(:,:) = area(:,:) * sshn(:,:)
+
+      !                                         ! 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 )
+
+      !                     
+      ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh
+      ztsn(:,:,:,jp_sal) = sn0(:,:,:)
+      CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity
+      !
+      zbotpres(:,:) = 0._wp                        ! no atmospheric surface pressure, levitating sea-ice
+      DO jk = 1, jpkm1
+         zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
+      END DO
+      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      !                                         
+      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 )                 ! 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(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk)
+      END DO
+      IF( .NOT.lk_vvl )   zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1)
+      !    
+      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 )
+
+      !                                         ! 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) * fse3t(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( .NOT.lk_vvl ) THEN
+         ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) )
+         zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) )
+      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  )
+      !
+      CALL wrk_dealloc( jpi , jpj              , zarea_ssh , zbotpres )
+      CALL wrk_dealloc( jpi , jpj , jpk        , zrhd      , zrhop    )
+      CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn                 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5')
+      !
+   END SUBROUTINE dia_ar5
+
+
+   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')
+      !
+      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(:,:) = e1t(:,:) * e2t(:,:) * 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) * fse3t_0(:,:,jk) )
+         thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk)
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( vol0 )
+      
+      CALL iom_open ( 'data_1m_salinity_nomask', inum )
+      CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1  )
+      CALL iom_get  ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )
+      CALL iom_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_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(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 )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ar5_init')
+      !
+   END SUBROUTINE dia_ar5_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                         NO diaar5
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE.   ! coupled flag
+CONTAINS
+   SUBROUTINE dia_ar5_init    ! Dummy routine
+   END SUBROUTINE dia_ar5_init
+   SUBROUTINE dia_ar5( kt )   ! Empty routine
+      INTEGER ::   kt
+      WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt
+   END SUBROUTINE dia_ar5
+#endif
+
+   !!======================================================================
+END MODULE diaar5
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90	(revision 3437)
@@ -0,0 +1,1203 @@
+MODULE diadct
+  !!=====================================================================
+  !!                       ***  MODULE  diadct  ***
+  !! Ocean diagnostics: Compute the transport trough a sec.
+  !!===============================================================
+  !! History : 
+  !!
+  !!         original  : 02/99 (Y Drillet)
+  !!         addition  : 10/01 (Y Drillet, R Bourdalle Badie)
+  !!                   : 10/05 (M Laborie) F90
+  !!         addition  : 04/07 (G Garric) Ice sections
+  !!         bugfix    : 04/07 (C Bricaud) test on sec%nb_point
+  !!                                      initialisation of ztransp1,ztransp2,...
+  !!         nemo_v_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 on U-point or V-point
+  !!   
+  !!----------------------------------------------------------------------
+  !! * Modules used
+  USE oce             ! ocean dynamics and tracers
+  USE dom_oce         ! ocean space and time domain
+  USE phycst          ! physical constants
+  USE in_out_manager  ! I/O manager
+  USE daymod          ! calendar
+  USE dianam          ! build name of file
+  USE lib_mpp         ! distributed memory computing library
+#if defined key_lim2 || defined key_lim3
+  USE ice
+#endif
+  USE domvvl
+  USE timing          ! preformance summary
+  USE wrk_nemo        ! working arrays
+
+  IMPLICIT NONE
+  PRIVATE
+
+  !! * Routine accessibility
+  PUBLIC   dia_dct     ! routine called by step.F90
+  PUBLIC   dia_dct_init! routine called by opa.F90
+  PRIVATE  readsec
+  PRIVATE  removepoints
+  PRIVATE  transport
+  PRIVATE  dia_dct_wri
+
+#include "domzgr_substitute.h90"
+
+  !! * Shared module variables
+  LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag
+
+  !! * Module variables
+  INTEGER :: nn_dct      = 1     ! Frequency of computation
+  INTEGER :: nn_dctwri   = 1     ! Frequency of output
+  INTEGER :: nn_secdebug = 0     ! 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 = 14
+  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         ! caracteristics 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
+ 
+ 
+CONTAINS
+
+  SUBROUTINE dia_dct_init
+     !!---------------------------------------------------------------------
+     !!               ***  ROUTINE diadct  ***  
+     !!
+     !!  ** Purpose: Read the namelist parametres
+     !!              Open output files
+     !!
+     !!---------------------------------------------------------------------
+     NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug
+
+     IF( nn_timing == 1 )   CALL timing_start('dia_dct_init')
+
+     !read namelist
+     REWIND( numnam )
+     READ  ( numnam, 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( lwp ) 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
+
+     IF( nn_timing == 1 )   CALL timing_stop('dia_dct_init')
+     !
+  END SUBROUTINE dia_dct_init
+ 
+ 
+  SUBROUTINE dia_dct(kt)
+     !!---------------------------------------------------------------------
+     !!               ***  ROUTINE diadct  ***  
+     !!
+     !!  ** Purpose: Compute sections tranport and write it in numdct file
+     !!---------------------------------------------------------------------
+     !! * Arguments
+     INTEGER,INTENT(IN)        ::kt
+
+     !! * Local variables
+     INTEGER             :: jsec,            &! loop on sections
+                            iost,            &! error for opening fileout
+                            itotal            ! nb_sec_max*nb_type_class*nb_class_max
+     LOGICAL             :: lldebug =.FALSE.  ! debug a section  
+     CHARACTER(len=160)  :: clfileout         ! fileout name
+
+     
+     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    
+ 
+     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 .AND. lwp ) lldebug=.TRUE. 
+
+           !Compute transport through section  
+           CALL transport(secs(jsec),lldebug) 
+
+        ENDDO
+             
+        IF( MOD(kt,nn_dctwri)==0 )THEN
+
+           IF( lwp .AND. kt==nit000+nn_dctwri-1 )WRITE(numout,*)"      diadct: write at kt = ",kt         
+  
+           !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( lwp )CALL dia_dct_wri(kt,jsec,secs(jsec))
+            
+              !nullify transports values after writing
+              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
+                                                              ! heat/salt tranport is actived
+
+     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 ( lwp .AND. ( 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( lwp .AND. ( 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( lwp .AND. ( 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 .NE. 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( lwp .AND. ( 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)
+              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==jpidta .AND. nimpp==1 ) iiglo = 2
+
+              iiloc=iiglo-jpizoom+1-nimpp+1   ! local coordinates of the point
+              ijloc=ijglo-jpjzoom+1-njmpp+1   !  "
+
+              !verify if the point is on the local domain:(1,nlei)*(1,nlej)
+              IF( iiloc .GE. 1 .AND. iiloc .LE. nlei .AND. &
+                  ijloc .GE. 1 .AND. ijloc .LE. 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
+
+           ENDDO
+     
+           secs(jsec)%nb_point=iptloc !store number of section's points
+
+           !debug
+           !-----
+           IF(   lwp .AND. ( 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 + jpizoom - 1 + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
+                 WRITE(numout,*)'         # I J : ',iiglo,ijglo
+              ENDDO
+           ENDIF
+
+              IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN
+              WRITE(narea+200,*)'avant secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc
+              DO jpt = 1,iptloc
+                 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
+                 WRITE(narea+200,*)'avant # I J : ',iiglo,ijglo
+              ENDDO
+              ENDIF
+
+           !remove redundant points between processors
+           !------------------------------------------
+           lldebug = .FALSE. ; IF ( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. lwp ) 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
+              WRITE(narea+200,*)'apres secs(jsec)%nb_point iptloc ',secs(jsec)%nb_point,iptloc
+              DO jpt = 1,secs(jsec)%nb_point
+                 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
+                 WRITE(narea+200,*)'apres # I J : ',iiglo,ijglo
+              ENDDO
+           ENDIF
+
+           !debug
+           !-----
+           IF( lwp .AND. ( 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 + jpizoom - 1 + nimpp - 1
+                 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
+                 WRITE(numout,*)'         # I J : ',iiglo,ijglo
+              ENDDO
+           ENDIF
+
+        ELSE  ! iptglo = 0
+           IF( lwp .AND. ( 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)
+     !!-------------------------------------------------------------------------------------------
+     !!                     ***  ROUTINE transport  ***
+     !!
+     !!  ** Purpose : Compute the transport through a section
+     !!
+     !!  ** Method  :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.   
+     !!
+     !!              !BE carefull :          
+     !!              one section is a sum of segments
+     !!              one segment is defined by 2 consectuve points in sec%listPoint
+     !!              all points of sec%listPoint are positioned on the F-point of the cell. 
+     !! 
+     !!              There are several loops:                 
+     !!              loop on the density/temperature/salinity/level classes
+     !!              loop on the segment between 2 nodes
+     !!              loop on the level jk
+     !!              test on the density/temperature/salinity/level
+     !!
+     !! ** Output: sec%transport: volume/mass/ice/heat/salt transport in the 2 directions
+     !!
+     !!
+     !!-------------------------------------------------------------------------------------------
+     !! * Arguments
+     TYPE(SECTION),INTENT(INOUT) :: sec
+     LOGICAL      ,INTENT(IN)    :: ld_debug
+    
+     !! * Local variables
+     INTEGER             :: jk,jseg,jclass,   &!loop on level/segment/classes 
+                            isgnu  , isgnv     !
+     INTEGER :: ii, ij ! local integer
+     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
+                ztransp1     , ztransp2     ,&!total        transport in directions 1 and 2
+                ztemp1       , ztemp2       ,&!temperature  transport     "
+                zrhoi1       , zrhoi2       ,&!mass         transport     "
+                zrhop1       , zrhop2       ,&!mass         transport     "
+                zsal1        , zsal2        ,&!salinity     transport     "
+                zice_vol_pos , zice_vol_neg ,&!volume  ice  transport     "
+                zice_surf_pos, zice_surf_neg  !surface ice  transport     "
+     REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
+
+     TYPE(POINT_SECTION) :: k
+     REAL(wp), POINTER, DIMENSION(:,:):: zsum ! 2D work array
+     !!--------------------------------------------------------
+     CALL wrk_alloc( nb_type_class , nb_class_max , zsum   )
+
+     IF( ld_debug )WRITE(numout,*)'      Compute transport'
+
+     !----------------!
+     ! INITIALIZATION !
+     !----------------!
+     zsum    = 0._wp
+     zice_surf_neg = 0._wp ; zice_surf_pos = 0._wp
+     zice_vol_pos  = 0._wp ; zice_vol_neg  = 0._wp
+
+     !---------------------------!
+     !  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( ld_debug )write(numout,*)"isgnu isgnv ",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 DENSITY CLASSES |
+           !-------------------------------
+           !The computation is made for each density class
+           DO jclass=1,MAX(1,sec%nb_class-1)
+
+              ztransp1=0._wp ; zrhoi1=0._wp ; zrhop1=0._wp ; ztemp1=0._wp ;zsal1=0._wp
+              ztransp2=0._wp ; zrhoi2=0._wp ; zrhop2=0._wp ; ztemp2=0._wp ;zsal2=0._wp
+    
+              !---------------------------|
+              !     LOOP ON THE LEVEL     |
+              !---------------------------|
+              !Sum of the transport on the vertical 
+              DO jk=1,jpk
+                    
+
+                 ! compute temparature, 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
+
+                 zfsdep= gdept(k%I,k%J,jk)
+ 
+                 !----------------------------------------------!
+                 !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.                  &
+                           ((( zfsdep .GE. sec%zlay(jclass)) .AND.            &
+                           (   zfsdep .LE. sec%zlay(jclass+1))) .OR.          &
+                           ( sec%zlay(jclass) .EQ. 99. ))))   THEN
+
+
+                    !compute velocity with the correct direction
+                    SELECT CASE( sec%direction(jseg) )
+                    CASE(0,1)  
+                       zumid=0.
+                       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.
+                    END SELECT
+
+                    !velocity* cell's length * cell's thickness
+                    zTnorm=zumid*e2u(k%I,k%J)*  fse3u(k%I,k%J,jk)+     &
+                           zvmid*e1v(k%I,k%J)*  fse3v(k%I,k%J,jk)
+
+#if ! defined key_vvl
+                    !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
+                    !COMPUTE TRANSPORT 
+                    !zTnorm=transport through one cell for one class
+                    !ztransp1 or ztransp2=transport through one cell i
+                    !                     for one class for one direction
+                    IF( zTnorm .GE. 0 )THEN
+
+                       ztransp1=zTnorm+ztransp1
+ 
+                       IF ( sec%llstrpond ) THEN
+                          ztemp1 = ztemp1  + zTnorm * ztn 
+                          zsal1  = zsal1   + zTnorm * zsn
+                          zrhoi1 = zrhoi1  + zTnorm * zrhoi
+                          zrhop1 = zrhop1  + zTnorm * zrhop
+                       ENDIF
+
+                    ELSE
+
+                       ztransp2=(zTnorm)+ztransp2
+
+                       IF ( sec%llstrpond ) THEN
+                          ztemp2 = ztemp2  + zTnorm * ztn 
+                          zsal2  = zsal2   + zTnorm * zsn
+                          zrhoi2 = zrhoi2  + zTnorm * zrhoi
+                          zrhop2 = zrhop2  + zTnorm * zrhop
+                       ENDIF
+                    ENDIF
+ 
+            
+                 ENDIF ! end of density test
+              ENDDO!end of loop on the level
+
+              !ZSUM=TRANSPORT FOR EACH CLASSES FOR THE  DIRECTIONS
+              !---------------------------------------------------
+              zsum(1,jclass)     = zsum(1,jclass)+ztransp1
+              zsum(2,jclass)     = zsum(2,jclass)+ztransp2
+              IF( sec%llstrpond )THEN
+                 zsum(3 ,jclass) = zsum( 3,jclass)+zrhoi1
+                 zsum(4 ,jclass) = zsum( 4,jclass)+zrhoi2
+                 zsum(5 ,jclass) = zsum( 5,jclass)+zrhop1
+                 zsum(6 ,jclass) = zsum( 6,jclass)+zrhop2
+                 zsum(7 ,jclass) = zsum( 7,jclass)+ztemp1
+                 zsum(8 ,jclass) = zsum( 8,jclass)+ztemp2
+                 zsum(9 ,jclass) = zsum( 9,jclass)+zsal1
+                 zsum(10,jclass) = zsum(10,jclass)+zsal2
+              ENDIF
+   
+           ENDDO !end of loop on the density classes
+
+#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( zTnorm .GE. 0)THEN
+                 zice_vol_pos = (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)) &
+                                      +zice_vol_pos
+                 zice_surf_pos = (zTnorm)*   &
+                                       (1.0 -  frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                      +zice_surf_pos
+              ELSE
+                 zice_vol_neg=(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)) &
+                                  +zice_vol_neg
+                 zice_surf_neg=(zTnorm)*   &
+                                    (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))  &
+                                     +zice_surf_neg
+              ENDIF
+   
+              zsum(11,1) = zsum(11,1)+zice_vol_pos
+              zsum(12,1) = zsum(12,1)+zice_vol_neg
+              zsum(13,1) = zsum(13,1)+zice_surf_pos
+              zsum(14,1) = zsum(14,1)+zice_surf_neg
+   
+           ENDIF !end of ice case
+#endif
+ 
+        ENDDO !end of loop on the segment
+
+
+     ELSE  !if sec%nb_point =0
+        zsum(1:2,:)=0.
+        IF (sec%llstrpond) zsum(3:10,:)=0.
+        zsum( 11:14,:)=0.
+     ENDIF   !end of sec%nb_point =0 case
+
+     !-------------------------------|
+     !FINISH COMPUTING TRANSPORTS    |
+     !-------------------------------|
+     DO jclass=1,MAX(1,sec%nb_class-1)
+        sec%transport(1,jclass)=sec%transport(1,jclass)+zsum(1,jclass)*1.E-6
+        sec%transport(2,jclass)=sec%transport(2,jclass)+zsum(2,jclass)*1.E-6
+        IF( sec%llstrpond ) THEN
+           IF( zsum(1,jclass) .NE. 0._wp ) THEN
+              sec%transport( 3,jclass) = sec%transport( 3,jclass) + zsum( 3,jclass)/zsum(1,jclass)
+              sec%transport( 5,jclass) = sec%transport( 5,jclass) + zsum( 5,jclass)/zsum(1,jclass)
+              sec%transport( 7,jclass) = sec%transport( 7,jclass) + zsum( 7,jclass)
+              sec%transport( 9,jclass) = sec%transport( 9,jclass) + zsum( 9,jclass)
+           ENDIF
+           IF( zsum(2,jclass) .NE. 0._wp )THEN
+              sec%transport( 4,jclass) = sec%transport( 4,jclass) + zsum( 4,jclass)/zsum(2,jclass)
+              sec%transport( 6,jclass) = sec%transport( 6,jclass) + zsum( 6,jclass)/zsum(2,jclass)
+              sec%transport( 8,jclass) = sec%transport( 8,jclass) + zsum( 8,jclass)
+              sec%transport(10,jclass) = sec%transport(10,jclass) + zsum(10,jclass)
+           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
+           sec%transport( 7,jclass) = 0._wp
+           sec%transport( 8,jclass) = 0._wp
+           sec%transport(10,jclass) = 0._wp
+        ENDIF
+     ENDDO   
+
+     IF( sec%ll_ice_section ) THEN
+        sec%transport( 9,1)=sec%transport( 9,1)+zsum( 9,1)*1.E-6
+        sec%transport(10,1)=sec%transport(10,1)+zsum(10,1)*1.E-6
+        sec%transport(11,1)=sec%transport(11,1)+zsum(11,1)*1.E-6
+        sec%transport(12,1)=sec%transport(12,1)+zsum(12,1)*1.E-6
+     ENDIF
+
+     CALL wrk_dealloc( nb_type_class , nb_class_max , zsum   )
+     !
+  END SUBROUTINE transport
+  
+  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 * rhau * Cp / 1.e15
+     !! 
+     !!        3. Write salt transports in "salt_transport"
+     !!           Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
+     !!
+     !!------------------------------------------------------------- 
+     !!arguments
+     INTEGER, INTENT(IN)          :: kt          ! time-step
+     TYPE(SECTION), INTENT(INOUT) :: sec         ! section to write   
+     INTEGER ,INTENT(IN)          :: ksec        ! section number
+
+     !!local declarations
+     INTEGER               :: jcl,ji             ! Dummy loop
+     CHARACTER(len=2)      :: classe             ! Classname 
+     REAL(wp)              :: zbnd1,zbnd2        ! Class bounds
+     REAL(wp)              :: zslope             ! section's slope coeff
+     !
+     REAL(wp), POINTER, DIMENSION(:):: zsumclass ! 1D workspace 
+     !!------------------------------------------------------------- 
+     CALL wrk_alloc(nb_type_class , zsumclass )  
+
+     zsumclass(:)=0._wp
+     zslope = sec%slopeSection       
+
+ 
+     DO jcl=1,MAX(1,sec%nb_class-1)
+
+        ! Mean computation
+        sec%transport(:,jcl)=sec%transport(:,jcl)/(nn_dctwri/nn_dct)
+        classe   = 'N       '
+        zbnd1   = 0._wp
+        zbnd2   = 0._wp
+        zsumclass(1:nb_type_class)=zsumclass(1:nb_type_class)+sec%transport(1:nb_type_class,jcl)
+
+   
+        !insitu density classes transports
+        IF( ( sec%zsigi(jcl)   .NE. 99._wp ) .AND. &
+            ( sec%zsigi(jcl+1) .NE. 99._wp )       )THEN
+           classe = 'DI       '
+           zbnd1 = sec%zsigi(jcl)
+           zbnd2 = sec%zsigi(jcl+1)
+        ENDIF
+        !potential density classes transports
+        IF( ( sec%zsigp(jcl)   .NE. 99._wp ) .AND. &
+            ( sec%zsigp(jcl+1) .NE. 99._wp )       )THEN
+           classe = 'DP      '
+           zbnd1 = sec%zsigp(jcl)
+           zbnd2 = sec%zsigp(jcl+1)
+        ENDIF
+        !depth classes transports
+        IF( ( sec%zlay(jcl)    .NE. 99._wp ) .AND. &
+            ( sec%zlay(jcl+1)  .NE. 99._wp )       )THEN 
+           classe = 'Z       '
+           zbnd1 = sec%zlay(jcl)
+           zbnd2 = sec%zlay(jcl+1)
+        ENDIF
+        !salinity classes transports
+        IF( ( sec%zsal(jcl) .NE. 99._wp    ) .AND. &
+            ( sec%zsal(jcl+1) .NE. 99._wp  )       )THEN
+           classe = 'S       '
+           zbnd1 = sec%zsal(jcl)
+           zbnd2 = sec%zsal(jcl+1)   
+        ENDIF
+        !temperature classes transports
+        IF( ( sec%ztem(jcl) .NE. 99._wp     ) .AND. &
+            ( sec%ztem(jcl+1) .NE. 99._wp     )       ) THEN
+           classe = 'T       '
+           zbnd1 = sec%ztem(jcl)
+           zbnd2 = sec%ztem(jcl+1)
+        ENDIF
+                  
+        !write volume transport per class
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(1,jcl),sec%transport(2,jcl), &
+                              sec%transport(1,jcl)+sec%transport(2,jcl)
+
+        IF( sec%llstrpond )THEN
+
+           !write heat transport per class:
+           WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope,  &
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(7,jcl)*1000._wp*rcp/1.e15,sec%transport(8,jcl)*1000._wp*rcp/1.e15, &
+                              ( sec%transport(7,jcl)+sec%transport(8,jcl) )*1000._wp*rcp/1.e15
+           !write salt transport per class
+           WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope,  &
+                              jcl,classe,zbnd1,zbnd2,&
+                              sec%transport(9,jcl)*1000._wp/1.e9,sec%transport(10,jcl)*1000._wp/1.e9,&
+                              (sec%transport(9,jcl)+sec%transport(10,jcl))*1000._wp/1.e9
+        ENDIF
+
+     ENDDO
+
+     zbnd1 = 0._wp
+     zbnd2 = 0._wp
+     jcl=0
+
+     !write total volume transport
+     WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(1),zsumclass(2),zsumclass(1)+zsumclass(2)
+
+     IF( sec%llstrpond )THEN
+
+        !write total heat transport
+        WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(7)* 1000._wp*rcp/1.e15,zsumclass(8)* 1000._wp*rcp/1.e15,&
+                           (zsumclass(7)+zsumclass(8) )* 1000._wp*rcp/1.e15
+        !write total salt transport
+        WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
+                           jcl,"total",zbnd1,zbnd2,&
+                           zsumclass(9)*1000._wp/1.e9,zsumclass(10)*1000._wp/1.e9,&
+                           (zsumclass(9)+zsumclass(10))*1000._wp/1.e9
+     ENDIF
+
+      
+     IF ( sec%ll_ice_section) THEN
+        !write total ice volume transport
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
+                              jcl,"ice_vol",zbnd1,zbnd2,&
+                              sec%transport(9,1),sec%transport(10,1),&
+                              sec%transport(9,1)+sec%transport(10,1)
+        !write total ice surface transport
+        WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
+                              jcl,"ice_surf",zbnd1,zbnd2,&
+                              sec%transport(11,1),sec%transport(12,1), &
+                              sec%transport(11,1)+sec%transport(12,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 , zsumclass )  
+  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. Veritcale 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, zfse3, zwgt1, zwgt2, zbis, zdepu            ! local real
+  REAL(wp):: zet1, zet2                                        ! weight for interpolation 
+  REAL(wp):: zdep1,zdep2                                       ! differences of depth
+  !!----------------------------------------------------------------------
+
+  IF( cd_point=='U' )THEN 
+     ii1 = ki    ; ij1 = kj 
+     ii2 = ki+1  ; ij2 = kj 
+
+     zet1=e1t(ii1,ij1)
+     zet2=e1t(ii2,ij2)
+
+  ELSE ! cd_point=='V' 
+     ii1 = ki    ; ij1 = kj 
+     ii2 = ki    ; ij2 = kj+1  
+
+     zet1=e2t(ii1,ij1)
+     zet2=e2t(ii2,ij2)
+
+  ENDIF
+
+  IF( ln_sco )THEN   ! s-coordinate case
+
+     zdepu = ( fsdept(ii1,ij1,kk) +  fsdept(ii2,ij2,kk) ) /2 
+     zdep1 = fsdept(ii1,ij1,kk) - zdepu
+     zdep2 = fsdept(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 = umask(ii1,ij1,kk) * ( zwgt2 *  ptab(ii1,ij1,kk) + zwgt1 *  ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )   
+
+
+  ELSE       ! full step or partial step case 
+
+#if defined key_vvl
+
+     ze3t  = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk) 
+     zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk)
+     zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk)
+
+#else
+
+     ze3t  = fse3t(ii2,ij2,kk)   - fse3t(ii1,ij1,kk) 
+     zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk)
+     zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk)
+
+#endif
+
+     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 = umask(ii1,ij1,kk) * ( 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 = umask(ii1,ij1,kk) * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 )
+        ENDIF    
+
+     ELSE
+        interp = umask(ii1,ij1,kk) * (  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 
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90	(revision 3437)
@@ -0,0 +1,229 @@
+MODULE diadimg
+   !!======================================================================
+   !!                     ***  MODULE  diadimg  ***
+   !! Ocean diagnostics :  write ocean output files in dimg direct access format (mpp)
+   !!=====================================================================
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O manager
+   USE daymod          ! calendar
+   USE lib_mpp
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dia_wri_dimg            ! called by trd_mld (eg)
+   PUBLIC dia_wri_dimg_alloc      ! called by nemo_alloc in nemogcm.F90
+
+
+   !! These workspace arrays are inside the module so that we can make them
+   !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp).
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d    ! 2d temporary workspace (sp)
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:)   :: z4dep   ! vertical level (sp)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION dia_wri_dimg_alloc()
+      !!---------------------------------------------------------------------
+      !!        *** ROUTINE dia_wri_dimg_alloc ***
+      !!
+      !!---------------------------------------------------------------------
+      INTEGER :: dia_wri_dimg_alloc   ! return value
+      !!---------------------------------------------------------------------
+      !
+      IF( .NOT. ALLOCATED( z42d ) )THEN
+
+         ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc )
+
+         IF( lk_mpp                  )   CALL mpp_sum ( dia_wri_dimg_alloc )
+         IF( dia_wri_dimg_alloc /= 0 )   CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.')
+
+      ELSE
+
+         dia_wri_dimg_alloc = 0
+
+      ENDIF
+      !
+  END FUNCTION dia_wri_dimg_alloc
+
+
+  SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi )
+    !!-------------------------------------------------------------------------
+    !!        *** ROUTINE dia_wri_dimg ***
+    !!
+    !! ** Purpose :   write ptab in the dimg file cd_name, with comment cd_text.
+    !!              ptab has klev x 2D fields
+    !!
+    !! ** Action :   Define header variables from the config parameters
+    !!               Open the dimg file on unit inum = 14 ( IEEE I4R4 file )
+    !!               Write header on record 1
+    !!               Write ptab on the following klev records
+    !!
+    !! History :  2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d
+    !!---------------------------------------------------------------------------
+    CHARACTER(len=*),INTENT(in) ::   &
+         &                            cd_name,  &  ! dimg file name
+         &                            cd_text      ! comment to write on record #1
+    INTEGER, INTENT(in) ::            klev         ! number of level in ptab to write
+    REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab  ! 3D array to write 
+    CHARACTER(LEN=1),INTENT(in) ::    cd_type      ! either 'T', 'W' or '2' , depending on the vertical
+    !                                              ! grid for ptab. 2 stands for 2D file
+    INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi 
+
+    !! * Local declarations
+    INTEGER :: jk, jn           ! dummy loop indices
+    INTEGER :: irecl4,             &    ! record length in bytes
+         &       inum,             &    ! logical unit (set to 14)
+         &       irec,             &    ! current record to be written
+         &       irecend                ! record number where nclit... are stored
+    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm
+    REAL(sp)                    :: zsouth
+
+    CHARACTER(LEN=80) :: clname                ! name of file in case of dimgnnn
+    CHARACTER(LEN=4) :: clver='@!01'           ! dimg string identifier
+    !!---------------------------------------------------------------------------
+
+    !                                      ! allocate dia_wri_dimg array
+    IF( dia_wri_dimg_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' )
+
+    !! * Initialisations
+
+    irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp )
+
+    zspval=0.0_sp    ! special values on land
+    !  the 'numerical' grid is described. The geographical one is in a grid file
+    zdx=1._sp
+    zdy=1._sp
+    zsouth=njmpp * 1._sp
+    zwest=nimpp * 1._sp
+    !  time in days since the historical begining of the run (nit000 = 0 ) 
+    ztimm=adatrj
+
+    SELECT CASE ( cd_type )
+
+    CASE ( 'T')
+       z4dep(:)=gdept_0(:)
+
+    CASE ( 'W' )
+       z4dep(:)=gdepw_0(:)
+
+    CASE ( '2' )
+       z4dep(1:klev) =(/(jk, jk=1,klev)/)
+
+    CASE ( 'I' )
+       z4dep(1:klev) = ksubi(1:klev)
+
+    CASE DEFAULT
+       IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg '
+       STOP 'dia_wri_dimg'
+
+    END SELECT
+
+    IF ( ln_dimgnnn  ) THEN
+     irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp  )
+       WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea
+       CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp)
+       WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
+            &     jpi,jpj, klev, 1 , 1 ,            &
+            &     zwest, zsouth, zdx, zdy, zspval,  &
+            &     z4dep(1:klev),                    &
+            &     ztimm,                            &
+            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output
+            &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !
+
+       !! * Write klev levels
+       IF ( cd_type == 'I' ) THEN
+
+          DO jk = 1, klev
+             irec =1 + jk
+             z42d(:,:) = ptab(:,:,ksubi(jk))
+             WRITE(inum,REC=irec)  z42d(:,:)
+          END DO
+       ELSE
+          DO jk = 1, klev
+             irec =1 + jk
+             z42d(:,:) = ptab(:,:,jk)
+             WRITE(inum,REC=irec)  z42d(:,:)
+          END DO
+       ENDIF
+    ELSE
+       clver='@!03'           ! dimg string identifier
+       ! note that version @!02 is optimized with respect to record length.
+       ! The vertical dep variable is reduced to klev instead of klev*jpnij :
+       !   this is OK for jpnij < 181 (jpk=46)
+       ! for more processors, irecl4 get huge and that's why we switch to '@!03':
+       !  In this case we just add an extra integer to the standard dimg structure,
+       !  which is a record number where the arrays nlci etc... starts (1 per record)
+       
+       !! Standard dimgproc (1 file per variable, all procs. write to this file )
+       !! * Open file
+       CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp)
+
+       !! * Write header on record #1
+       irecend=1 + klev*jpnij 
+       IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
+            &     jpi,jpj, klev, 1 , 1 ,            &
+            &     zwest, zsouth, zdx, zdy, zspval,  &
+            &     z4dep(1:klev),       &
+            &     ztimm,                            &
+            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend 
+       IF (lwp ) THEN
+         WRITE(inum,REC=irecend + 1 ) nlcit
+         WRITE(inum,REC=irecend + 2 ) nlcjt
+         WRITE(inum,REC=irecend + 3 ) nldit
+         WRITE(inum,REC=irecend + 4 ) nldjt
+         WRITE(inum,REC=irecend + 5 ) nleit
+         WRITE(inum,REC=irecend + 6 ) nlejt
+         WRITE(inum,REC=irecend + 7 ) nimppt
+         WRITE(inum,REC=irecend + 8 ) njmppt
+       ENDIF
+      !   &    ! extension to dimg for mpp output
+      !   &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !
+
+       !! * Write klev levels
+       IF ( cd_type == 'I' ) THEN
+
+          DO jk = 1, klev
+             irec =1 + klev * (narea -1) + jk
+             z42d(:,:) = ptab(:,:,ksubi(jk))
+             WRITE(inum,REC=irec)  z42d(:,:)
+          END DO
+       ELSE
+          DO jk = 1, klev
+             irec =1 + klev * (narea -1) + jk
+             z42d(:,:) = ptab(:,:,jk)
+             WRITE(inum,REC=irec)  z42d(:,:)
+          END DO
+       ENDIF
+    ENDIF
+
+    !! * Close the file
+    CLOSE(inum)
+
+  END SUBROUTINE dia_wri_dimg
+
+#  else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type )
+      REAL, DIMENSION(:,:,:) :: ptab
+      INTEGER :: klev
+      CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type
+      WRITE(*,*) ' This print must never occur ', cd_name, cd_exper,ptab, klev, cd_type
+      WRITE(*,*) ' this routine is here just for compilation '
+   END SUBROUTINE dia_wri_dimg
+# endif
+   !!======================================================================
+END MODULE diadimg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90	(revision 3437)
@@ -0,0 +1,463 @@
+MODULE diafwb
+   !!======================================================================
+   !!                       ***  MODULE  diafwb  ***
+   !! Ocean diagnostics: freshwater budget
+   !!======================================================================
+   !! History :  8.2  !  01-02  (E. Durand)  Original code
+   !!            8.5  !  02-06  (G. Madec)  F90: Free form and module
+   !!            9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
+   !!----------------------------------------------------------------------
+#if (  defined key_orca_r1 || defined key_orca_r2 || defined  key_orca_r4 ) && ! defined key_coupled
+   !!----------------------------------------------------------------------
+   !!   "key_orca_r1 or 2 or 4"
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   dia_fwb     : freshwater budget for global ocean configurations
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! ???
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+   USE timing          ! preformance summary
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dia_fwb    ! routine called by step.F90
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .TRUE.    !: fresh water budget flag
+
+   REAL(wp)               ::   a_fwf ,          &
+      &                        a_sshb, a_sshn, a_salb, a_saln
+   REAL(wp), DIMENSION(4) ::   a_flxi, a_flxo, a_temi, a_temo, a_sali, a_salo
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_fwb( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_fwb  ***
+      !!     
+      !! ** Purpose :
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER :: inum             ! temporary logical unit
+      INTEGER :: ji, jj, jk, jt   ! dummy loop indices
+      INTEGER :: ii0, ii1, ij0, ij1
+      REAL(wp) ::   zarea, zvol, zwei
+      REAL(wp) ::  ztemi(4), ztemo(4), zsali(4), zsalo(4), zflxi(4), zflxo(4)
+      REAL(wp) ::  zt, zs, zu  
+      REAL(wp) ::  zsm0, zfwfnew
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_fwb')
+
+      ! Mean global salinity
+      zsm0 = 34.72654
+
+      ! To compute fwf mean value mean fwf
+
+      IF( kt == nit000 ) THEN
+
+         a_fwf    = 0.e0
+         a_sshb   = 0.e0 ! valeur de ssh au debut de la simulation
+         a_salb   = 0.e0 ! valeur de sal au debut de la simulation
+         ! sshb used because diafwb called after tranxt (i.e. after the swap)
+         a_sshb = SUM( e1t(:,:) * e2t(:,:) * sshb(:,:) * tmask_i(:,:) )
+         IF( lk_mpp )   CALL mpp_sum( a_sshb )      ! sum over the global domain
+
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( a_salb )      ! sum over the global domain
+      ENDIF
+      
+      a_fwf    = SUM( e1t(:,:) * e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 
+      IF( lk_mpp )   CALL mpp_sum( a_fwf    )       ! sum over the global domain
+
+      IF( kt == nitend ) THEN
+         a_sshn = 0.e0
+         a_saln = 0.e0
+         zarea = 0.e0
+         zvol  = 0.e0
+         zfwfnew = 0.e0
+         ! Mean sea level at nitend
+         a_sshn = SUM( e1t(:,:) * e2t(:,:) * sshn(:,:) * tmask_i(:,:) )
+         IF( lk_mpp )   CALL mpp_sum( a_sshn )      ! sum over the global domain
+         zarea  = SUM( e1t(:,:) * e2t(:,:) *             tmask_i(:,:) )
+         IF( lk_mpp )   CALL mpp_sum( zarea  )      ! sum over the global domain
+         
+         DO jk = 1, jpkm1   
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei
+                  zvol  = zvol  + zwei
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( a_saln )      ! sum over the global domain
+         IF( lk_mpp )   CALL mpp_sum( zvol )      ! sum over the global domain
+         
+         ! Conversion in m3
+         a_fwf    = a_fwf * rdttra(1) * 1.e-3 
+         
+         ! fwf correction to bring back the mean ssh to zero
+         zfwfnew = a_sshn / ( ( nitend - nit000 + 1 ) * rdt ) * 1.e3 / zarea
+
+      ENDIF
+
+
+      ! Calcul des termes de transport 
+      ! ------------------------------
+      
+      ! 1 --> Gibraltar 
+      ! 2 --> Cadiz 
+      ! 3 --> Red Sea
+      ! 4 --> Baltic Sea
+
+      IF( kt == nit000 ) THEN
+         a_flxi(:) = 0.e0
+         a_flxo(:) = 0.e0
+         a_temi(:) = 0.e0
+         a_temo(:) = 0.e0
+         a_sali(:) = 0.e0
+         a_salo(:) = 0.e0
+      ENDIF
+
+      zflxi(:) = 0.e0
+      zflxo(:) = 0.e0
+      ztemi(:) = 0.e0
+      ztemo(:) = 0.e0
+      zsali(:) = 0.e0
+      zsalo(:) = 0.e0
+
+      ! Mean flow at Gibraltar
+
+      IF( cp_cfg == "orca" ) THEN  
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ii0 = 70   ;   ii1 = 70
+            ij0 = 52   ;   ij1 = 52
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ii0 = 140   ;   ii1 = 140
+            ij0 = 102   ;   ij1 = 102
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 283   ;   ii1 = 283
+            ij0 = 200   ;   ij1 = 200
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
+            ! 
+         END SELECT
+         ! 
+         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
+            DO jj = mj0(ij0), mj1(ij1)
+               DO jk = 1, jpk 
+                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+
+                  IF( un(ji,jj,jk) > 0.e0 ) THEN 
+                     zflxi(1) = zflxi(1) +    zu
+                     ztemi(1) = ztemi(1) + zt*zu
+                     zsali(1) = zsali(1) + zs*zu
+                  ELSE
+                     zflxo(1) = zflxo(1) +    zu
+                     ztemo(1) = ztemo(1) + zt*zu
+                     zsalo(1) = zsalo(1) + zs*zu
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+      
+      ! Mean flow at Cadiz
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ii0 = 69   ;   ii1 = 69
+            ij0 = 52   ;   ij1 = 52
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ii0 = 137   ;   ii1 = 137
+            ij0 = 101   ;   ij1 = 102
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 282   ;   ii1 = 282
+            ij0 = 200   ;   ij1 = 200
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
+            ! 
+         END SELECT
+         ! 
+         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
+            DO jj = mj0(ij0), mj1(ij1)
+               DO jk = 1, jpk 
+                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  
+                  IF( un(ji,jj,jk) > 0.e0 ) THEN 
+                     zflxi(2) = zflxi(2) +    zu
+                     ztemi(2) = ztemi(2) + zt*zu
+                     zsali(2) = zsali(2) + zs*zu
+                  ELSE
+                     zflxo(2) = zflxo(2) +    zu
+                     ztemo(2) = ztemo(2) + zt*zu
+                     zsalo(2) = zsalo(2) + zs*zu
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Mean flow at Red Sea entrance
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ii0 = 83   ;   ii1 = 83
+            ij0 = 45   ;   ij1 = 45
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ii0 = 160   ;   ii1 = 160
+            ij0 = 88    ;   ij1 = 88 
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 331   ;   ii1 = 331
+            ij0 = 176   ;   ij1 = 176
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
+            ! 
+         END SELECT
+         ! 
+         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
+            DO jj = mj0(ij0), mj1(ij1)
+               DO jk = 1, jpk 
+                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  
+                  IF( un(ji,jj,jk) > 0.e0 ) THEN 
+                     zflxi(3) = zflxi(3) +    zu
+                     ztemi(3) = ztemi(3) + zt*zu
+                     zsali(3) = zsali(3) + zs*zu
+                  ELSE
+                     zflxo(3) = zflxo(3) +    zu
+                     ztemo(3) = ztemo(3) + zt*zu
+                     zsalo(3) = zsalo(3) + zs*zu
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Mean flow at Baltic Sea entrance
+      IF( cp_cfg == "orca" ) THEN
+               
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            ii0 = 1     ;   ii1 = 1  
+            ij0 = 1     ;   ij1 = 1  
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            ii0 = 146   ;   ii1 = 146 
+            ij0 = 116   ;   ij1 = 116
+            !                                        ! =======================
+         CASE ( 1 )                                  !  ORCA_R1 configurations
+            !                                        ! =======================
+            ii0 = 297   ;   ii1 = 297 
+            ij0 = 230   ;   ij1 = 230
+            !                                        ! =======================
+         CASE DEFAULT                                !    ORCA R05 or R025
+            !                                        ! =======================
+            CALL ctl_stop( ' dia_fwb Not yet implemented in ORCA_R05 or R025' )
+            ! 
+         END SELECT
+         ! 
+         DO ji = mi0(ii0), MIN(mi1(ii1),jpim1)
+            DO jj = mj0(ij0), mj1(ij1)
+               DO jk = 1, jpk
+                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) )
+                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) )
+                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) * tmask_i(ji,jj)
+                  
+                  IF( un(ji,jj,jk) > 0.e0 ) THEN 
+                     zflxi(4) = zflxi(4) +    zu
+                     ztemi(4) = ztemi(4) + zt*zu
+                     zsali(4) = zsali(4) + zs*zu
+                  ELSE
+                     zflxo(4) = zflxo(4) +    zu
+                     ztemo(4) = ztemo(4) + zt*zu
+                     zsalo(4) = zsalo(4) + zs*zu
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Sum at each time-step
+      DO jt = 1, 4 
+         !
+         IF( zflxi(jt) /= 0.e0 ) THEN
+            a_flxi(jt) = a_flxi(jt) + zflxi(jt)
+            a_temi(jt) = a_temi(jt) + ztemi(jt)/zflxi(jt)
+            a_sali(jt) = a_sali(jt) + zsali(jt)/zflxi(jt)
+         ENDIF
+         !
+         IF( zflxo(jt) /= 0.e0 ) THEN
+            a_flxo(jt) = a_flxo(jt) + zflxo(jt)
+            a_temo(jt) = a_temo(jt) + ztemo(jt)/zflxo(jt)
+            a_salo(jt) = a_salo(jt) + zsalo(jt)/zflxo(jt)
+         ENDIF
+         !
+      END DO
+
+      IF( kt == nitend ) THEN
+         DO jt = 1, 4 
+            a_flxi(jt) = a_flxi(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 )
+            a_temi(jt) = a_temi(jt) /   FLOAT( nitend - nit000 + 1 )
+            a_sali(jt) = a_sali(jt) /   FLOAT( nitend - nit000 + 1 )
+            a_flxo(jt) = a_flxo(jt) / ( FLOAT( nitend - nit000 + 1 ) * 1.e6 )
+            a_temo(jt) = a_temo(jt) /   FLOAT( nitend - nit000 + 1 )
+            a_salo(jt) = a_salo(jt) /   FLOAT( nitend - nit000 + 1 )
+         END DO
+         IF( lk_mpp ) THEN
+            CALL mpp_sum( a_flxi, 4 )      ! sum over the global domain
+            CALL mpp_sum( a_temi, 4 )      ! sum over the global domain
+            CALL mpp_sum( a_sali, 4 )      ! sum over the global domain
+
+            CALL mpp_sum( a_flxo, 4 )      ! sum over the global domain
+            CALL mpp_sum( a_temo, 4 )      ! sum over the global domain
+            CALL mpp_sum( a_salo, 4 )      ! sum over the global domain
+         ENDIF
+      ENDIF
+
+
+      ! Ecriture des diagnostiques 
+      ! --------------------------
+
+      IF ( kt == nitend .AND. cp_cfg == "orca" .AND. lwp ) THEN
+
+         CALL ctl_opn( inum, 'STRAIT.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+         WRITE(inum,*)
+         WRITE(inum,*)    'Net freshwater budget '
+         WRITE(inum,9010) '  fwf    = ',a_fwf,   ' m3 =', a_fwf   /(FLOAT(nitend-nit000+1)*rdttra(1)) * 1.e-6,' Sv'
+         WRITE(inum,*)
+         WRITE(inum,9010) '  zarea =',zarea
+         WRITE(inum,9010) '  zvol  =',zvol
+         WRITE(inum,*)
+         WRITE(inum,*)    'Mean sea level : '
+         WRITE(inum,9010) '  at nit000 = ',a_sshb        ,' m3 '
+         WRITE(inum,9010) '  at nitend = ',a_sshn        ,' m3 '
+         WRITE(inum,9010) '  diff      = ',(a_sshn-a_sshb),' m3 =', (a_sshn-a_sshb)/(FLOAT(nitend-nit000+1)*rdt) * 1.e-6,' Sv'
+         WRITE(inum,9020) '  mean sea level elevation    =', a_sshn/zarea,' m'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Anomaly of salinity content : '
+         WRITE(inum,9010) '  at nit000 = ',a_salb        ,' psu.m3 '
+         WRITE(inum,9010) '  at nitend = ',a_saln        ,' psu.m3 '
+         WRITE(inum,9010) '  diff      = ',(a_saln-a_salb),' psu.m3'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Mean salinity : '
+         WRITE(inum,9020) '  at nit000 =',a_salb/zvol+zsm0   ,' psu '
+         WRITE(inum,9020) '  at nitend =',a_saln/zvol+zsm0   ,' psu '
+         WRITE(inum,9020) '  diff      =',(a_saln-a_salb)/zvol,' psu'
+         WRITE(inum,9020) '  S-SLevitus=',a_saln/zvol,' psu'
+         WRITE(inum,*)
+         WRITE(inum,*)    'Gibraltar : '
+         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(1)
+         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(1)
+         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(1)
+         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(1)
+         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(1)
+         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(1)
+         WRITE(inum,*)
+         WRITE(inum,*)    'Cadiz : '
+         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(2)
+         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(2)
+         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(2)
+         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(2)
+         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(2)
+         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(2)
+         WRITE(inum,*)
+         WRITE(inum,*)    'Bab el Mandeb : '
+         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(3)
+         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(3)
+         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(3)
+         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(3)
+         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(3)
+         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(3)
+         WRITE(inum,*)
+         WRITE(inum,*)    'Baltic : '
+         WRITE(inum,9030) '  Flux entrant (Sv) :', a_flxi(4)
+         WRITE(inum,9030) '  Flux sortant (Sv) :', a_flxo(4)
+         WRITE(inum,9030) '  T entrant (deg)   :', a_temi(4)
+         WRITE(inum,9030) '  T sortant (deg)   :', a_temo(4)
+         WRITE(inum,9030) '  S entrant (psu)   :', a_sali(4)
+         WRITE(inum,9030) '  S sortant (psu)   :', a_salo(4)
+         CLOSE(inum)
+      ENDIF
+
+      IF( nn_timing == 1 )   CALL timing_start('dia_fwb')
+
+ 9005 FORMAT(1X,A,ES24.16)
+ 9010 FORMAT(1X,A,ES12.5,A,F10.5,A)
+ 9020 FORMAT(1X,A,F10.5,A)
+ 9030 FORMAT(1X,A,F9.4,A)
+
+   END SUBROUTINE dia_fwb
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Dummy Module
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_diafwb = .FALSE.    !: fresh water budget flag
+CONTAINS
+   SUBROUTINE dia_fwb( kt )        ! Empty routine
+      WRITE(*,*) 'dia_fwb: : You should not have seen this print! error?', kt
+   END SUBROUTINE dia_fwb
+#endif
+
+   !!======================================================================
+END MODULE diafwb
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90	(revision 3437)
@@ -0,0 +1,608 @@
+MODULE diaharm 
+
+#if defined key_diaharm && defined key_tide
+   !!=================================================================================
+   !!                       ***  MODULE  diaharm  ***
+   !! Harmonic analysis of tidal constituents 
+   !!=================================================================================
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain
+   USE in_out_manager  ! I/O units
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE ioipsl          ! NetCDF IPSL library
+   USE diadimg         ! To write dimg
+   USE phycst
+   USE dynspg_oce
+   USE dynspg_ts
+   USE daymod
+   USE tide_mod
+   USE iom 
+   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
+
+   INTEGER ::                            & !! namelist variables
+                         nit000_han = 1, & ! First time step used for harmonic analysis
+                         nitend_han = 1, & ! Last time step used for harmonic analysis
+                         nstep_han  = 1, & ! Time step frequency for harmonic analysis
+                         nb_ana            ! Number of harmonics to analyse
+
+   INTEGER , ALLOCATABLE, DIMENSION(:)       :: name
+   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp
+   REAL(wp), ALLOCATABLE, DIMENSION(:)       :: ana_freq, vt, ut, 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',...)
+
+
+!! * Routine accessibility
+   PUBLIC  dia_harm    ! routine called by step.F90
+
+   !!---------------------------------------------------------------------------------
+   !!  
+   !!---------------------------------------------------------------------------------
+
+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
+      !!
+      !! History :
+      !!   9.0  O. Le Galloudec and J. Chanut (Original)
+      !!--------------------------------------------------------------------
+      !! * Local declarations 
+      INTEGER :: jh, nhan, jk, ji
+
+      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
+      !
+      CALL tide_init_Wave
+      !
+      tname(:)=''
+      !
+      ! Read Namelist nam_diaharm
+      REWIND ( numnam )
+      READ   ( numnam, 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) THEN
+        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nit000_han must be greater than nit000, stop'
+        IF(lwp) WRITE(numout,*) ' restart capability not implemented'
+        nstop = nstop + 1
+      ENDIF
+      IF (nitend < nitend_han) THEN
+        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nitend_han must be lower than nitend, stop'
+        IF(lwp) WRITE(numout,*) ' restart capability not implemented'
+        nstop = nstop + 1
+      ENDIF
+
+      IF (MOD(nitend_han-nit000_han+1,nstep_han).NE.0) THEN
+        IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : analysis time span must be a multiple of nstep_han, stop'
+        nstop = nstop + 1
+      END IF
+
+      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
+      ENDDO
+      !
+      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)) .eq. Wave(ji)%cname_tide) THEN
+             name(jk) = ji
+             EXIT
+          END IF
+       END DO
+      END DO
+
+      ! Initialize frequency array:
+      ! ---------------------------
+      ALLOCATE(ana_freq(nb_ana))
+      ALLOCATE(vt      (nb_ana))
+      ALLOCATE(ut      (nb_ana))
+      ALLOCATE(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,nb_ana*2,3))
+      ana_temp(:,:,:,:) = 0.e0
+
+   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]
+      !!
+      !! History :
+      !!   9.0  O. Le Galloudec and J. Chanut (Original)
+      !!--------------------------------------------------------------------
+      !! * Argument:
+      INTEGER, INTENT( IN ) :: kt
+
+      !! * Local declarations
+      INTEGER  :: ji, jj, jh, jc, nhc
+      REAL(wp) :: ztime, ztemp
+      !!--------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_harm')
+
+      IF ( kt .EQ. nit000 ) CALL dia_harm_init
+
+      IF ( ((kt.GE.nit000_han).AND.(kt.LE.nitend_han)).AND. &
+           (MOD(kt,nstep_han).EQ.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)*tmask(ji,jj,1)        
+#if defined key_dynspg_ts
+                ! ubar
+                ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2)                &
+                                        + ztemp*un_b(ji,jj)*hur(ji,jj)*umask(ji,jj,1)
+                ! vbar
+                ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3)                &
+                                        + ztemp*vn_b(ji,jj)*hvr(ji,jj)*vmask(ji,jj,1)
+#endif
+              END DO
+            END DO
+
+          END DO
+        END DO
+       
+      END IF
+
+      IF ( kt .EQ. 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 
+      !!
+      !! History :
+      !!   9.0  O. Le Galloudec and J. Chanut (Original)
+      !!--------------------------------------------------------------------
+
+      !! * Local declarations
+      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)
+               ENDDO
+            ENDDO
+
+            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))
+      ALLOCATE(out_u  (jpi,jpj,2*nb_ana))
+      ALLOCATE(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(ji,jj,1)
+               out_eta(ji,jj,nb_ana+jh)=X2 * tmask(ji,jj,1)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      ! 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)
+               ENDDO
+            ENDDO
+
+            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 * umask(ji,jj,1)
+               out_u (ji,jj,nb_ana+jh) = X2 * umask(ji,jj,1)
+            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)
+               ENDDO
+            ENDDO
+
+            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 * vmask(ji,jj,1)
+               out_v(ji,jj,nb_ana+jh)=X2 * vmask(ji,jj,1)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      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
+      !!
+      !!
+      !! History :
+      !!   9.0  O. Le Galloudec and J. Chanut (Original)
+      !!--------------------------------------------------------------------
+
+      !! * Local declarations
+      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 defined key_dimgout
+      cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc'
+      cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc'
+      cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc'
+#endif
+
+      IF(lwp) WRITE(numout,*) '  '
+      IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'
+#if defined key_dimgout
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~  Output files: ', TRIM(cdfile_name_T)
+      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_U)
+      IF(lwp) WRITE(numout,*) '                             ', TRIM(cdfile_name_V)
+#endif
+      IF(lwp) WRITE(numout,*) '  '
+
+      ! A) Elevation
+      !/////////////
+      !
+#if defined key_dimgout
+      cltext='Elevation amplitude and phase'
+      CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2')
+#else
+      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
+#endif
+
+      ! B) ubar
+      !/////////
+      !
+#if defined key_dimgout
+      cltext='ubar amplitude and phase'
+      CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2')
+#else
+      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
+#endif
+
+      ! C) vbar
+      !/////////
+      !
+#if defined key_dimgout
+      cltext='vbar amplitude and phase'
+      CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2')
+#else
+      DO jh = 1, nb_ana
+      CALL iom_put( TRIM(tname(jh))//'x_v', out_u(:,:,jh) )
+      CALL iom_put( TRIM(tname(jh))//'y_v', out_u(:,:,nb_ana+jh) )
+      END DO
+#endif
+
+   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 .GT. jpdimsparse ) &
+         CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse')
+
+      IF( ninco .GT. jpincomax ) &
+         CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax')
+
+      ztmp3(:,:)=0.e0
+
+      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
+
+         ENDDO
+      ENDDO
+
+      DO jj_sd = 1 ,ninco
+          ipos1(jj_sd) = jj_sd
+          ipos2(jj_sd) = jj_sd
+      ENDDO
+
+      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.GE.zval1 )THEN
+               ipivot(ji_sd) = jj_sd
+               zval1         = zval2
+            ENDIF
+         ENDDO
+
+         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)
+         ENDDO
+
+         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)
+         ENDDO
+
+         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)
+            ENDDO
+         ENDDO
+
+      ENDDO
+
+   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)
+      ENDDO
+   ENDDO
+
+   !system solving: 
+   ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco)
+   ji_sd = ninco
+   DO ji_sd = ninco-1, 1, -1
+      zx1=0.
+      DO jj_sd = ji_sd+1, ninco
+         zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd)
+      ENDDO
+      ztmpx(ji_sd) = ztmp4(ji_sd)-zx1
+   ENDDO
+
+   DO jj_sd =1, ninco
+      ztmp7(ipos1(jj_sd))=ztmpx(jj_sd)
+   ENDDO
+
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90	(revision 3437)
@@ -0,0 +1,269 @@
+MODULE diahsb
+   !!======================================================================
+   !!                       ***  MODULE  diahsb  ***
+   !! Ocean diagnostics: Heat, salt and volume budgets
+   !!======================================================================
+   !! History :  3.3  ! 2010-09  (M. Leclair)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE sbc_oce         ! surface thermohaline fluxes
+   USE in_out_manager  ! I/O manager
+   USE domvvl          ! vertical scale factors
+   USE traqsr          ! penetrative solar radiation
+   USE trabbc          ! bottom boundary condition 
+   USE lib_mpp         ! distributed memory computing library
+   USE trabbc          ! bottom boundary condition
+   USE obc_par         ! (for lk_obc)
+   USE bdy_par         ! (for lk_bdy)
+   USE timing          ! preformance summary
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dia_hsb        ! routine called by step.F90
+   PUBLIC   dia_hsb_init   ! routine called by opa.F90
+
+   LOGICAL, PUBLIC ::   ln_diahsb  = .FALSE.   !: check the heat and salt budgets
+
+   INTEGER                                 ::   numhsb                           !
+   REAL(dp)                                ::   surf_tot   , vol_tot             !
+   REAL(dp)                                ::   frc_t      , frc_s     , frc_v   ! global forcing trends
+   REAL(dp)                                ::   fact1                            ! conversion factors
+   REAL(dp)                                ::   fact21    , fact22               !     -         -
+   REAL(dp)                                ::   fact31    , fact32               !     -         -
+   REAL(dp), DIMENSION(:,:)  , ALLOCATABLE ::   surf      , ssh_ini              !
+   REAL(dp), DIMENSION(:,:,:), ALLOCATABLE ::   hc_loc_ini, sc_loc_ini, e3t_ini  !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_hsb( kt )
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hsb  ***
+      !!     
+      !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation
+      !!	
+      !! ** Method : - Compute the deviation of heat content, salt content and volume
+      !!	            at the current time step from their values at nit000
+      !!	            - Compute the contribution of forcing and remove it from these deviations
+      !!
+      !! ** Action : Write the results in the 'heat_salt_volume_budgets.txt' ASCII file
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER    ::   jk                          ! dummy loop indice
+      REAL(dp)   ::   zdiff_hc    , zdiff_sc      ! heat and salt content variations
+      REAL(dp)   ::   zdiff_v1    , zdiff_v2      ! volume variation
+      REAL(dp)   ::   z1_rau0                     ! local scalars
+      REAL(dp)   ::   zdeltat                     !    -     -
+      REAL(dp)   ::   z_frc_trd_t , z_frc_trd_s   !    -     -
+      REAL(dp)   ::   z_frc_trd_v                 !    -     -
+      !!---------------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_hsb')
+
+      ! ------------------------- !
+      ! 1 - Trends due to forcing !
+      ! ------------------------- !
+      z1_rau0 = 1.e0 / rau0
+      z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) )     ! volume fluxes
+      z_frc_trd_t =           SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) )     ! heat fluxes
+      z_frc_trd_s =           SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) )     ! salt fluxes
+      ! Add penetrative solar radiation
+      IF( ln_traqsr )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qsr     (:,:) * surf(:,:) )
+      ! Add geothermal heat flux
+      IF( ln_trabbc )   z_frc_trd_t = z_frc_trd_t + ro0cpr * SUM( qgh_trd0(:,:) * surf(:,:) )
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( z_frc_trd_v )
+         CALL mpp_sum( z_frc_trd_t )
+      ENDIF
+      frc_v = frc_v + z_frc_trd_v * rdt
+      frc_t = frc_t + z_frc_trd_t * rdt
+      frc_s = frc_s + z_frc_trd_s * rdt
+
+      ! ----------------------- !
+      ! 2 -  Content variations !
+      ! ----------------------- !
+      zdiff_v2 = 0.d0
+      zdiff_hc = 0.d0
+      zdiff_sc = 0.d0
+      ! volume variation (calculated with ssh)
+      zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) )
+      DO jk = 1, jpkm1
+         ! volume variation (calculated with scale factors)
+         zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk)   &
+            &                       * ( fse3t_n(:,:,jk)         &
+            &                           - e3t_ini(:,:,jk) ) )
+         ! heat content variation
+         zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk)          &
+            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   &
+            &                           - hc_loc_ini(:,:,jk) ) )
+         ! salt content variation
+         zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk)          &
+            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   &
+            &                           - sc_loc_ini(:,:,jk) ) )
+      ENDDO
+
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( zdiff_hc )
+         CALL mpp_sum( zdiff_sc )
+         CALL mpp_sum( zdiff_v1 )
+         CALL mpp_sum( zdiff_v2 )
+      ENDIF
+
+      ! Substract forcing from heat content, salt content and volume variations
+      zdiff_v1 = zdiff_v1 - frc_v
+      zdiff_v2 = zdiff_v2 - frc_v
+      zdiff_hc = zdiff_hc - frc_t
+      zdiff_sc = zdiff_sc - frc_s
+      
+      ! ----------------------- !
+      ! 3 - Diagnostics writing !
+      ! ----------------------- !
+      zdeltat  = 1.e0 / ( ( kt - nit000 + 1 ) * rdt )
+      WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1  * zdeltat,                                &
+         &                      zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat,   &
+         &                      zdiff_v1           , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat,   &
+         &                      zdiff_v2           , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat
+
+      IF ( kt == nitend ) CLOSE( numhsb )
+
+      IF( nn_timing == 1 )   CALL timing_stop('dia_hsb')
+
+9020  FORMAT(I5,11D15.7)
+      !
+   END SUBROUTINE dia_hsb
+
+
+   SUBROUTINE dia_hsb_init
+      !!---------------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_hsb  ***
+      !!     
+      !! ** Purpose: Initialization for the heat salt volume budgets
+      !!	
+      !! ** Method : Compute initial heat content, salt content and volume
+      !!
+      !! ** Action : - Compute initial heat content, salt content and volume
+      !!             - Initialize forcing trends
+      !!             - Compute coefficients for conversion
+      !!---------------------------------------------------------------------------
+      CHARACTER (len=32) ::   cl_name  ! output file name
+      INTEGER            ::   jk       ! dummy loop indice
+      INTEGER            ::   ierror   ! local integer
+      !!
+      NAMELIST/namhsb/ ln_diahsb
+      !!----------------------------------------------------------------------
+      !
+      REWIND ( numnam )              ! Read Namelist namhsb 
+      READ   ( numnam, namhsb )
+      !
+      IF(lwp) THEN                   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_hsb_init : check the heat and salt budgets'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namhsb : set hsb parameters'
+         WRITE(numout,*) '      Switch for hsb diagnostic (T) or not (F)  ln_diahsb  = ', ln_diahsb
+      ENDIF
+
+      IF( .NOT. ln_diahsb )   RETURN
+
+      ! ------------------- !
+      ! 1 - Allocate memory !
+      ! ------------------- !
+      ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' )   ;   RETURN
+      ENDIF
+      ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' )   ;   RETURN
+      ENDIF
+      ALLOCATE( e3t_ini(jpi,jpj,jpk)   , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' )      ;   RETURN
+      ENDIF
+      ALLOCATE( surf(jpi,jpj)          , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate surf' )         ;   RETURN
+      ENDIF
+      ALLOCATE( ssh_ini(jpi,jpj)       , STAT=ierror )
+      IF( ierror > 0 ) THEN
+         CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' )      ;   RETURN
+      ENDIF
+
+      ! ----------------------------------------------- !
+      ! 2 - Time independant variables and file opening !
+      ! ----------------------------------------------- !
+      WRITE(numout,*) "dia_hsb: heat salt volume budgets activated"
+      WRITE(numout,*) "~~~~~~~  output written in the 'heat_salt_volume_budgets.txt' ASCII file"
+      IF( lk_obc .or. lk_bdy ) THEN
+         CALL ctl_warn( 'dia_hsb does not take open boundary fluxes into account' )         
+      ENDIF
+      cl_name    = 'heat_salt_volume_budgets.txt'                         ! name of output file
+      surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:)      ! masked surface grid cell area
+      surf_tot  = SUM( surf(:,:) )                                       ! total ocean surface area
+      vol_tot   = 0.d0                                                   ! total ocean volume
+      DO jk = 1, jpkm1
+         vol_tot  = vol_tot + SUM( surf(:,:) * tmask(:,:,jk)     &
+            &                      * fse3t_n(:,:,jk)         )
+      END DO
+      IF( lk_mpp ) THEN 
+         CALL mpp_sum( vol_tot )
+         CALL mpp_sum( surf_tot )
+      ENDIF
+
+      CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 )
+      !                   12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80
+      WRITE( numhsb, 9010 ) "kt   |     heat content budget     |            salt content budget             ",   &
+         !                                                   123456789012345678901234567890123456789012345 -> 45
+         &                                                  "|            volume budget (ssh)             ",   &
+         !                                                   678901234567890123456789012345678901234567890 -> 45
+         &                                                  "|            volume budget (e3t)             "
+      WRITE( numhsb, 9010 ) "     |      [C]         [W/m2]     |     [psu]        [mmm/s]          [SV]     ",   &
+         &                                                  "|     [m3]         [mmm/s]          [SV]     ",   &
+         &                                                  "|     [m3]         [mmm/s]          [SV]     "
+
+      ! --------------- !
+      ! 3 - Conversions ! (factors will be multiplied by duration afterwards)
+      ! --------------- !
+
+      ! heat content variation   =>   equivalent heat flux:
+      fact1  = rau0 * rcp / surf_tot                                         ! [C*m3]   ->  [W/m2]
+      ! salt content variation   =>   equivalent EMP and equivalent "flow": 
+      fact21 = 1.e3  / ( soce * surf_tot )                                   ! [psu*m3] ->  [mm/s]
+      fact22 = 1.e-6 / soce                                                  ! [psu*m3] ->  [Sv]
+      ! volume variation         =>   equivalent EMP and equivalent "flow":
+      fact31 = 1.e3  / surf_tot                                              ! [m3]     ->  [mm/s]
+      fact32 = 1.e-6                                                         ! [m3]     ->  [SV]
+
+      ! ---------------------------------- !
+      ! 4 - initial conservation variables !
+      ! ---------------------------------- !
+      ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh
+      DO jk = 1, jpk
+         e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors
+         hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content
+         sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content
+      END DO
+      frc_v = 0.d0                                           ! volume       trend due to forcing
+      frc_t = 0.d0                                           ! heat content   -    -   -    -   
+      frc_s = 0.d0                                           ! salt content   -    -   -    -         
+      !
+9010  FORMAT(A80,A45,A45)
+      !
+   END SUBROUTINE dia_hsb_init
+
+   !!======================================================================
+END MODULE diahsb
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90	(revision 3437)
@@ -0,0 +1,353 @@
+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 
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!   NEMO     3.2  !  2009-07  (S. Masson) hc300 bugfix + cleaning + add new diag
+   !!----------------------------------------------------------------------
+#if   defined key_diahth   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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', 'lim_sbc_init : 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 = fsdepw(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 = fsdepw(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( "BLT"     , ztm2 - zpycn )   ! Barrier Layer Thickness
+      CALL iom_put( "tinv"    , ztinv        )   ! max. temp. inv. (t10 ref) 
+      CALL iom_put( "depti"   , zdepinv      )   ! depth of max. temp. inv. (t10 ref) 
+
+
+      ! ----------------------------------- !
+      ! 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 = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the oean bottom
+            !
+            iid = ik20(ji,jj)
+            IF( iid /= 1 ) THEN 
+               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    fsdept(ji,jj,iid+1) - fsdept(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 =      fsdept(ji,jj,iid  )   &                     ! linear interpolation
+                  &  + (    fsdept(ji,jj,iid+1) - fsdept(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_0 to do this search...)
+      ilevel   = 0
+      zthick_0 = 0._wp
+      DO jk = 1, jpkm1                      
+         zthick_0 = zthick_0 + e3t_0(jk)
+         IF( zthick_0 < 300. )   ilevel = jk
+      END DO
+      ! surface boundary condition
+      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                   
+      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,jk,jp_tem) * sshn(:,:) * tmask(:,:,jk)   
+      ENDIF
+      ! integration down to ilevel
+      DO jk = 1, ilevel
+         zthick(:,:) = zthick(:,:) + fse3t(:,:,jk)
+         htc3  (:,:) = htc3  (:,:) + fse3t(:,:,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( fse3t(ji,jj,ilevel+1), zthick(ji,jj) )  &
+                                                                   * tmask(ji,jj,ilevel+1)
+            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/dianam.F90	(revision 3437)
@@ -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( rdttra(1) )   ! 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 = rdttra(1) / rday * REAL( nitend - nit000, wp )                ! length of the run in days
+      zjul  = fjulday - rdttra(1) / 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90	(revision 3437)
@@ -0,0 +1,885 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dia_ptr      : Poleward Transport Diagnostics module
+   !!   dia_ptr_init : Initialization, namelist read
+   !!   dia_ptr_wri  : Output of poleward fluxes
+   !!   ptr_vjk      : "zonal" sum computation of a "meridional" flux array
+   !!   ptr_tjk      : "zonal" mean computation of a tracer field
+   !!   ptr_vj       : "zonal" and vertical sum computation of a "meridional" flux array
+   !!                   (Generic interface to ptr_vj_3d, ptr_vj_2d)
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and active tracers
+   USE dom_oce          ! ocean space and time domain
+   USE phycst           ! physical constants
+   USE ldftra_oce       ! ocean active tracers: lateral physics
+   USE dianam           !
+   USE iom              ! IOM library
+   USE ioipsl           ! IO-IPSL library
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE lbclnk           ! lateral boundary condition - processor exchanges
+   USE timing           ! preformance summary
+   USE wrk_nemo         ! working arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE ptr_vj
+      MODULE PROCEDURE ptr_vj_3d, ptr_vj_2d
+   END INTERFACE
+
+   PUBLIC   dia_ptr_init   ! call in opa module
+   PUBLIC   dia_ptr        ! call in step module
+   PUBLIC   ptr_vj         ! call by tra_ldf & tra_adv routines
+   PUBLIC   ptr_vjk        ! call by tra_ldf & tra_adv routines
+
+   !                                           !!** namelist  namptr  **
+   LOGICAL , PUBLIC ::   ln_diaptr  = .FALSE.   !: Poleward transport flag (T) or not (F)
+   LOGICAL , PUBLIC ::   ln_subbas  = .FALSE.   !: Atlantic/Pacific/Indian basins calculation
+   LOGICAL , PUBLIC ::   ln_diaznl  = .FALSE.   !: Add zonal means and meridional stream functions
+   LOGICAL , PUBLIC ::   ln_ptrcomp = .FALSE.   !: Add decomposition : overturning (and gyre, soon ...)
+   INTEGER , PUBLIC ::   nn_fptr    = 15        !: frequency of ptr computation  [time step]
+   INTEGER , PUBLIC ::   nn_fwri    = 15        !: frequency of ptr outputs      [time step]
+
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   htr_adv, htr_ldf, htr_ove   !: Heat TRansports (adv, diff, overturn.)
+   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) ::   str_adv, str_ldf, str_ove   !: Salt TRansports (adv, diff, overturn.)
+   
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   btmsk                  ! T-point basin interior masks
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   btm30                  ! mask out Southern Ocean (=0 south of 30°S)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr  , str             ! adv heat and salt transports (approx)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tn_jk, sn_jk , v_msf   ! i-mean T and S, j-Stream-Function
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sjk  , r1_sjk          ! i-mean i-k-surface and its inverse        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htr_eiv, str_eiv       ! bolus adv heat ans salt transports ('key_diaeiv')
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   v_msf_eiv              ! bolus j-streamfuction              ('key_diaeiv')
+
+
+   INTEGER ::   niter       !
+   INTEGER ::   nidom_ptr   !
+   INTEGER ::   numptr      ! logical unit for Poleward TRansports
+   INTEGER ::   nptr        ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T) 
+
+   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
+
+   REAL(wp), TARGET, DIMENSION(:),   ALLOCATABLE, SAVE :: p_fval1d
+   REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d
+
+   !! Integer, 1D workspace arrays. Not common enough to be implemented in 
+   !! wrk_nemo module.
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex  , ndex_atl     , ndex_pac     , ndex_ind     , ndex_ipc
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::         ndex_atl_30  , ndex_pac_30  , ndex_ind_30  , ndex_ipc_30
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   FUNCTION dia_ptr_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_ptr_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER               ::   dia_ptr_alloc   ! return value
+      INTEGER, DIMENSION(6) ::   ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( btmsk(jpi,jpj,nptr) ,           &
+         &      htr_adv(jpj) , str_adv(jpj) ,   &
+         &      htr_ldf(jpj) , str_ldf(jpj) ,   &
+         &      htr_ove(jpj) , str_ove(jpj),    &
+         &      htr(jpj,nptr) , str(jpj,nptr) , &
+         &      tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , &
+         &      sjk  (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1)  )
+         !
+#if defined key_diaeiv
+      ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , &
+         &      v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) )
+#endif
+      ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3))
+      !
+      ALLOCATE(ndex(jpj*jpk),        ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), &
+         &     ndex_ind(jpj*jpk),    ndex_ipc(jpj*jpk),                    &
+         &     ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4))
+
+      ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk),                   &
+         &     ndex_h(jpj),          ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), &
+         &     ndex_h_ind_30(jpj),   ndex_h_ipc_30(jpj), Stat=ierr(5) )
+         !
+     ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6)  )
+         !
+      dia_ptr_alloc = MAXVAL( ierr )
+      IF(lk_mpp)   CALL mpp_sum( dia_ptr_alloc )
+      !
+   END FUNCTION dia_ptr_alloc
+
+
+   FUNCTION ptr_vj_3d( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vj_3d  ***
+      !!
+      !! ** Purpose :   i-k sum computation of a j-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!              pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pva   ! mask flux array at V-point
+      !!
+      INTEGER                  ::   ji, jj, jk   ! dummy loop arguments
+      INTEGER                  ::   ijpj         ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval  ! function value
+      !!--------------------------------------------------------------------
+      !
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! Vector opt.
+               p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 
+            END DO
+         END DO
+      END DO
+#if defined key_mpp_mpi
+      IF(lk_mpp)   CALL mpp_sum( p_fval, ijpj, ncomm_znl)
+#endif
+      !
+   END FUNCTION ptr_vj_3d
+
+
+   FUNCTION ptr_vj_2d( pva )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vj_2d  ***
+      !!
+      !! ** Purpose :   "zonal" and vertical sum computation of a i-flux array
+      !!
+      !! ** Method  : - i-k sum of pva using the interior 2D vmask (vmask_i).
+      !!      pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)
+      !!
+      !! ** Action  : - p_fval: i-k-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      IMPLICIT none
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pva   ! mask flux array at V-point
+      !!
+      INTEGER                  ::   ji,jj       ! dummy loop arguments
+      INTEGER                  ::   ijpj        ! ???
+      REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value
+      !!--------------------------------------------------------------------
+      ! 
+      p_fval => p_fval1d
+
+      ijpj = jpj
+      p_fval(:) = 0._wp
+      DO jj = 2, jpjm1
+         DO ji = nldi, nlei   ! No vector optimisation here. Better use a mask ?
+            p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj)
+         END DO
+      END DO
+#if defined key_mpp_mpi
+      CALL mpp_sum( p_fval, ijpj, ncomm_znl )
+#endif
+      ! 
+   END FUNCTION ptr_vj_2d
+
+
+   FUNCTION ptr_vjk( pva, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_vjk  ***
+      !!
+      !! ** Purpose :   i-sum computation of a j-velocity array
+      !!
+      !! ** Method  : - i-sum of pva using the interior 2D vmask (vmask_i).
+      !!              pva is supposed to be a masked flux (i.e. * vmask)
+      !!
+      !! ** Action  : - p_fval: i-mean poleward flux of pva
+      !!----------------------------------------------------------------------
+      !!
+      IMPLICIT none
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk)           ::   pva    ! mask flux array at V-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)    , OPTIONAL ::   pmsk   ! Optional 2D basin mask
+      !!
+      INTEGER                           :: ji, jj, jk ! dummy loop arguments
+      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval     ! return function value
+#if defined key_mpp_mpi
+      INTEGER, DIMENSION(1) ::   ish
+      INTEGER, DIMENSION(2) ::   ish2
+      INTEGER               ::   ijpjjpk
+#endif
+#if defined key_mpp_mpi
+      REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point
+#endif
+      !!--------------------------------------------------------------------
+      !
+#if defined key_mpp_mpi
+      ijpjjpk = jpj*jpk
+      CALL wrk_alloc( jpj*jpk, zwork )
+#endif
+
+      p_fval => p_fval2d
+
+      p_fval(:,:) = 0._wp
+      !
+      IF( PRESENT( pmsk ) ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+!!gm here, use of tmask_i  ==> no need of loop over nldi, nlei....
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj)
+               END DO
+            END DO
+         END DO
+      ELSE 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+                  p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+      END IF
+      !
+#if defined key_mpp_mpi
+      ish(1) = ijpjjpk  ;   ish2(1) = jpj   ;   ish2(2) = jpk
+      zwork(1:ijpjjpk) = RESHAPE( p_fval, ish )
+      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
+      p_fval(:,:) = RESHAPE( zwork, ish2 )
+#endif
+      !
+#if defined key_mpp_mpi
+      CALL wrk_dealloc( jpj*jpk, zwork )
+#endif
+      !
+   END FUNCTION ptr_vjk
+
+
+   FUNCTION ptr_tjk( pta, pmsk )   RESULT ( p_fval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ptr_tjk  ***
+      !!
+      !! ** Purpose :   i-sum computation of e1t*e3t * a tracer field
+      !!
+      !! ** Method  : - i-sum of mj(pta) using tmask
+      !!
+      !! ** Action  : - p_fval: i-sum of e1t*e3t*pta
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) ::   pta    ! tracer flux array at T-point
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj)     ::   pmsk   ! Optional 2D basin mask
+      !!
+      INTEGER                           :: ji, jj, jk   ! dummy loop arguments
+      REAL(wp), POINTER, DIMENSION(:,:) :: p_fval       ! return function value
+#if defined key_mpp_mpi
+      INTEGER, DIMENSION(1) ::   ish
+      INTEGER, DIMENSION(2) ::   ish2
+      INTEGER               ::   ijpjjpk
+#endif
+#if defined key_mpp_mpi
+      REAL(wp), POINTER, DIMENSION(:) ::   zwork    ! mask flux array at V-point
+#endif
+      !!-------------------------------------------------------------------- 
+      !
+#if defined key_mpp_mpi
+      ijpjjpk = jpj*jpk
+      CALL wrk_alloc( jpj*jpk, zwork )
+#endif
+
+      p_fval => p_fval2d
+
+      p_fval(:,:) = 0._wp
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji =  nldi, nlei   ! No vector optimisation here. Better use a mask ?
+               p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj)
+            END DO
+         END DO
+      END DO
+#if defined key_mpp_mpi
+      ish(1) = jpj*jpk   ;   ish2(1) = jpj   ;   ish2(2) = jpk
+      zwork(1:ijpjjpk)= RESHAPE( p_fval, ish )
+      CALL mpp_sum( zwork, ijpjjpk, ncomm_znl )
+      p_fval(:,:)= RESHAPE( zwork, ish2 )
+#endif
+      !
+#if defined key_mpp_mpi
+      CALL wrk_dealloc( jpj*jpk, zwork )
+#endif
+      !    
+   END FUNCTION ptr_tjk
+
+
+   SUBROUTINE dia_ptr( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr  ***
+      !!----------------------------------------------------------------------
+      USE oce,     vt  =>   ua   ! use ua as workspace
+      USE oce,     vs  =>   va   ! use va as workspace
+      IMPLICIT none
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time step index
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zv               ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('dia_ptr')
+      !
+      IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 )   THEN
+         !
+         IF( MOD( kt, nn_fptr ) == 0 ) THEN 
+            !
+            IF( ln_diaznl ) THEN               ! i-mean temperature and salinity
+               DO jn = 1, nptr
+                  tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn)
+               END DO
+            ENDIF
+            !
+            !                          ! horizontal integral and vertical dz 
+            !                                ! eulerian velocity
+            v_msf(:,:,1) = ptr_vjk( vn(:,:,:) ) 
+            DO jn = 2, nptr
+               v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 
+            END DO
+#if defined key_diaeiv
+            DO jn = 1, nptr                  ! bolus velocity
+               v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) )   ! here no btm30 for MSFeiv
+            END DO
+            !                                ! add bolus stream-function to the eulerian one
+            v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:)
+#endif
+            !
+            !                          ! Transports
+            !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] )
+            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp
+            DO jk= 1, jpkm1
+               DO jj = 2, jpj
+                  DO ji = 1, jpi
+#if defined key_diaeiv 
+                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp
+#else
+                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp
+#endif 
+                     vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem)
+                     vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal)
+                  END DO
+               END DO
+            END DO
+!!gm useless as overlap areas are not used in ptr_vjk
+            CALL lbc_lnk( vs, 'V', -1. )   ;   CALL lbc_lnk( vt, 'V', -1. )
+!!gm
+            !                                ! heat & salt advective transports (approximation)
+            htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt   ! SUM over jk + conversion
+            str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram
+            DO jn = 2, nptr 
+               htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt   ! mask Southern Ocean
+               str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram   ! mask Southern Ocean
+            END DO
+
+            IF( ln_ptrcomp ) THEN            ! overturning transport
+               htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt   ! SUM over jk + conversion
+               str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram
+            END IF
+            !                                ! Advective and diffusive transport
+            htr_adv(:) = htr_adv(:) * rc_pwatt        ! these are computed in tra_adv... and tra_ldf... routines 
+            htr_ldf(:) = htr_ldf(:) * rc_pwatt        ! here just the conversion in PW and Gg
+            str_adv(:) = str_adv(:) * rc_ggram
+            str_ldf(:) = str_ldf(:) * rc_ggram
+
+#if defined key_diaeiv
+            DO jn = 1, nptr                  ! Bolus component
+               htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt   ! SUM over jk
+               str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram   ! SUM over jk
+            END DO
+#endif
+            !                                ! "Meridional" Stream-Function
+            DO jn = 1, nptr
+               DO jk = 2, jpk 
+                  v_msf    (:,jk,jn) = v_msf    (:,jk-1,jn) + v_msf    (:,jk,jn)       ! Eulerian j-Stream-Function
+#if defined key_diaeiv
+                  v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn)       ! Bolus    j-Stream-Function
+
+#endif
+               END DO
+            END DO
+            v_msf    (:,:,:) = v_msf    (:,:,:) * rc_sv       ! converte in Sverdrups
+#if defined key_diaeiv
+            v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv
+#endif
+         ENDIF
+         !
+         CALL dia_ptr_wri( kt )                        ! outputs
+         !
+      ENDIF
+      !
+#if defined key_mpp_mpi
+      IF( kt == nitend .AND. l_znl_root )   CALL histclo( numptr )      ! Close the file
+#else
+      IF( kt == nitend )                    CALL histclo( numptr )      ! Close the file
+#endif
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr')
+      !
+   END SUBROUTINE dia_ptr
+
+
+   SUBROUTINE dia_ptr_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dia_ptr_init  ***
+      !!                   
+      !! ** Purpose :   Initialization, namelist read
+      !!----------------------------------------------------------------------
+      INTEGER ::   jn           ! dummy loop indices 
+      INTEGER ::   inum, ierr   ! local integers
+#if defined key_mpp_mpi
+      INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+#endif
+      !!
+      NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri
+      !!----------------------------------------------------------------------
+      IF( nn_timing == 1 )   CALL timing_start('dia_ptr_init')
+
+      REWIND( numnam )                 ! Read Namelist namptr : poleward transport parameters
+      READ  ( numnam, namptr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namptr : set ptr parameters'
+         WRITE(numout,*) '      Poleward heat & salt transport (T) or not (F)      ln_diaptr  = ', ln_diaptr
+         WRITE(numout,*) '      Overturning heat & salt transport                  ln_ptrcomp = ', ln_ptrcomp
+         WRITE(numout,*) '      T & S zonal mean and meridional stream function    ln_diaznl  = ', ln_diaznl 
+         WRITE(numout,*) '      Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins      ln_subbas  = ', ln_subbas
+         WRITE(numout,*) '      Frequency of computation                           nn_fptr    = ', nn_fptr
+         WRITE(numout,*) '      Frequency of outputs                               nn_fwri    = ', nn_fwri
+      ENDIF
+      
+      IF( ln_diaptr) THEN  
+      
+         IF( ln_subbas ) THEN   ;   nptr = 5       ! Global, Atlantic, Pacific, Indian, Indo-Pacific
+         ELSE                   ;   nptr = 1       ! Global only
+         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 )
+            CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin
+            CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin
+            CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin
+            CALL iom_close( inum )
+            btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin
+            WHERE( gphit(:,:) < -30._wp)   ;   btm30(:,:) = 0._wp      ! mask out Southern Ocean
+            ELSE WHERE                     ;   btm30(:,:) = tmask(:,:,1)
+            END WHERE
+         ENDIF
+         btmsk(:,:,1) = tmask_i(:,:)                                   ! global ocean
+      
+         DO jn = 1, nptr
+            btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:)               ! interior domain only
+         END DO
+      
+         IF( lk_vvl )   CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' )
+
+         !                                   ! i-sum of e1v*e3v surface and its inverse
+         DO jn = 1, nptr
+            sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) )
+            r1_sjk(:,:,jn) = 0._wp
+            WHERE( sjk(:,:,jn) /= 0._wp )   r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn)
+         END DO
+
+      ! Initialise arrays to zero because diatpr is called before they are first calculated
+      ! Note that this means diagnostics will not be exactly correct when model run is restarted.
+      htr_adv(:) = 0._wp ; str_adv(:) =  0._wp ;  htr_ldf(:) = 0._wp ; str_ldf(:) =  0._wp
+
+#if defined key_mpp_mpi 
+         iglo (1) = jpjglo                   ! MPP case using MPI  ('key_mpp_mpi')
+         iloc (1) = nlcj
+         iabsf(1) = njmppt(narea)
+         iabsl(:) = iabsf(:) + iloc(:) - 1
+         ihals(1) = nldj - 1
+         ihale(1) = nlcj - nlej
+         idid (1) = 2
+         CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr )
+#else
+         nidom_ptr = FLIO_DOM_NONE
+#endif
+      ENDIF 
+      ! 
+      IF( nn_timing == 1 )   CALL timing_stop('dia_ptr_init')
+      ! 
+   END SUBROUTINE dia_ptr_init
+
+
+   SUBROUTINE dia_ptr_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE dia_ptr_wri  ***
+      !!
+      !! ** Purpose :   output of poleward fluxes
+      !!
+      !! ** Method  :   NetCDF file
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER, SAVE ::   nhoridz, ndepidzt, ndepidzw
+      INTEGER, SAVE ::   ndim  , ndim_atl     , ndim_pac     , ndim_ind     , ndim_ipc
+      INTEGER, SAVE ::           ndim_atl_30  , ndim_pac_30  , ndim_ind_30  , ndim_ipc_30
+      INTEGER, SAVE ::   ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30
+      !!
+      CHARACTER (len=40) ::   clhstnam, clop, clop_once, cl_comment   ! temporary names
+      INTEGER            ::   iline, it, itmod, ji, jj, jk            !
+#if defined key_iomput
+      INTEGER            ::   inum                                    ! temporary logical unit
+#endif
+      REAL(wp)           ::   zsto, zout, zdt, zjulian                ! temporary scalars
+      !!
+      REAL(wp), POINTER, DIMENSION(:)   ::   zphi, zfoo    ! 1D workspace
+      REAL(wp), POINTER, DIMENSION(:,:) ::   z_1           ! 2D workspace
+      !!-------------------------------------------------------------------- 
+      !
+      CALL wrk_alloc( jpi      , zphi , zfoo )
+      CALL wrk_alloc( jpi , jpk, z_1 )
+
+      ! define time axis
+      it    = kt / nn_fptr
+      itmod = kt - nit000 + 1
+      
+      ! Initialization
+      ! --------------
+      IF( kt == nit000 ) THEN
+         niter = ( nit000 - 1 ) / nn_fptr
+         zdt = rdt
+         IF( nacc == 1 )   zdt = rdtmin
+         !
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+
+         ! Reference latitude (used in plots)
+         ! ------------------
+         !                                           ! =======================
+         IF( cp_cfg == "orca" ) THEN                 !   ORCA configurations
+            !                                        ! =======================
+            IF( jp_cfg == 05  )   iline = 192   ! i-line that passes near the North Pole
+            IF( jp_cfg == 025 )   iline = 384   ! i-line that passes near the North Pole
+            IF( jp_cfg == 1   )   iline =  96   ! i-line that passes near the North Pole
+            IF( jp_cfg == 2   )   iline =  48   ! i-line that passes near the North Pole
+            IF( jp_cfg == 4   )   iline =  24   ! i-line that passes near the North Pole
+            zphi(1:jpj) = 0._wp
+            DO ji = mi0(iline), mi1(iline) 
+               zphi(1:jpj) = gphiv(ji,:)         ! if iline is in the local domain
+               ! Correct highest latitude for some configurations - will work if domain is parallelized in J ?
+               IF( jp_cfg == 05 ) THEN
+                  DO jj = mj0(jpjdta), mj1(jpjdta) 
+                     zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp
+                     zphi( jj ) = MIN( zphi(jj), 90._wp )
+                  END DO
+               END IF
+               IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN
+                  DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 
+                     zphi( jj ) = 88.5_wp
+                  END DO
+                  DO jj = mj0(jpjdta  ), mj1(jpjdta  ) 
+                     zphi( jj ) = 89.5_wp
+                  END DO
+               END IF
+            END DO
+            ! provide the correct zphi to all local domains
+#if defined key_mpp_mpi
+            CALL mpp_sum( zphi, jpj, ncomm_znl )        
+#endif
+            !                                        ! =======================
+         ELSE                                        !   OTHER configurations 
+            !                                        ! =======================
+            zphi(1:jpj) = gphiv(1,:)             ! assume lat/lon coordinate, select the first i-line
+            !
+         ENDIF
+         !
+         ! Work only on westmost processor (will not work if mppini2 is used)
+#if defined key_mpp_mpi
+         IF( l_znl_root ) THEN 
+#endif
+            !
+            ! OPEN netcdf file 
+            ! ----------------
+            ! Define frequency of output and means
+            zsto = nn_fptr * zdt
+            IF( ln_mskland )   THEN    ! put 1.e+20 on land (very expensive!!)
+               clop      = "ave(only(x))"
+               clop_once = "once(only(x))"
+            ELSE                       ! no use of the mask value (require less cpu time)
+               clop      = "ave(x)"       
+               clop_once = "once"
+            ENDIF
+
+            zout = nn_fwri * zdt
+            zfoo(1:jpj) = 0._wp
+
+            CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )  ! Compute julian date from starting date of the run
+            zjulian = zjulian - adatrj                         ! set calendar origin to the beginning of the experiment
+
+#if defined key_iomput
+            ! Requested by IPSL people, use by their postpro...
+            IF(lwp) THEN
+               CALL dia_nam( clhstnam, nn_fwri,' ' )
+               CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+               WRITE(inum,*) clhstnam
+               CLOSE(inum)
+            ENDIF
+#endif
+
+            CALL dia_nam( clhstnam, nn_fwri, 'diaptr' )
+            IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam
+
+            ! Horizontal grid : zphi()
+            CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   &
+               1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr)
+            ! Vertical grids : gdept_0, gdepw_0
+            CALL histvert( numptr, "deptht", "Vertical T levels",   &
+               &                   "m", jpk, gdept_0, ndepidzt, "down" )
+            CALL histvert( numptr, "depthw", "Vertical W levels",   &
+               &                   "m", jpk, gdepw_0, ndepidzw, "down" )
+            !
+            CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex  , ndim  )      ! Lat-Depth
+            CALL wheneq ( jpj    , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h )     ! Lat
+
+            IF( ln_subbas ) THEN
+               z_1(:,1) = 1._wp
+               WHERE ( gphit(jpi/2,:) < -30._wp )   z_1(:,1) = 0._wp
+               DO jk = 2, jpk
+                  z_1(:,jk) = z_1(:,1)
+               END DO
+               !                       ! Atlantic (jn=2)
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)         , 1._wp), 1, 1., ndex_atl     , ndim_atl      ) ! Lat-Depth
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30  , ndim_atl_30   ) ! Lat-Depth
+               CALL wheneq ( jpj    , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat
+               !                       ! Pacific (jn=3)
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)         , 1._wp), 1, 1., ndex_pac     , ndim_pac      ) ! Lat-Depth
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30  , ndim_pac_30   ) ! Lat-Depth
+               CALL wheneq ( jpj    , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat
+               !                       ! Indian (jn=4)
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)         , 1._wp), 1, 1., ndex_ind     , ndim_ind      ) ! Lat-Depth
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30  , ndim_ind_30   ) ! Lat-Depth
+               CALL wheneq ( jpj    , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat
+               !                       ! Indo-Pacific (jn=5)
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)         , 1._wp), 1, 1., ndex_ipc     , ndim_ipc      ) ! Lat-Depth
+               CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30  , ndim_ipc_30   ) ! Lat-Depth
+               CALL wheneq ( jpj    , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat
+            ENDIF
+            ! 
+#if defined key_diaeiv
+            cl_comment = ' (Bolus part included)'
+#else
+            cl_comment = '                      '
+#endif
+            IF( ln_diaznl ) THEN             !  Zonal mean T and S
+               CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+               CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU"  ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+
+               CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2"   ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
+               !
+               IF (ln_subbas) THEN 
+                  CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU"  ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2"   ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
+
+                  CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C"  ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU"   ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2"    ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
+
+                  CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C"   ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU"    ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2"     ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
+
+                  CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU"  ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout )
+                  CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2"   ,   &
+                     1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout )
+               ENDIF
+            ENDIF
+            !
+            !  Meridional Stream-Function (Eulerian and Bolus)
+            CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" ,   &
+               1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+            IF( ln_subbas .AND. ln_diaznl ) THEN
+               CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+               CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv"  ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+               CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv"   ,   &
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+               CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,&
+                  1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+            ENDIF
+            !
+            !  Heat transport 
+            CALL histdef( numptr, "sophtadv", "Advective Heat Transport"      ,   &
+               "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport"      ,   &
+               "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            IF ( ln_ptrcomp ) THEN 
+               CALL histdef( numptr, "sophtove", "Overturning Heat Transport"    ,   &
+                  "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            END IF
+            IF( ln_subbas ) THEN
+               CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment),  &
+                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) ,  &
+                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment)  ,  &
+                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), &
+                  "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            ENDIF
+            !
+            !  Salt transport 
+            CALL histdef( numptr, "sopstadv", "Advective Salt Transport"      ,   &
+               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport"      ,   &
+               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            IF ( ln_ptrcomp ) THEN 
+               CALL histdef( numptr, "sopstove", "Overturning Salt Transport"    ,   &
+                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            END IF
+#if defined key_diaeiv
+            ! Eddy induced velocity
+            CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global",   &
+               "Sv"      , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout )
+            CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport",   &
+               "PW"      , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport",   &
+               "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+#endif
+            IF( ln_subbas ) THEN
+               CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment)      ,  &
+                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment)      ,   &
+                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment)      ,    &
+                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+               CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment),  &
+                  "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout )
+            ENDIF
+            !
+            CALL histend( numptr )
+            !
+         END IF
+#if defined key_mpp_mpi
+      END IF
+#endif
+
+#if defined key_mpp_mpi
+      IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN
+#else
+      IF( MOD( itmod, nn_fptr ) == 0  ) THEN
+#endif
+         niter = niter + 1
+
+         IF( ln_diaznl ) THEN 
+            CALL histwrite( numptr, "zosrfglo", niter, sjk  (:,:,1) , ndim, ndex )
+            CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1)  , ndim, ndex )
+            CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1)  , ndim, ndex )
+
+            IF (ln_subbas) THEN 
+               CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl )
+               CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac )
+               CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind )
+               CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc )
+
+               CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2)  , ndim_atl, ndex_atl )
+               CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2)  , ndim_atl, ndex_atl )
+               CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3)  , ndim_pac, ndex_pac )
+               CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3)  , ndim_pac, ndex_pac )
+               CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4)  , ndim_ind, ndex_ind )
+               CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4)  , ndim_ind, ndex_ind )
+               CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5)  , ndim_ipc, ndex_ipc )
+               CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5)  , ndim_ipc, ndex_ipc )
+            END IF
+         ENDIF
+
+         ! overturning outputs:
+         CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex )
+         IF( ln_subbas .AND. ln_diaznl ) THEN
+            CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 )
+            CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 )
+            CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 )
+            CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 )
+         ENDIF
+#if defined key_diaeiv
+         CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim  , ndex   )
+#endif
+
+         ! heat transport outputs:
+         IF( ln_subbas ) THEN
+            CALL histwrite( numptr, "sohtatl", niter, htr(:,2)  , ndim_h_atl_30, ndex_h_atl_30 )
+            CALL histwrite( numptr, "sohtpac", niter, htr(:,3)  , ndim_h_pac_30, ndex_h_pac_30 )
+            CALL histwrite( numptr, "sohtind", niter, htr(:,4)  , ndim_h_ind_30, ndex_h_ind_30 )
+            CALL histwrite( numptr, "sohtipc", niter, htr(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 )
+            CALL histwrite( numptr, "sostatl", niter, str(:,2)  , ndim_h_atl_30, ndex_h_atl_30 )
+            CALL histwrite( numptr, "sostpac", niter, str(:,3)  , ndim_h_pac_30, ndex_h_pac_30 )
+            CALL histwrite( numptr, "sostind", niter, str(:,4)  , ndim_h_ind_30, ndex_h_ind_30 )
+            CALL histwrite( numptr, "sostipc", niter, str(:,5)  , ndim_h_ipc_30, ndex_h_ipc_30 )
+         ENDIF
+
+         CALL histwrite( numptr, "sophtadv", niter, htr_adv     , ndim_h, ndex_h )
+         CALL histwrite( numptr, "sophtldf", niter, htr_ldf     , ndim_h, ndex_h )
+         CALL histwrite( numptr, "sopstadv", niter, str_adv     , ndim_h, ndex_h )
+         CALL histwrite( numptr, "sopstldf", niter, str_ldf     , ndim_h, ndex_h )
+         IF( ln_ptrcomp ) THEN 
+            CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h )
+            CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h )
+         ENDIF
+#if defined key_diaeiv
+         CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1)  , ndim_h, ndex_h )
+         CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1)  , ndim_h, ndex_h )
+#endif
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi      , zphi , zfoo )
+      CALL wrk_dealloc( jpi , jpk, z_1 )
+      !
+  END SUBROUTINE dia_ptr_wri
+
+   !!======================================================================
+END MODULE diaptr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90	(revision 3437)
@@ -0,0 +1,800 @@
+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 ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv
+   USE sol_oce         ! solver variables
+   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 diadimg         ! dimg direct access file format output
+   USE diaar5, ONLY :   lk_diaar5
+   USE iom
+   USE ioipsl
+#if defined key_lim2
+   USE limwri_2 
+#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 ::   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
+
+   !! * Substitutions
+#  include "zdfddm_substitute.h90"
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   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
+
+#if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                                      DIMG output file
+   !!----------------------------------------------------------------------
+#   include "diawri_dimg.h90"
+
+#else
+   !!----------------------------------------------------------------------
+   !!   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
+      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
+
+      CALL iom_put( "toce"   , tsn(:,:,:,jp_tem)                     )    ! temperature
+      CALL iom_put( "soce"   , tsn(:,:,:,jp_sal)                     )    ! salinity
+      CALL iom_put( "sst"    , tsn(:,:,1,jp_tem)                     )    ! sea surface temperature
+      CALL iom_put( "sst2"   , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) )    ! square of sea surface temperature
+      CALL iom_put( "sss"    , tsn(:,:,1,jp_sal)                     )    ! sea surface salinity
+      CALL iom_put( "sss2"   , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) )    ! square of sea surface salinity
+      CALL iom_put( "uoce"   , un                                    )    ! i-current      
+      CALL iom_put( "voce"   , vn                                    )    ! j-current
+      
+      CALL iom_put( "avt"    , avt                                   )    ! T vert. eddy diff. coef.
+      CALL iom_put( "avm"    , avmu                                  )    ! T vert. eddy visc. coef.
+      IF( lk_zdfddm ) THEN
+         CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef.
+      ENDIF
+
+      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 ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  )
+            zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / 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
+!CDIR NOVERRCHK
+      z2d(:,:) = SQRT( z2d(:,:) )
+      CALL iom_put( "sstgrad" ,  z2d               )    ! module of sst gradient
+
+      IF( lk_diaar5 ) THEN
+         z3d(:,:,jpk) = 0.e0
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk)
+         END DO
+         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction
+         zztmp = 0.5 * rcp
+         z2d(:,:) = 0.e0 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( 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", z2d )                  ! heat transport in i-direction
+         DO jk = 1, jpkm1
+            z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk)
+         END DO
+         CALL iom_put( "v_masstr", z3d )                  ! mass transport in j-direction
+         z2d(:,:) = 0.e0 
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( 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", z2d )                  !  heat transport in i-direction
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi , jpj      , z2d )
+      CALL wrk_dealloc( jpi , jpj, jpk , z3d )
+      !
+      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
+      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt           ! 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 ( ln_traldf_gdia )  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
+      zdt = rdt
+      IF( nacc == 1 ) zdt = rdtmin
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#if defined key_diainstant
+      zsto = nwrite * zdt
+      clop = "inst("//TRIM(clop)//")"
+#else
+      zsto=zdt
+      clop = "ave("//TRIM(clop)//")"
+#endif
+      zout = nwrite * zdt
+      zmax = ( nitend - nit000 + 1 ) * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      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, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_0, nz_T, "down" )
+         !                                                            ! 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
+
+         ! 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, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept
+            &           "m", ipk, gdept_0, nz_U, "down" )
+         !                                                            ! 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, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept
+            &          "m", ipk, gdept_0, nz_V, "down" )
+         !                                                            ! 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, zdt, nh_W, nid_W, domain_id=nidom, snc4chunks=snc4set )
+         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw
+            &          "m", ipk, gdepw_0, nz_W, "down" )
+
+
+         ! 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 )
+         !                                                                                      !!! 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 )
+!!$#if defined key_lim3 || defined key_lim2 
+!!$         ! sowaflup = sowaflep + sorunoff + sowafldp + a term associated to
+!!$         !    internal damping to Levitus that can be diagnosed from others
+!!$         ! sowaflcd = sowaflep + sorunoff + sowafldp + iowaflup
+!!$         CALL histdef( nid_T, "iowaflup", "Ice=>ocean net freshwater"          , "kg/m2/s",   &  ! fsalt
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$         CALL histdef( nid_T, "sowaflep", "atmos=>ocean net freshwater"        , "kg/m2/s",   &  ! fmass
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$#endif
+         CALL histdef( nid_T, "sowaflup", "Net Upward Water Flux"              , "Kg/m2/s",   &  ! (emp-rnf)
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+!!$         CALL histdef( nid_T, "sorunoff", "Runoffs"                            , "Kg/m2/s",   &  ! runoffs
+!!$            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sowaflcd", "concentration/dilution water flux"  , "kg/m2/s",   &  ! (emps-rnf)
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sosalflx", "Surface Salt Flux"                  , "Kg/m2/s",   &  ! (emps-rnf) * sn
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+         CALL histdef( nid_T, "sohefldo", "Net Downward Heat Flux"             , "W/m2"   ,   &  ! qns + qsr
+            &          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 ! defined key_coupled 
+         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 ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 
+         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"                 , "W"      ,   & ! htc3
+            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+#endif
+
+#if defined key_coupled 
+# if defined key_lim3
+         Must be adapted to LIM3
+# else
+         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 
+#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_traldf_gdia ) THEN
+            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
+                 &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+         ELSE
+#if defined key_diaeiv
+            CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current"                  , "m/s"    ,   &  ! u_eiv
+            &          jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )
+#endif
+         END IF
+         !                                                                                      !!! 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_traldf_gdia ) THEN
+            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
+                 &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+         ELSE 
+#if defined key_diaeiv
+            CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current"             , "m/s"    ,   &  ! v_eiv
+            &          jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )
+#endif
+         END IF
+         !                                                                                      !!! 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 )
+         IF( ln_traldf_gdia ) THEN
+            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
+                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+         ELSE
+#if defined key_diaeiv
+            CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity"              , "m/s"    ,   &  ! w_eiv
+                 &          jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )
+#endif
+         END IF
+         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
+         !                                                                                      !!! nid_W : 2D
+#if defined key_traldf_c2d
+         CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity"           , "m2/s"   ,   &  ! ahtw
+            &          jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+# if defined key_traldf_eiv 
+            CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s",   &  ! aeiw
+               &       jpi, jpj, nh_W, 1  , 1, 1  , - 99, 32, clop, zsto, zout )
+# endif
+#endif
+
+         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 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, "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
+      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height
+!!$#if  defined key_lim3 || defined key_lim2 
+!!$      CALL histwrite( nid_T, "iowaflup", it, fsalt(:,:)    , ndim_hT, ndex_hT )   ! ice=>ocean water flux
+!!$      CALL histwrite( nid_T, "sowaflep", it, fmass(:,:)    , ndim_hT, ndex_hT )   ! atmos=>ocean water flux
+!!$#endif
+      CALL histwrite( nid_T, "sowaflup", it, ( emp-rnf )   , ndim_hT, ndex_hT )   ! upward water flux
+!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff
+      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux
+      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1)
+      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux
+      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux
+      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 ! defined key_coupled
+      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 ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 
+      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 defined key_coupled 
+# if defined key_lim3
+      Must be adapted for LIM3
+      CALL histwrite( nid_T, "soicetem", it, tn_ice        , ndim_hT, ndex_hT )   ! surf. ice temperature
+      CALL histwrite( nid_T, "soicealb", it, alb_ice       , ndim_hT, ndex_hT )   ! ice albedo
+# else
+      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
+#endif
+         ! Write fields on U grid
+      CALL histwrite( nid_U, "vozocrtx", it, un            , ndim_U , ndex_U )    ! i-current
+      IF( ln_traldf_gdia ) THEN
+         IF (.not. ALLOCATED(psix_eiv))THEN
+            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
+            IF( lk_mpp   )   CALL mpp_sum ( ierr )
+            IF( ierr > 0 )   CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')
+            psix_eiv(:,:,:) = 0.0_wp
+            psiy_eiv(:,:,:) = 0.0_wp
+         ENDIF
+         DO jk=1,jpkm1
+            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U )           ! i-eiv current
+      ELSE
+#if defined key_diaeiv
+         CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U )          ! i-eiv current
+#endif
+      ENDIF
+      CALL histwrite( nid_U, "sozotaux", it, utau          , ndim_hU, ndex_hU )   ! i-wind stress
+
+         ! Write fields on V grid
+      CALL histwrite( nid_V, "vomecrty", it, vn            , ndim_V , ndex_V  )   ! j-current
+      IF( ln_traldf_gdia ) THEN
+         DO jk=1,jpk-1
+            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V )           ! j-eiv current
+      ELSE
+#if defined key_diaeiv
+         CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V )          ! j-eiv current
+#endif
+      ENDIF
+      CALL histwrite( nid_V, "sometauy", it, vtau          , ndim_hV, ndex_hV )   ! j-wind stress
+
+         ! Write fields on W grid
+      CALL histwrite( nid_W, "vovecrtz", it, wn             , ndim_T, ndex_T )    ! vert. current
+      IF( ln_traldf_gdia ) THEN
+         DO jk=1,jpk-1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2v(ji,jj) + &
+                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
+               END DO
+            END DO
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL histwrite( nid_W, "voveeivw", it, zw3d          , ndim_T, ndex_T )    ! vert. eiv current
+      ELSE
+#   if defined key_diaeiv
+         CALL histwrite( nid_W, "voveeivw", it, w_eiv          , ndim_T, ndex_T )    ! vert. eiv current
+#   endif
+      ENDIF
+      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 defined key_traldf_c2d
+      CALL histwrite( nid_W, "soleahtw", it, ahtw          , ndim_hT, ndex_hT )   ! lateral eddy diff. coef.
+# if defined key_traldf_eiv
+         CALL histwrite( nid_W, "soleaeiw", it, aeiw       , ndim_hT, ndex_hT )   ! EIV coefficient at w-point
+# endif
+#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 ( ln_traldf_gdia )  call wrk_dealloc( jpi , jpj , jpk  , zw3d )
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
+      !
+   END SUBROUTINE dia_wri
+# endif
+
+#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, zdt
+      !!----------------------------------------------------------------------
+      ! 
+      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)
+      zdt  = rdt
+      zsto = rdt
+      clop = "inst(x)"           ! no use of the mask value (require less cpu time)
+      zout = rdt
+      zmax = ( nitend - nit000 + 1 ) * zdt
+
+      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, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit
+      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept
+          "m", jpk, gdept_0, nz_i, "down")
+
+      ! 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 ) 
+      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 )
+#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
+      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
+
+      ! 3. Close the file
+      ! -----------------
+      CALL histclo( id_i )
+#if ! defined key_iomput && ! defined key_dimgout
+      IF( ninist /= 1  ) THEN
+         CALL histclo( nid_T )
+         CALL histclo( nid_U )
+         CALL histclo( nid_V )
+         CALL histclo( nid_W )
+      ENDIF
+#endif
+       
+      IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state')
+      ! 
+
+   END SUBROUTINE dia_wri_state
+   !!======================================================================
+END MODULE diawri
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90	(revision 3437)
@@ -0,0 +1,365 @@
+  !!----------------------------------------------------------------------
+  !!                        ***  diawri_dimg.h90  ***
+  !!----------------------------------------------------------------------
+  !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+  !! $Id $
+  !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+  !!----------------------------------------------------------------------
+
+  SUBROUTINE dia_wri( kt )
+    !!----------------------------------------------------------------------
+    !!           *** routine dia_wri ***
+    !!
+    !! ** Purpose : output dynamics and tracer fields on direct access file
+    !!              suitable for MPP computing
+    !!
+    !! ** define key : 'key_dimgout'
+    !!
+    !! **  Method : Default is to cumulate the values over the interval between
+    !!      2 output, and each nwrite time-steps  the mean value is  computed 
+    !!      and written to the direct access file.
+    !!     If 'key_diainstant' is defined, no mean values are computed and the 
+    !!     instantaneous fields are dump.
+    !!       Each processor creates its own file with its local data
+    !!     Merging all the files is performed off line by a dedicated program
+    !!
+    !! ** Arguments :
+    !!     kt      : time-step number
+    !!     kindinc :  error condition indicator : >=0 :  OK, < 0 : error.
+    !!
+    !! ** Naming convention for files
+    !!
+    !! {cexper}_{var}_y----m--d--.dimg
+    !!   cexper is the name of the experience, given in the namelist
+    !!   var can be either U, V, T, S, KZ, SSH, ...
+    !!   var can also be 2D, which means that each level of the file is a 2D field as described below
+    !!    y----m--d--  is the date at the time of the dump
+    !!    For mpp output, each processor dumps its own memory, on appropriate record range 
+    !!    (direct access : for level jk of a klev field on proc narea irec = 1+ klev*(narea -1) + jk )
+    !!    To be tested with a lot of procs !!!!
+    !!
+    !!  level 1:  utau(:,:) * umask(:,:,1) zonal stress in N.m-2
+    !!  level 2:  vtau(:,:) * vmask(:,:,1) meridional stress in N. m-2
+    !!  level 3:  qsr + qns                total heat flux (W/m2)
+    !!  level 4:  ( emp (:,:)-rnf(:,:) )   E-P flux (mm/day)
+    !!  level 5:  tb  (:,:,1)-sst          model SST -forcing sst (degree C) ! deprecated
+    !!  level 6:  bsfb(:,:)		   streamfunction (m**3/s)
+    !!  level 7:  qsr (:,:)		   solar flux (W/m2)
+    !!  level 8:  qrp (:,:)                relax component of T flux.
+    !!  level 9:  erp (:,:)                relax component of S flux
+    !!  level 10: hmld(:,:)                turbocline depth
+    !!  level 11: hmlp(:,:)                mixed layer depth
+    !!  level 12: fr_i(:,:)                ice fraction (between 0 and 1)
+    !!  level 13: sst(:,:)                 the observed SST we relax to. ! deprecated
+    !!  level 14: qct(:,:)                 equivalent flux due to treshold SST
+    !!  level 15: fbt(:,:)                 feedback term .
+    !!  level 16: ( emps(:,:) - rnf(:,:) ) concentration/dilution water flux
+    !!  level 17: fsalt(:,:)               Ice=>ocean net freshwater
+    !!  level 18: gps(:,:)                 the surface pressure (m).
+    !!  level 19: spgu(:,:)                the surface pressure gradient in X direction.
+    !!  level 20: spgv(:,:)                the surface pressure gradient in Y direction.
+    !! 
+    !! History:  OPA  ! 1997-02 ( Clipper Group ) dimg files
+    !!            -   ! 2003-12 ( J.M. Molines) f90, mpp output for OPA9.0
+    !!   NEMO    1.0  ! 2005-05  (S. Theetten) add emps fsalt move gps spgu spgv 2 lines below
+    !!            -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+    !!----------------------------------------------------------------------
+    USE lib_mpp
+    !!
+    INTEGER ,INTENT(in) :: kt
+    !!
+#if defined key_diainstant
+    LOGICAL, PARAMETER :: ll_dia_inst=.TRUE.  !: for instantaneous output
+#else
+    LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output
+#endif
+    INTEGER              , SAVE                    ::  nmoyct 
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  um , vm, wm   ! mean u, v, w fields
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  avtm          ! mean kz fields
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  tm , sm       ! mean t, s fields
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::  fsel          ! mean 2d fields
+    
+    INTEGER :: inbsel, jk
+    INTEGER :: iyear,imon,iday
+    INTEGER :: ialloc
+    REAL(wp) :: zdtj
+    CHARACTER(LEN=80) :: clname
+    CHARACTER(LEN=80) :: cltext
+    CHARACTER(LEN=80) :: clmode
+    CHARACTER(LEN= 4) :: clver
+    !!----------------------------------------------------------------------
+    IF( nn_timing == 1 )   CALL timing_start('dia_wri')
+    !
+    !  Initialization
+    !  ---------------
+    !
+    IF( .NOT. ALLOCATED(um) )THEN
+       ALLOCATE(um(jpi,jpj,jpk), vm(jpi,jpj,jpk), &
+                wm(jpi,jpj,jpk),                  &
+                avtm(jpi,jpj,jpk),                &
+                tm(jpi,jpj,jpk), sm(jpi,jpj,jpk), &
+                fsel(jpi,jpj,jpk),                &
+                STAT=ialloc )
+       !
+       IF( lk_mpp      )   CALL mpp_sum ( ialloc  )
+       IF( ialloc /= 0 )   CALL ctl_warn('dia_wri( diawri_dimg.h90) : failed to allocate arrays')
+    ENDIF
+
+
+    inbsel = 17
+
+    IF( inbsel >  jpk ) THEN
+       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk
+       STOP
+    ENDIF
+
+    iyear = ndastp/10000
+    imon = (ndastp-iyear*10000)/100
+    iday = ndastp - imon*100 - iyear*10000
+
+    !     
+    !! dimg format V1.0 should start with the 4 char. string '@!01'
+    !!
+    clver='@!01'
+    !
+    IF( .NOT. ll_dia_inst ) THEN
+       !
+       !! * Mean output section
+       !! ----------------------
+       !
+       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
+            'THE OUTPUT FILES CONTAINS THE AVERAGE OF EACH FIELD'
+       !
+       IF( kt == nit000  ) THEN
+          ! reset arrays for average computation
+          nmoyct = 0
+          !
+          um(:,:,:) = 0._wp
+          vm(:,:,:) = 0._wp
+          wm(:,:,:) = 0._wp
+          avtm(:,:,:) = 0._wp
+          tm(:,:,:) = 0._wp
+          sm(:,:,:) = 0._wp
+          fsel(:,:,:) = 0._wp
+          !
+       ENDIF
+
+       !  cumulate values
+       !  ---------------
+
+       nmoyct = nmoyct+1
+       !
+       um(:,:,:)=um(:,:,:) + un (:,:,:)
+       vm(:,:,:)=vm(:,:,:) + vn (:,:,:)
+       wm(:,:,:)=wm(:,:,:) + wn (:,:,:)
+       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:)
+       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem)
+       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal)
+       !
+       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1)
+       fsel(:,:,2 ) = fsel(:,:,2 ) + vtau(:,:) * vmask(:,:,1)
+       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:) 
+       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) ) 
+       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used
+       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) 
+       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:)
+       fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:)
+       fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:)
+       fsel(:,:,10) = fsel(:,:,10) + hmld(:,:)
+       fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:)
+       fsel(:,:,12) = fsel(:,:,12) + fr_i(:,:)
+       !        fsel(:,:,13) = fsel(:,:,13)   !RB not used
+       !        fsel(:,:,14) = fsel(:,:,14) + qct(:,:)
+       !        fsel(:,:,15) = fsel(:,:,15) + fbt(:,:)
+       fsel(:,:,16) = fsel(:,:,16) + ( emps(:,:)-rnf(:,:) ) 
+       !
+       ! Output of dynamics and tracer fields and selected fields
+       ! --------------------------------------------------------
+       !
+       !
+       zdtj=rdt/86400.   ! time step in days
+       WRITE(clmode,'(f5.1,a)' ) nwrite*zdtj,' days average'
+
+       !       iwrite=NINT(adatrj/rwrite)
+       !      IF (abs(adatrj-iwrite*rwrite) < zdtj/2.      &
+
+       IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
+            &   .OR. ( kt == 1 .AND. ninist ==1 )  ) THEN
+          ! it is time to make a dump on file 
+          ! compute average
+          um(:,:,:) = um(:,:,:) / nmoyct
+          vm(:,:,:) = vm(:,:,:) / nmoyct
+          wm(:,:,:) = wm(:,:,:) / nmoyct
+          avtm(:,:,:) = avtm(:,:,:) / nmoyct
+          tm(:,:,:) = tm(:,:,:) / nmoyct
+          sm(:,:,:) = sm(:,:,:) / nmoyct
+          !
+          fsel(:,:,:) = fsel(:,:,:) / nmoyct
+          !
+          ! note : the surface pressure is not averaged, but rather 
+          ! computed from the averaged gradients.
+          !
+          ! mask mean field with tmask except utau vtau (1,2)
+          DO jk=3,inbsel
+            fsel(:,:,jk)=fsel(:,:,jk)*tmask(:,:,1)
+          END DO
+       ENDIF
+       !
+    ELSE   ! ll_dia_inst true
+       !
+       !! * Instantaneous output section
+       !! ------------------------------
+       !
+       IF( kt == nit000 .AND. lwp ) WRITE(numout,*) &
+            'THE OUTPUT FILES CONTAINS INSTANTANEOUS VALUES OF EACH FIELD'
+       !
+       zdtj=rdt/86400.   ! time step in days
+       !  iwrite=NINT(adatrj/rwrite)
+       clmode='instantaneous'
+       !     IF (abs(adatrj-iwrite*rwrite) < zdtj/2.  &
+       IF (  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
+            &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
+          !
+          ! transfer wp arrays to sp arrays for dimg files
+          fsel(:,:,:) = 0._wp
+          !
+          fsel(:,:,1 ) = utau(:,:) * umask(:,:,1)
+          fsel(:,:,2 ) = vtau(:,:) * vmask(:,:,1)
+          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1)
+          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1) 
+          !         fsel(:,:,5 ) = (tsb(:,:,1,jp_tem) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used
+
+          fsel(:,:,6 ) = sshn(:,:)
+          fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1)
+          fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1)
+          fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1)
+          fsel(:,:,10) = hmld(:,:) * tmask(:,:,1)
+          fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1)
+          fsel(:,:,12) = fr_i(:,:) * tmask(:,:,1)
+          !         fsel(:,:,13) = sf_sst(1)%fnow(:,:) !RB not used
+          !         fsel(:,:,14) =  qct(:,:)
+          !         fsel(:,:,15) =  fbt(:,:)
+          fsel(:,:,16) = ( emps(:,:)-rnf(:,:) ) * tmask(:,:,1) 
+          !
+          !         qct(:,:) = 0._wp
+       ENDIF
+    ENDIF
+    !
+    ! Opening of the datrj.out file with the absolute time in day of each dump
+    ! this file gives a record of the dump date for post processing ( ASCII file )
+    !
+    IF(  ( MOD (kt-nit000+1,nwrite) ==  0 )          &
+         &   .OR. ( kt == 1 .AND. ninist == 1 )  ) THEN
+
+       IF( lwp) WRITE(numout,*)'Days since the begining of the run :',adatrj
+
+       !! * U section
+
+       WRITE(clname,9000) TRIM(cexper),'U',iyear,imon,iday
+       cltext=TRIM(cexper)//' U(m/s) '//TRIM(clmode)
+       !
+       IF( ll_dia_inst) THEN   ;   CALL dia_wri_dimg(clname, cltext, un, jpk, 'T')
+       ELSE                    ;   CALL dia_wri_dimg(clname, cltext, um, jpk, 'T')
+       ENDIF
+
+       !! * V section
+
+       WRITE(clname,9000) TRIM(cexper),'V',iyear,imon,iday
+       cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode)
+       !
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, vm, jpk, 'T')
+       ENDIF
+       !
+
+       !! * KZ section
+
+       WRITE(clname,9000) TRIM(cexper),'KZ',iyear,imon,iday
+       cltext=TRIM(cexper)//' KZ(m2/s) '//TRIM(clmode)
+
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, avt, jpk, 'W')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, avtm, jpk, 'W')
+       ENDIF
+       !
+
+       !! * W section
+
+       WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday
+       cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode)
+
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W')
+       ENDIF
+
+       !! * T section
+
+       WRITE(clname,9000) TRIM(cexper),'T',iyear,imon,iday
+       cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode)
+
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T')
+       ENDIF
+       !
+
+       !! * S section
+
+       WRITE(clname,9000) TRIM(cexper),'S',iyear,imon,iday
+       cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode)
+
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T')
+       ENDIF
+       !
+
+       !! * 2D section
+
+       WRITE(clname,9000) TRIM(cexper),'2D',iyear,imon,iday
+       cltext='2D fields '//TRIM(clmode)
+
+       IF( ll_dia_inst) THEN
+          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
+       ELSE
+          CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2')
+       ENDIF
+
+       IF( lk_mpp )   CALL mppsync   ! synchronization in mpp
+
+       !! * Log message in numout 
+
+       IF( lwp)WRITE(numout,*) ' '
+       IF( lwp)WRITE(numout,*) ' **** WRITE in dimg file ',kt
+
+       IF( lwp .AND.        ll_dia_inst) WRITE(numout,*) '    instantaneous fields'
+       IF( lwp .AND. .NOT.  ll_dia_inst) WRITE(numout,*) '    average fields with ',nmoyct,'pdt'
+       !
+       !
+       !! * Reset cumulating arrays  and counter to 0 after writing
+       !
+       IF( .NOT. ll_dia_inst ) THEN
+          nmoyct = 0
+          !
+          um(:,:,:) = 0._wp
+          vm(:,:,:) = 0._wp
+          wm(:,:,:) = 0._wp
+          tm(:,:,:) = 0._wp
+          sm(:,:,:) = 0._wp
+          fsel(:,:,:) = 0._wp
+          avtm(:,:,:) = 0._wp
+       ENDIF
+    ENDIF
+    !
+    IF( nn_timing == 1 )   CALL timing_stop('dia_wri')
+    !
+9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+    !
+  END SUBROUTINE dia_wri
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90	(revision 3437)
@@ -0,0 +1,439 @@
+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 in_out_manager  ! I/O manager
+   USE sbc_oce         ! ocean surface boundary conditions
+   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 sbc_clo      ! routine called by step module
+   PUBLIC clo_rnf      ! routine called by sbcrnf module
+   PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) 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
+#  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 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
+      !!----------------------------------------------------------------------
+      
+      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
+            !                                        ! =======================
+            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea
+            ncsi1(1)   = 332  ; ncsj1(1)   = 203
+            ncsi2(1)   = 344  ; ncsj2(1)   = 235
+            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 1 : west part of the Black Sea 
+            ncsnr(3)   = 1    ; ncstt(3)   =   2            !            (ie west of the cyclic b.c.)
+            ncsi1(3)   = 174  ; ncsj1(3)   = 107            ! put in Med Sea
+            ncsi2(3)   = 181  ; ncsj2(3)   = 112
+            ncsir(3,1) = 171  ; ncsjr(3,1) = 106 
+            !                                            ! Black Sea 2 : est part of the Black Sea 
+            ncsnr(4)   =   1  ;  ncstt(4)   =   2           !               (ie est of the cyclic b.c.)
+            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! put in Med Sea
+            ncsi2(4)   =   6  ;  ncsj2(4)   = 112
+            ncsir(4,1) = 171  ;  ncsjr(4,1) = 106 
+            !                                        ! =======================
+         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 sbc_clo( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  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, emps   updated surface freshwater fluxes at kt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean model time step
+      !
+      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     ! 
+      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.e0_wp
+         !
+         surf(jpncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean
+         !
+         !                                        ! surface of closed seas 
+         IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
+            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
+         ELSE                                          ! Standard calculation           
+            DO jc = 1, jpncs
+               DO jj = ncsj1(jc), ncsj2(jc)
+                  DO ji = ncsi1(jc), ncsi2(jc)
+                     surf(jc) = surf(jc) + e1e2t(ji,jj) * tmask_i(ji,jj)      ! surface of closed seas
+                  END DO 
+               END DO 
+            END DO 
+            IF( lk_mpp )   CALL mpp_sum ( surf, jpncs+1 )       ! mpp: sum over all the global domain
+         ENDIF
+
+         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, emps  !
+      zfwf = 0.e0_wp                                      !--------------------!
+      IF( lk_mpp_rep ) THEN                         ! MPP reproductible calculation
+         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
+      ELSE                                          ! Standard calculation           
+         DO jc = 1, jpncs
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  zfwf(jc) = zfwf(jc) + e1e2t(ji,jj) * ( emp(ji,jj)-rnf(ji,jj) ) * tmask_i(ji,jj) 
+               END DO  
+            END DO 
+         END DO
+         IF( lk_mpp )   CALL mpp_sum ( zfwf(:) , jpncs )       ! mpp: sum over all the global domain
+      ENDIF
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 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
+               emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+               emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
+               ! accumulate closed seas correction
+               zcorr     = zcorr     + zfwf(jc) / surf(jpncs+1)
+               !
+            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 
+                         emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
+                         emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) * e1e2t(ji,jj) )
+                     ENDIF 
+                   END DO 
+               ELSE 
+                   emp (:,:) = emp (:,:) + zfwf(jc) / surf(jpncs+1)
+                   emps(:,:) = emps(:,:) + zfwf(jc) / surf(jpncs+1)
+                   ! accumulate closed seas correction
+                   zcorr     = zcorr     + zfwf(jc) / surf(jpncs+1)
+               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 
+                     emp (ji,jj) = emp (ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
+                     emps(ji,jj) = emps(ji,jj) + zfwf(jc) / ( REAL(ncsnr(jc)) *  e1e2t(ji,jj) )
+                  ENDIF 
+               END DO 
+            ENDIF 
+            !
+            DO jj = ncsj1(jc), ncsj2(jc)
+               DO ji = ncsi1(jc), ncsi2(jc)
+                  emp (ji,jj) = emp (ji,jj) - zfwf(jc) / surf(jc)
+                  emps(ji,jj) = emps(ji,jj) - zfwf(jc) / surf(jc)
+               END DO  
+            END DO 
+            !
+         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
+                  emps(ji,jj) = emps(ji,jj) - zcorr
+               END DO  
+             END DO 
+          END DO
+      ENDIF
+      !
+      emp (:,:) = emp (:,:) * tmask(:,:,1)
+      emps(:,:) = emps(:,:) * tmask(:,:,1)
+      !
+      CALL lbc_lnk( emp , 'T', 1._wp )
+      CALL lbc_lnk( emps, '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      ! dummy loop indices
+      INTEGER  ::   ii, ij      ! temporary integer
+      !!----------------------------------------------------------------------
+      !
+      DO jc = 1, jpncs
+         IF( ncstt(jc) >= 1 ) THEN            ! runoff mask set to 1 at closed sea outflows
+             DO jn = 1, 4
+               ii = mi0( ncsir(jc,jn) )
+               ij = mj0( ncsjr(jc,jn) )
+               p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0_wp )
+            END DO 
+         ENDIF 
+      END DO 
+      !
+   END SUBROUTINE clo_rnf
+
+   
+   SUBROUTINE clo_ups( p_upsmsk )
+      !!---------------------------------------------------------------------
+      !!                  ***  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 0.5 the upstream mask (upsmsk, see traadv_cen2 
+      !!                module) over the closed seas.
+      !!
+      !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array)
+      !
+      INTEGER  ::   jc, ji, jj      ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jc = 1, jpncs
+         DO jj = ncsj1(jc), ncsj2(jc)
+            DO ji = ncsi1(jc), ncsi2(jc)
+               p_upsmsk(ji,jj) = 0.5_wp         ! mixed upstream/centered scheme over closed seas
+            END DO 
+         END DO 
+       END DO 
+       !
+   END SUBROUTINE clo_ups
+   
+      
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90	(revision 3437)
@@ -0,0 +1,361 @@
+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, rdttra(1) ) == 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 trc_oce, ONLY : lk_offline ! offline flag
+   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
+      !!----------------------------------------------------------------------
+      !
+      ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0
+      IF( MOD( rday     , rdttra(1) ) /= 0. )   CALL ctl_stop( 'the time step must devide the number of second of in a day' )
+      IF( MOD( rday     , 2.        ) /= 0. )   CALL ctl_stop( 'the number of second of in a day must be an even number'    )
+      IF( MOD( rdttra(1), 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(      rdttra(1))
+      ndt05   = NINT(0.5 * rdttra(1))
+
+      IF( .NOT. lk_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 ) 
+
+      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,i6)')' ==============>> 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
+         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  + rdttra(1) / rday
+      fjulday = fjulday + rdttra(1) / 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. lk_offline ) CALL rst_opn( kt )               ! Open the restart file if needed and control lrst_oce
+      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information
+      !
+      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 ) * rdttra(1) ) / rday 
+               ! note this is wrong if time step has changed during run 
+            ENDIF
+         ELSE
+            ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day)
+            ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00
+            adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
+         ENDIF
+         IF( ABS(adatrj  - REAL(NINT(adatrj),wp)) < 0.1 / rday )   adatrj = REAL(NINT(adatrj),wp)   ! avoid truncation error
+         !
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info used values : '
+            WRITE(numout,*) '   date ndastp                                      : ', ndastp
+            WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+            WRITE(numout,*)
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         !
+         IF( kt == nitrst ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file  kt =', kt
+            IF(lwp) WRITE(numout,*) '~~~~~~~'         
+         ENDIF
+         ! calendar control
+         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step 
+         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date
+         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since
+         !                                                                     ! the begining of the run [s]
+      ENDIF
+      !
+   END SUBROUTINE day_rst
+
+   !!======================================================================
+END MODULE daymod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90	(revision 3437)
@@ -0,0 +1,314 @@
+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
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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... to be suppressed ???
+
+   PUBLIC dom_oce_alloc  ! Called from nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! time & space domain namelist
+   !! ----------------------------
+   !                                              !!* Namelist namdom : time & space domain *
+   INTEGER , PUBLIC ::   nn_bathy     =    0       !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   rn_hmin      =   -3.0_wp  !: minimum ocean depth (>0) or minimum number of ocean levels (<0)
+   REAL(wp), PUBLIC ::   rn_e3zps_min =    5.0_wp  !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   rn_e3zps_rat =    0.1_wp  !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nn_msh       =    0       !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nn_acc       =    0       !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   rn_atfp      =    0.1_wp  !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rn_rdt       = 3600._wp   !: time step for the dynamics (and tracer if nacc=0)
+   REAL(wp), PUBLIC ::   rn_rdtmin    = 3600._wp   !: minimum time step on tracers
+   REAL(wp), PUBLIC ::   rn_rdtmax    = 3600._wp   !: maximum time step on tracers
+   REAL(wp), PUBLIC ::   rn_rdth      =  800._wp   !: depth variation of tracer step
+   INTEGER , PUBLIC ::   nn_baro      =   64       !: number of barotropic time steps (key_dynspg_ts)
+   INTEGER , PUBLIC ::   nn_closea    =    0       !: =0 suppress closed sea/lake from the ORCA domain or not (=1)
+
+   !                                    !! old non-DOCTOR names still used in the model
+   INTEGER , PUBLIC ::   ntopo           !: = 0/1 ,compute/read the bathymetry file
+   REAL(wp), PUBLIC ::   e3zps_min       !: miminum thickness for partial steps (meters)
+   REAL(wp), PUBLIC ::   e3zps_rat       !: minimum thickness ration for partial steps
+   INTEGER , PUBLIC ::   nmsh            !: = 1 create a mesh-mask file
+   INTEGER , PUBLIC ::   nacc            !: = 0/1 use of the acceleration of convergence technique
+   REAL(wp), PUBLIC ::   atfp            !: asselin time filter parameter
+   REAL(wp), PUBLIC ::   rdt             !: time step for the dynamics (and tracer if nacc=0)
+   REAL(wp), PUBLIC ::   rdtmin          !: minimum time step on tracers
+   REAL(wp), PUBLIC ::   rdtmax          !: maximum time step on tracers
+   REAL(wp), PUBLIC ::   rdth            !: depth variation of tracer step
+
+   !                                                  !!! associated variables
+   INTEGER , PUBLIC                 ::   neuler  = 0   !: restart euler forward option (0=Euler)
+   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0
+
+   !                                         !!* Namelist namcla : cross land advection
+   INTEGER, PUBLIC ::   nn_cla = 0            !: =1 cross land advection for exchanges through some straits (ORCA2)
+
+   !!----------------------------------------------------------------------
+   !! 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
+   LOGICAL, PUBLIC ::   lzoom_arct =  .FALSE.   !: ORCA    arctic zoom flag
+   LOGICAL, PUBLIC ::   lzoom_anta =  .FALSE.   !: ORCA antarctic zoom 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, 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,               DIMENSION(jpidta) ::   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,               DIMENSION(jpjdta) ::   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
+
+   !!----------------------------------------------------------------------
+   !! horizontal curvilinear coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamt, glamu   !: longitude of t-, u-, v- and f-points (degre)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  glamv, glamf   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !:
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1)
+
+   !!----------------------------------------------------------------------
+   !! vertical coordinate and scale factors
+   !! ---------------------------------------------------------------------
+   !                                           !!* Namelist namzgr : vertical coordinate *
+   LOGICAL, PUBLIC ::   ln_zco     =  .TRUE.    !: z-coordinate - full step
+   LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step
+   LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w          !: depth of T-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept , gdepw   !: analytical depth at T-W  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t   , e3u     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw            !: analytical vertical scale factors at  VW--
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w   , e3uw    !:                                        W--UW  points (m)
+#if defined key_vvl
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag
+
+   !! All coordinates
+   !! ---------------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdep3w_1           !: depth of T-points (sum of e3w) (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_1, gdepw_1   !: analytical depth at T-W  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3v_1  , e3f_1     !: analytical vertical scale factors at  V--F
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_1  , e3u_1     !:                                       T--U  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3vw_1             !: analytical vertical scale factors at  VW--
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3w_1  , e3uw_1    !:                                       W--UW  points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3t_b              !: before         -      -      -    -   T      points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   e3u_b  , e3v_b     !:   -            -      -      -    -   U--V   points (m)
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag
+#endif
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu   , hv     !: depth at u- and v-points (meters)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters)
+
+   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1)
+   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1) 
+
+   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate)
+   !! =-----------------====------
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   :: e3t_0  , e3w_0   !: 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
+
+   !! 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)
+
+   !!----------------------------------------------------------------------
+   !! 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(:,:) ::   bmask        !: land/ocean mask of barotropic stream function
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts
+
+   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
+
+#if defined key_noslip_accurate
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: npcoa        !: ???
+   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ???
+#endif
+
+   !!----------------------------------------------------------------------
+   !! calendar variables
+   !! ---------------------------------------------------------------------
+   INTEGER , PUBLIC ::   nyear         !: current year
+   INTEGER , PUBLIC ::   nmonth        !: current month
+   INTEGER , PUBLIC ::   nday          !: current day of the month
+   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format
+   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year
+   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month
+   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday
+   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day
+   REAL(wp), PUBLIC ::   fjulday       !: current julian day 
+   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days
+   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation
+   !                                   !: (cumulative duration of previous runs that may have used different time-step size)
+   INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year
+   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year
+   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
+   !!----------------------------------------------------------------------
+#if defined key_mpp_rep
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .TRUE.    !: agrif flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp_rep = .FALSE.   !: agrif flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! agrif domain
+   !!----------------------------------------------------------------------
+#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(11) :: ierr
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) )
+         !
+      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     &
+         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     &
+         &                                      nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) )
+         !
+      ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) ,                      & 
+         &      glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) ,                      &  
+         &      glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) ,     &  
+         &      glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff   (jpi,jpj) , STAT=ierr(3) )     
+         !
+      ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) ,                         &
+         &      gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) ,                         &
+         &      gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) )
+         !
+#if defined key_vvl
+      ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) ,                           &
+         &      gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) ,                           &
+         &      gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) ,     &
+         &      e3t_b   (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk)                       , STAT=ierr(5) )
+#endif
+         !
+      ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) ,     &
+         &      hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) )
+         !
+      ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) ,                                     &
+         &      e3t_0  (jpk) , e3w_0  (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) , bmask(jpi,jpj) ,                     &
+         &     mbkt   (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) )
+
+      ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk),     & 
+         &      vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) )
+
+#if defined key_noslip_accurate
+      ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) )
+#endif
+      !
+      dom_oce_alloc = MAXVAL(ierr)
+      !
+   END FUNCTION dom_oce_alloc
+
+   !!======================================================================
+END MODULE dom_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90	(revision 3437)
@@ -0,0 +1,325 @@
+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
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   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 sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! physical constants
+   USE closea          ! closed seas
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+
+   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 c1d             ! 1D vertical configuration
+   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_init   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!-------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
+   !!-------------------------------------------------------------------------
+CONTAINS
+
+   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 argument
+      INTEGER ::   iconf = 0         ! temporary integers
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_init')
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_init : domain initialization'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
+                             CALL dom_clo      ! Closed seas and lake
+                             CALL dom_hgr      ! Horizontal mesh
+                             CALL dom_zgr      ! Vertical mesh and bathymetry
+                             CALL dom_msk      ! Masks
+      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
+      !
+      IF( lk_c1d ) THEN                        ! 1D configuration 
+         CALL cor_c1d                          ! Coriolis set at T-point
+         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
+         vmask(:,:,:) = tmask(:,:,:)
+      END IF
+      !
+      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
+      hv(:,:) = 0.e0
+      DO jk = 1, jpk
+         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
+         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
+      END DO
+      !                                        ! Inverse of the local depth
+      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
+      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
+
+                             CALL dom_stp      ! time step
+      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
+      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
+      !
+      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
+      !!              - namcla namelist
+      !!              - namnc4 namelist   ! "key_netcdf4" only
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
+         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
+         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
+      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
+         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
+         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
+      NAMELIST/namcla/ nn_cla
+#if defined key_netcdf4
+      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
+#endif
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )              ! Namelist namrun : parameters of the run
+      READ  ( numnam, namrun )
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namrun'
+         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
+         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
+         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
+         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
+         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
+         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
+         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
+         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
+         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
+         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
+         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
+         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
+         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
+         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
+         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
+      ENDIF
+
+      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
+      cexper = cn_exp
+      nrstdt = nn_rstctl
+      nit000 = nn_it000
+      nitend = nn_itend
+      ndate0 = nn_date0
+      nleapy = nn_leapy
+      ninist = nn_istate
+      nstock = nn_stock
+      nwrite = nn_write
+
+
+      !                             ! control of output frequency
+      IF ( nstock == 0 .OR. nstock > nitend ) THEN
+         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nstock = nitend
+      ENDIF
+      IF ( nwrite == 0 ) THEN
+         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
+         CALL ctl_warn( ctmp1 )
+         nwrite = nitend
+      ENDIF
+
+#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 )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
+      READ  ( numnam, namdom )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namdom : space & time domain'
+         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
+         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
+         WRITE(numout,*) '      min number of ocean level (<0)       '
+         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
+         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
+         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
+         WRITE(numout,*) '           = 0   no file created           '
+         WRITE(numout,*) '           = 1   mesh_mask                 '
+         WRITE(numout,*) '           = 2   mesh and mask             '
+         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask'
+         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
+         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
+         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
+         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
+         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
+         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
+         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
+         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
+      ENDIF
+
+      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
+      e3zps_min = rn_e3zps_min
+      e3zps_rat = rn_e3zps_rat
+      nmsh      = nn_msh
+      nacc      = nn_acc
+      atfp      = rn_atfp
+      rdt       = rn_rdt
+      rdtmin    = rn_rdtmin
+      rdtmax    = rn_rdtmin
+      rdth      = rn_rdth
+
+      REWIND( numnam )              ! Namelist cross land advection
+      READ  ( numnam, namcla )
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namcla'
+         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
+      ENDIF
+
+#if defined key_netcdf4
+      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
+      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
+      READ  ( numnam, namnc4 )
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
+         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
+         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
+         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
+         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
+      ENDIF
+
+      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
+      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
+      snc4set%ni   = nn_nchunks_i
+      snc4set%nj   = nn_nchunks_j
+      snc4set%nk   = nn_nchunks_k
+      snc4set%luse = ln_nc4zip
+#else
+      snc4set%luse = .FALSE.        ! No NetCDF 4 case
+#endif
+      !
+   END SUBROUTINE dom_nam
+
+
+   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(:,:,1), ze1min, iimi1,ijmi1 )
+         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
+         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
+         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
+      ELSE
+         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )    
+
+         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi1 = iloc(1) + nimpp - 1
+         ijmi1 = iloc(2) + njmpp - 1
+         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iimi2 = iloc(1) + nimpp - 1
+         ijmi2 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima1 = iloc(1) + nimpp - 1
+         ijma1 = iloc(2) + njmpp - 1
+         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
+         iima2 = iloc(1) + nimpp - 1
+         ijma2 = iloc(2) + njmpp - 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         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
+
+   !!======================================================================
+END MODULE domain
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90	(revision 3437)
@@ -0,0 +1,194 @@
+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$ 
+   !! 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
+      !!----------------------------------------------------------------------
+
+      !                        ! ============== !
+      !                        !  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
+         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
+ 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(  jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
+               & jpizoom ==  21    .AND. jpjzoom ==  97         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+            !                             
+         CASE ( 05 )                              !  ORCA_R05 configuration
+            IF(  jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
+               & jpizoom ==  81    .AND. jpjzoom == 301         )   lzoom_arct = .TRUE.
+            IF(  jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
+               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
+         END SELECT
+         !
+         IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic/arctic zoom flags : '
+         IF(lwp) WRITE(numout,*) '             lzoom_arct = ', lzoom_arct, ' (T=   arctic zoom, F=global)'
+         IF(lwp) WRITE(numout,*) '             lzoom_anta = ', lzoom_anta, ' (T=antarctic zoom, F=global)'
+         !
+      ENDIF
+      !
+   END SUBROUTINE dom_glo
+
+   !!======================================================================
+END MODULE domcfg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90	(revision 3437)
@@ -0,0 +1,627 @@
+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 
+   !!            4.0  ! 2011-02  (G. Madec) add cell surface (e1e2t)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 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 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! 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
+      !!----------------------------------------------------------------------
+      !
+      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 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
+
+         CALL hgr_read           ! Defaultl option  :   NetCDF file
+
+         !                                                ! =====================
+         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+            !                                             ! =====================
+            IF( nn_cla == 0 ) THEN
+               !
+               ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u = 20 km)
+               ij0 = 102   ;   ij1 = 102   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Gibraltar    : e2u reduced to 20 km'
+               !
+               ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u = 18 km)
+               ij0 =  88   ;   ij1 =  88   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  18.e3
+                                               e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  30.e3
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb: e2u reduced to 30 km'
+               IF(lwp) WRITE(numout,*) '                                     e1v reduced to 18 km'
+            ENDIF
+
+            ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u = 10 km)
+            ij0 = 116   ;   ij1 = 116   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r2: Danish Straits : e2u reduced to 10 km'
+            !
+         ENDIF
+
+            !                                             ! =====================
+         IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
+            !                                             ! =====================
+
+            ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u = 20 km)
+            ij0 = 200   ;   ij1 = 200   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Gibraltar : e2u reduced to 20 km'
+
+            ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u = 10 km)
+            ij0 = 208   ;   ij1 = 208   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Bhosporus : e2u reduced to 10 km'
+
+            ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v = 13 km)
+            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  13.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Lombok : e1v reduced to 10 km'
+
+            ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v = 8 km) [closed from bathy_11 on]
+            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  8.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Sumba : e1v reduced to 8 km'
+
+            ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v = 13 km)
+            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 13.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Ombai : e1v reduced to 13 km'
+
+            ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v = 20 km)
+            ij0 = 124   ;   ij1 = 125   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 20.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: Timor Passage : e1v reduced to 20 km'
+
+            ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v = 30 km)
+            ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 30.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: W Halmahera : e1v reduced to 30 km'
+
+            ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v = 50 km)
+            ij0 = 141   ;   ij1 = 142   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 50.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r1: E Halmahera : e1v reduced to 50 km'
+
+            !
+
+            !
+            !
+            !
+            !
+         ENDIF
+
+         !                                                ! ======================
+         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
+            !                                             ! ======================
+            ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
+            ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Gibraltar Strait'
+            !
+            ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u = 10 km)
+            ij0 = 343   ;   ij1 = 343   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Bosphore Strait'
+            !
+            ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u = 40 km)
+            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  40.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Sumba Strait'
+            !
+            ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u = 15 km)
+            ij0 = 232   ;   ij1 = 232   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  15.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Ombai Strait'
+            !
+            ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u = 10 km)
+            ij0 = 270   ;   ij1 = 270   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Palk Strait'
+            !
+            ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v = 10 km)
+            ij0 = 232   ;   ij1 = 233   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  10.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Lombok Strait'
+            !
+            !
+            ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v = 25 km)
+            ij0 = 276   ;   ij1 = 276   ;   e1v( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  25.e3
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e1v at the Bab el Mandeb'
+            !
+         ENDIF
+
+
+         ! N.B. :  General case, lat and long function of both i and j indices:
+         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   &
+         !                                  + (                           fsdiph( zti, ztj ) )**2  )
+         !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   &
+         !                                  + (                           fsdiph( zui, zuj ) )**2  )
+         !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   &
+         !                                  + (                           fsdiph( zvi, zvj ) )**2  )
+         !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   &
+         !                                  + (                           fsdiph( zfi, zfj ) )**2  )
+         !
+         !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   &
+         !                                  + (                           fsdjph( zti, ztj ) )**2  )
+         !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   &
+         !                                  + (                           fsdjph( zui, zuj ) )**2  )
+         !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   &
+         !                                  + (                           fsdjph( zvi, zvj ) )**2  )
+         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   &
+         !                                  + (                           fsdjph( zfi, zfj ) )**2  )
+
+
+      CASE ( 1 )                     ! geographical mesh on the sphere with regular 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 = 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
+               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.e0
+         gphi0 = - ppe2_m * 1.e-3
+         
+#if defined key_agrif && defined key_eel_r6
+         IF( .NOT. Agrif_Root() ) THEN
+           glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3
+           gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3
+           ppe1_m = Agrif_Parent(ppe1_m)/Agrif_Rhox()
+           ppe2_m = Agrif_Parent(ppe2_m)/Agrif_Rhoy()          
+         ENDIF
+#endif         
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       )
+               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( 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 * ( FLOAT( jj - 1 + njmpp - 1 )       )
+               gphiu(ji,jj) = gphit(ji,jj)
+               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( 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 = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 )
+               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 )
+               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
+               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( 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
+         zphi1 = 29
+         ! resolution in meters
+         ze1 = 106000. / FLOAT(jp_cfg)            
+         ! benchmark: forced the resolution to be about 100 km
+         IF( nbench /= 0 )   ze1 = 106000.e0     
+         zsin_alpha = - SQRT( 2. ) / 2.
+         zcos_alpha =   SQRT( 2. ) / 2.
+         ze1deg = ze1 / (ra * rad)
+         IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon
+         !                                                          ! at the right jp_cfg resolution
+         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 )
+         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 )
+
+         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 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
+             zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( 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
+      
+      ! T-cell surface
+      ! --------------
+      e1e2t(:,:) = e1t(:,:) * e2t(:,:)
+
+
+      ! Control printing : Grid informations (if not restart)
+      ! ----------------
+
+      IF( lwp .AND. .NOT.ln_rstart ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '          longitude and e1 scale factors'
+         WRITE(numout,*) '          ------------------------------'
+         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
+            glamv(ji,1), glamf(ji,1),   &
+            e1t(ji,1), e1u(ji,1),   &
+            e1v(ji,1), 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
+
+      
+      IF( nprint == 1 .AND. lwp ) THEN
+         WRITE(numout,*) '          e1u e2u '
+         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1v e2v  '
+         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         WRITE(numout,*) '          e1f e2f  '
+         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
+      ENDIF
+
+
+      ! ================= !
+      !  Coriolis factor  !
+      ! ================= !
+
+      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
+
+      CASE ( 0, 1, 4 )               ! mesh on the sphere
+
+         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
+
+      CASE ( 2 )                     ! f-plane at ppgphi0 
+
+         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
+
+         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
+
+      CASE ( 3 )                     ! beta-plane
+
+         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
+         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
+         
+#if defined key_agrif && defined key_eel_r6
+         IF( .NOT. Agrif_Root() ) THEN
+           zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad)
+         ENDIF
+#endif         
+         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
+
+         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
+         
+         IF(lwp) THEN
+            WRITE(numout,*) 
+            WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(nldi,nldj)
+            WRITE(numout,*) '          Coriolis parameter varies from ', ff(nldi,nldj),' to ', ff(nldi,nlej)
+         ENDIF
+         IF( lk_mpp ) THEN 
+            zminff=ff(nldi,nldj)
+            zmaxff=ff(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.e0                                                      ! latitude of the first row F-points
+         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
+
+         ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - 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(nldi,nldj),' to ', ff(nldi,nlej)
+         ENDIF
+
+         IF( lk_mpp ) THEN 
+            zminff=ff(nldi,nldj)
+            zmaxff=ff(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) ) ) / FLOAT( 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
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE hgr_read  ***
+      !!
+      !! ** Purpose :   Read a coordinate file in NetCDF format 
+      !!
+      !! ** Method  :   The mesh file has been defined trough a analytical 
+      !!      or semi-analytical method. It is read in a NetCDF file. 
+      !!     
+      !!----------------------------------------------------------------------
+      USE iom
+
+      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 )
+      CALL iom_get( inum, jpdom_data, 'glamu', glamu )
+      CALL iom_get( inum, jpdom_data, 'glamv', glamv )
+      CALL iom_get( inum, jpdom_data, 'glamf', glamf )
+      
+      CALL iom_get( inum, jpdom_data, 'gphit', gphit )
+      CALL iom_get( inum, jpdom_data, 'gphiu', gphiu )
+      CALL iom_get( inum, jpdom_data, 'gphiv', gphiv )
+      CALL iom_get( inum, jpdom_data, 'gphif', gphif )
+      
+      CALL iom_get( inum, jpdom_data, 'e1t', e1t )
+      CALL iom_get( inum, jpdom_data, 'e1u', e1u )
+      CALL iom_get( inum, jpdom_data, 'e1v', e1v )
+      CALL iom_get( inum, jpdom_data, 'e1f', e1f )
+      
+      CALL iom_get( inum, jpdom_data, 'e2t', e2t )
+      CALL iom_get( inum, jpdom_data, 'e2u', e2u )
+      CALL iom_get( inum, jpdom_data, 'e2v', e2v )
+      CALL iom_get( inum, jpdom_data, 'e2f', e2f )
+      
+      CALL iom_close( inum )
+      
+    END SUBROUTINE hgr_read
+    
+   !!======================================================================
+END MODULE domhgr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90	(revision 3437)
@@ -0,0 +1,645 @@
+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 and sup-
+   !!                 !                      pression of the double computation of bmask
+   !!            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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_msk        : compute land/ocean mask
+   !!   dom_msk_nsa    : update land/ocean mask when no-slip accurate option is used.
+   !!----------------------------------------------------------------------
+   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 dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_msk         ! routine called by inidom.F90
+   PUBLIC   dom_msk_alloc   ! routine called by nemogcm.F90
+
+   !                            !!* Namelist namlbc : lateral boundary condition *
+   REAL(wp)        :: rn_shlat   = 2.   ! type of lateral boundary condition on velocity
+   LOGICAL, PUBLIC :: ln_vorlat  = .false.   !  consistency of vorticity boundary condition 
+   !                                            with analytical eqs.
+
+
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  icoord ! Workspace for dom_msk_nsa()
+
+   !! * 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
+   
+   INTEGER FUNCTION dom_msk_alloc()
+      !!---------------------------------------------------------------------
+      !!                 ***  FUNCTION dom_msk_alloc  ***
+      !!---------------------------------------------------------------------
+      dom_msk_alloc = 0
+#if defined key_noslip_accurate
+      ALLOCATE(icoord(jpi*jpj*jpk,3), STAT=dom_msk_alloc)
+#endif
+      IF( dom_msk_alloc /= 0 )   CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array')
+      !
+   END FUNCTION dom_msk_alloc
+
+
+   SUBROUTINE dom_msk
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk  ***
+      !!
+      !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori-
+      !!      zontal velocity points (u & v), vorticity points (f) and baro-
+      !!      tropic stream function  points (b).
+      !!
+      !! ** 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.
+      !!      b-point : the same definition as for f-point of the first ocean
+      !!                level (surface level) but with 0 along coastlines.
+      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated
+      !!                rows/lines due to cyclic or North Fold boundaries as well
+      !!                as MPP halos.
+      !!
+      !!        The lateral friction is set through the value of fmask along
+      !!      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,
+      !!      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_obc=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.)
+      !!                          =rn_shlat along lateral boundaries
+      !!               bmask    : land/ocean mask at barotropic stream
+      !!                          function point (=0. or 1.) and set to 0 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 , 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 )              ! Namelist namlbc : lateral momentum boundary condition
+      READ  ( numnam, 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  
+
+!!gm  ????
+#if defined key_zdfkpp
+      IF( cp_cfg == 'orca' ) THEN
+         IF( jp_cfg == 2 )   THEN       ! land point on Bab el Mandeb zonal section
+            ij0 =  87   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 161
+            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp
+         ELSE
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,cform_war)
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*)'          A mask must be applied on Bab el Mandeb strait'
+            IF(lwp) WRITE(numout,*)'          in case of ORCAs configurations'
+            IF(lwp) WRITE(numout,*)'          This is a problem which is not yet solved'
+            IF(lwp) WRITE(numout,*)
+         ENDIF
+      ENDIF
+#endif
+!!gm end
+
+      ! Interior domain mask (used for global sum)
+      ! --------------------
+      tmask_i(:,:) = tmask(:,:,1)
+      iif = jpreci                         ! ???
+      iil = nlci - jpreci + 1
+      ijf = jprecj                         ! ???
+      ijl = nlcj - jprecj + 1
+
+      tmask_i( 1 :iif,   :   ) = 0._wp      ! first columns
+      tmask_i(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns)
+      tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows
+      tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows)
+
+      ! north fold mask
+      ! ---------------
+      tpol(1:jpiglo) = 1._wp 
+      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_i(ji,nlej-1) = tmask_i(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
+
+      ! 2. Ocean/land mask at u-,  v-, and z-points (computed from tmask)
+      ! -------------------------------------------
+      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 )
+
+
+      ! 4. ocean/land mask for the elliptic equation
+      ! --------------------------------------------
+      bmask(:,:) = tmask(:,:,1)       ! elliptic equation is written at t-point
+      !
+      !                               ! Boundary conditions
+      !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+         bmask( 1 ,:) = 0._wp
+         bmask(jpi,:) = 0._wp
+      ENDIF
+      IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1
+         bmask(:, 1 ) = 0._wp
+      ENDIF
+      !                                    ! north fold : 
+      IF( nperio == 3 .OR. nperio == 4 ) THEN   ! T-pt pivot : bmask set to 0. on row jpj and on half jpjglo-1 row
+         DO ji = 1, jpi                      
+            ii = ji + nimpp - 1
+            bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii)
+            bmask(ji,jpj  ) = 0._wp
+         END DO
+      ENDIF
+      IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
+         bmask(:,jpj) = 0._wp
+      ENDIF
+      !
+      IF( lk_mpp ) THEN                    ! mpp specificities
+         !                                      ! bmask is set to zero on the overlap region
+         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp
+         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp
+         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp
+         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp
+         !
+         IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj
+            DO ji = 1, nlci
+               ii = ji + nimpp - 1
+               bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii)
+               bmask(ji,nlcj  ) = 0._wp
+            END DO
+         ENDIF
+         IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj
+            DO ji = 1, nlci
+               bmask(ji,nlcj  ) = 0._wp
+            END DO
+         ENDIF
+      ENDIF
+
+
+      ! mask for second order calculation of vorticity
+      ! ----------------------------------------------
+      CALL dom_msk_nsa
+
+      
+      ! Lateral boundary conditions on velocity (modify fmask)
+      ! ---------------------------------------     
+      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
+      !
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration
+         !                                                 ! Increased lateral friction near of some straits
+         IF( nn_cla == 0 ) THEN
+            !                                ! Gibraltar strait  : partial slip (fmask=0.5)
+            ij0 = 101   ;   ij1 = 101
+            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.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
+            !
+         ENDIF
+         !                                ! Danish straits  : strong slip (fmask > 2)
+! We keep this as an example but it is instable in this case 
+!         ij0 = 115   ;   ij1 = 115
+!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._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
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : '
+         IF(lwp) WRITE(numout,*) '      Gibraltar '
+         ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait 
+         ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Bhosporus '
+         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait 
+         ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Makassar (Top) '
+         ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top) 
+         ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  3._wp  
+
+         IF(lwp) WRITE(numout,*) '      Lombok '
+         ii0 =  44   ;   ii1 =  44        ! Lombok Strait 
+         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Ombai '
+         ii0 =  53   ;   ii1 =  53        ! Ombai Strait 
+         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      Timor Passage '
+         ii0 =  56   ;   ii1 =  56        ! Timor Passage 
+         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp  
+
+         IF(lwp) WRITE(numout,*) '      West Halmahera '
+         ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait 
+         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp  
+
+         IF(lwp) WRITE(numout,*) '      East Halmahera '
+         ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait 
+         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp  
+         !
+      ENDIF
+      !
+      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask
+
+      ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 )
+            
+      IF( nprint == 1 .AND. lwp ) THEN      ! Control print
+         imsk(:,:) = INT( tmask_i(:,:) )
+         WRITE(numout,*) ' tmask_i : '
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                           1, jpj, 1, 1, numout)
+         WRITE (numout,*)
+         WRITE (numout,*) ' dommsk: tmask for each level'
+         WRITE (numout,*) ' ----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( tmask(:,:,jk) )
+
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: vmask for each level'
+         WRITE(numout,*) ' -----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( vmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: fmask for each level'
+         WRITE(numout,*) ' -----------------------------'
+         DO jk = 1, jpk
+            imsk(:,:) = INT( fmask(:,:,jk) )
+            WRITE(numout,*)
+            WRITE(numout,*) ' level = ',jk
+            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+               &                              1, jpj, 1, 1, numout )
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) ' dom_msk: bmask '
+         WRITE(numout,*) ' ---------------'
+         WRITE(numout,*)
+         imsk(:,:) = INT( bmask(:,:) )
+         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   &
+            &                              1, jpj, 1, 1, numout )
+      ENDIF
+      !
+      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
+
+#if defined key_noslip_accurate
+   !!----------------------------------------------------------------------
+   !!   'key_noslip_accurate' :         accurate no-slip boundary condition
+   !!----------------------------------------------------------------------
+   
+   SUBROUTINE dom_msk_nsa
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE dom_msk_nsa  ***
+      !! 
+      !! ** Purpose :
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action :
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk, jl      ! dummy loop indices
+      INTEGER  ::   ine, inw, ins, inn, itest, ierror, iind, ijnd
+      REAL(wp) ::   zaa
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_msk_nsa')
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme'
+      IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' )
+
+      ! mask for second order calculation of vorticity
+      ! ----------------------------------------------
+      ! noslip boundary condition: fmask=1  at convex corner, store
+      ! index of straight coast meshes ( 'west', refering to a coast,
+      ! means west of the ocean, aso)
+      
+      DO jk = 1, jpk
+         DO jl = 1, 4
+            npcoa(jl,jk) = 0
+            DO ji = 1, 2*(jpi+jpj)
+               nicoa(ji,jl,jk) = 0
+               njcoa(ji,jl,jk) = 0
+            END DO
+         END DO
+      END DO
+      
+      IF( jperio == 2 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' symetric boundary conditions need special'
+         WRITE(numout,*) ' treatment not implemented. we stop.'
+         STOP
+      ENDIF
+      
+      ! convex corners
+      
+      DO jk = 1, jpkm1
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                  &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-3._wp) <= 0.1_wp )   fmask(ji,jj,jk) = 1._wp
+            END DO
+         END DO
+      END DO
+
+      ! north-south straight coast
+
+      DO jk = 1, jpkm1
+         inw = 0
+         ine = 0
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
+                  inw = inw + 1
+                  nicoa(inw,1,jk) = ji
+                  njcoa(inw,1,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' west  : ', jk, inw, ji, jj
+               ENDIF
+               zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk)
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
+                  ine = ine + 1
+                  nicoa(ine,2,jk) = ji
+                  njcoa(ine,2,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' east  : ', jk, ine, ji, jj
+               ENDIF
+            END DO
+         END DO
+         npcoa(1,jk) = inw
+         npcoa(2,jk) = ine
+      END DO
+
+      ! west-east straight coast
+
+      DO jk = 1, jpkm1
+         ins = 0
+         inn = 0
+         DO jj = 2, jpjm1
+            DO ji =2, jpim1
+               zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk)
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
+                  ins = ins + 1
+                  nicoa(ins,3,jk) = ji
+                  njcoa(ins,3,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' south : ', jk, ins, ji, jj
+               ENDIF
+               zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk)
+               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN
+                  inn = inn + 1
+                  nicoa(inn,4,jk) = ji
+                  njcoa(inn,4,jk) = jj
+                  IF( nprint == 1 ) WRITE(numout,*) ' north : ', jk, inn, ji, jj
+               ENDIF
+            END DO
+         END DO
+         npcoa(3,jk) = ins
+         npcoa(4,jk) = inn
+      END DO
+
+      itest = 2 * ( jpi + jpj )
+      DO jk = 1, jpk
+         IF( npcoa(1,jk) > itest .OR. npcoa(2,jk) > itest .OR.   &
+             npcoa(3,jk) > itest .OR. npcoa(4,jk) > itest ) THEN
+            
+            WRITE(ctmp1,*) ' level jk = ',jk
+            WRITE(ctmp2,*) ' straight coast index arraies are too small.:'
+            WRITE(ctmp3,*) ' npe, npw, nps, npn = ', npcoa(1,jk), npcoa(2,jk),   &
+                &                                     npcoa(3,jk), npcoa(4,jk)
+            WRITE(ctmp4,*) ' 2*(jpi+jpj) = ',itest,'. we stop.'
+            CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4 )
+        ENDIF
+      END DO
+
+      ierror = 0
+      iind = 0
+      ijnd = 0
+      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 )   iind = 2
+      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   ijnd = 2
+      DO jk = 1, jpk
+         DO jl = 1, npcoa(1,jk)
+            IF( nicoa(jl,1,jk)+3 > jpi+iind ) THEN
+               ierror = ierror+1
+               icoord(ierror,1) = nicoa(jl,1,jk)
+               icoord(ierror,2) = njcoa(jl,1,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl = 1, npcoa(2,jk)
+            IF(nicoa(jl,2,jk)-2 < 1-iind ) THEN
+               ierror = ierror + 1
+               icoord(ierror,1) = nicoa(jl,2,jk)
+               icoord(ierror,2) = njcoa(jl,2,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl = 1, npcoa(3,jk)
+            IF( njcoa(jl,3,jk)+3 > jpj+ijnd ) THEN
+               ierror = ierror + 1
+               icoord(ierror,1) = nicoa(jl,3,jk)
+               icoord(ierror,2) = njcoa(jl,3,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+         DO jl = 1, npcoa(4,jk)
+            IF( njcoa(jl,4,jk)-2 < 1) THEN
+               ierror=ierror + 1
+               icoord(ierror,1) = nicoa(jl,4,jk)
+               icoord(ierror,2) = njcoa(jl,4,jk)
+               icoord(ierror,3) = jk
+            ENDIF
+         END DO
+      END DO
+      
+      IF( ierror > 0 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '              Problem on lateral conditions'
+         IF(lwp) WRITE(numout,*) '                 Bad marking off at points:'
+         DO jl = 1, ierror
+            IF(lwp) WRITE(numout,*) 'Level:',icoord(jl,3),   &
+               &                  '  Point(',icoord(jl,1),',',icoord(jl,2),')'
+         END DO
+         CALL ctl_stop( 'We stop...' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_msk_nsa')
+      !
+   END SUBROUTINE dom_msk_nsa
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                      Empty routine
+   !!----------------------------------------------------------------------
+   SUBROUTINE dom_msk_nsa       
+   END SUBROUTINE dom_msk_nsa
+#endif
+   
+   !!======================================================================
+END MODULE dommsk
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90	(revision 3437)
@@ -0,0 +1,85 @@
+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 )
+      !!----------------------------------------------------------------------
+      !!                    ***  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
+      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
+      !
+      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
+      SELECT CASE( cdgrid )
+      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
+      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
+      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
+      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90	(revision 3437)
@@ -0,0 +1,111 @@
+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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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:
+      !!      nacc = 0 : synchronous time intergration. 
+      !!      There is one time step only, defined by: rdt, rdttra(k)=rdt
+      !!      nacc = 1 : accelerating the convergence. There is 2 different
+      !!      time steps for dynamics and tracers:
+      !!        rdt      : dynamical part
+      !!        rdttra(k): temperature and salinity
+      !!      The tracer time step is a function of vertical level. the model
+      !!      reference time step ( i.e. for wind stress, surface heat and
+      !!      salt fluxes) is the surface tracer time step is rdttra(1).
+      !!         N.B. depth dependent acceleration of convergence is not im-
+      !!      plemented for s-coordinate.
+      !!
+      !! ** Action  : - 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
+
+      SELECT CASE ( nacc )
+
+         CASE ( 0 )                ! Synchronous time stepping
+            IF(lwp) WRITE(numout,*)'               synchronous time stepping'
+            IF(lwp) WRITE(numout,*)'               dynamics and tracer time step = ', rdt/3600., ' hours'
+
+            rdttra(:) = rdt
+
+         CASE ( 1 )                ! Accelerating the convergence
+            IF(lwp) WRITE(numout,*) '              no tracer damping in the turbocline'
+            IF(lwp) WRITE(numout,*)'               accelerating the convergence'
+            IF(lwp) WRITE(numout,*)'               dynamics time step = ', rdt/3600., ' hours'
+            IF( ln_sco .AND. rdtmin /= rdtmax .AND. lk_vvl )   &
+                 & CALL ctl_stop ( ' depth dependent acceleration of convergence not implemented in s-coordinates &
+                 &                   nor in variable volume' )
+            IF(lwp) WRITE(numout,*)'         tracers   time step :  dt (hours)  level'
+
+            DO jk = 1, jpk
+               IF( gdept_0(jk) <= rdth ) rdttra(jk) = rdtmin
+               IF( gdept_0(jk) >  rdth ) THEN
+                  rdttra(jk) = rdtmin + ( rdtmax - rdtmin )   &
+                                      * ( EXP( ( gdept_0(jk ) - rdth ) / rdth ) - 1. )   &
+                                      / ( EXP( ( gdept_0(jpk) - rdth ) / rdth ) - 1. )
+               ENDIF
+               IF(lwp) WRITE(numout,"(36x,f5.2,5x,i3)") rdttra(jk)/3600., jk
+            END DO  
+
+         CASE DEFAULT              ! E R R O R 
+
+            WRITE(ctmp1,*) ' nacc value e r r o r, nacc= ',nacc
+            CALL ctl_stop( ctmp1 )
+
+      END SELECT
+
+   END SUBROUTINE dom_stp
+
+   !!======================================================================
+END MODULE domstp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90	(revision 3437)
@@ -0,0 +1,482 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_vvl
+   !!----------------------------------------------------------------------
+   !!   'key_vvl'                              variable volume
+   !!----------------------------------------------------------------------
+   !!   dom_vvl     : defined coefficients to distribute ssh on each layers
+   !!----------------------------------------------------------------------
+   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 wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_vvl         ! called by domain.F90
+   PUBLIC   dom_vvl_2       ! called by domain.F90
+   PUBLIC   dom_vvl_alloc   ! called by nemogcm.F90
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mut , muu , muv , muf    !: 1/H_0 at t-,u-,v-,f-points 
+
+   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:)     ::   r2dt   ! vertical profile time-step, = 2 rdttra 
+      !                                                              ! except at nit000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS       
+
+   INTEGER FUNCTION dom_vvl_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_alloc  ***
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) ,     &
+         &      r2dt        (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')
+      !
+   END FUNCTION dom_vvl_alloc
+
+
+   SUBROUTINE dom_vvl
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl  ***
+      !!                   
+      !! ** Purpose :   compute mu coefficients at t-, u-, v- and f-points to 
+      !!              spread ssh over the whole water column (scale factors)
+      !!                set the before and now ssh at u- and v-points 
+      !!              (also f-point in now case)
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zcoefu, zcoefv , zcoeff                ! local scalars
+      REAL(wp) ::   zvt   , zvt_ip1, zvt_jp1, zvt_ip1jp1   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zee_t, zee_u, zee_v, zee_f   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_vvl')
+      !
+      CALL wrk_alloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f )
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_vvl : Variable volume initialization'
+         WRITE(numout,*) '~~~~~~~~  compute coef. used to spread ssh over each layers'
+      ENDIF
+      
+      IF( dom_vvl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dom_vvl : unable to allocate arrays' )
+
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
+
+      !                                 !==  mu computation  ==!
+      zee_t(:,:) = fse3t_0(:,:,1)                ! Lower bound : thickness of the first model level
+      zee_u(:,:) = fse3u_0(:,:,1)
+      zee_v(:,:) = fse3v_0(:,:,1)
+      zee_f(:,:) = fse3f_0(:,:,1)
+      DO jk = 2, jpkm1                          ! Sum of the masked vertical scale factors
+         zee_t(:,:) = zee_t(:,:) + fse3t_0(:,:,jk) * tmask(:,:,jk)
+         zee_u(:,:) = zee_u(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
+         zee_v(:,:) = zee_v(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
+         DO jj = 1, jpjm1                      ! f-point : fmask=shlat at coasts, use the product of umask
+            zee_f(:,jj) = zee_f(:,jj) + fse3f_0(:,jj,jk) *  umask(:,jj,jk) * umask(:,jj+1,jk)
+         END DO
+      END DO  
+      !                                         ! Compute and mask the inverse of the local depth at T, U, V and F points
+      zee_t(:,:) = 1._wp / zee_t(:,:) * tmask(:,:,1)
+      zee_u(:,:) = 1._wp / zee_u(:,:) * umask(:,:,1)
+      zee_v(:,:) = 1._wp / zee_v(:,:) * vmask(:,:,1)
+      DO jj = 1, jpjm1                               ! f-point case fmask cannot be used 
+         zee_f(:,jj) = 1._wp / zee_f(:,jj) * umask(:,jj,1) * umask(:,jj+1,1)
+      END DO
+      CALL lbc_lnk( zee_f, 'F', 1. )                 ! lateral boundary condition on ee_f
+      !
+      DO jk = 1, jpk                            ! mu coefficients
+         mut(:,:,jk) = zee_t(:,:) * tmask(:,:,jk)     ! T-point at T levels
+         muu(:,:,jk) = zee_u(:,:) * umask(:,:,jk)     ! U-point at T levels
+         muv(:,:,jk) = zee_v(:,:) * vmask(:,:,jk)     ! V-point at T levels
+      END DO
+      DO jk = 1, jpk                                 ! F-point : fmask=shlat at coasts, use the product of umask
+         DO jj = 1, jpjm1
+               muf(:,jj,jk) = zee_f(:,jj) * umask(:,jj,jk) * umask(:,jj+1,jk)   ! at T levels
+         END DO
+         muf(:,jpj,jk) = 0._wp
+      END DO
+      CALL lbc_lnk( muf, 'F', 1. )                   ! lateral boundary condition
+
+
+      hu_0(:,:) = 0.e0                          ! Reference ocean depth at U- and V-points
+      hv_0(:,:) = 0.e0
+      DO jk = 1, jpk
+         hu_0(:,:) = hu_0(:,:) + fse3u_0(:,:,jk) * umask(:,:,jk)
+         hv_0(:,:) = hv_0(:,:) + fse3v_0(:,:,jk) * vmask(:,:,jk)
+      END DO
+      
+      DO jj = 1, jpjm1                          ! initialise before and now Sea Surface Height at u-, v-, f-points
+         DO ji = 1, jpim1   ! NO vector opt.
+            zcoefu = 0.50_wp / ( e1u(ji,jj) * e2u(ji,jj) ) * umask(ji,jj,1)
+            zcoefv = 0.50_wp / ( e1v(ji,jj) * e2v(ji,jj) ) * vmask(ji,jj,1)
+            zcoeff = 0.25_wp / ( e1f(ji,jj) * e2f(ji,jj) ) * umask(ji,jj,1) * umask(ji,jj+1,1)
+            !
+            zvt           = e1e2t(ji  ,jj  ) * sshb(ji  ,jj  )    ! before fields
+            zvt_ip1       = e1e2t(ji+1,jj  ) * sshb(ji+1,jj  )
+            zvt_jp1       = e1e2t(ji  ,jj+1) * sshb(ji  ,jj+1)
+            sshu_b(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
+            sshv_b(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
+            !
+            zvt           = e1e2t(ji  ,jj  ) * sshn(ji  ,jj  )    ! now fields
+            zvt_ip1       = e1e2t(ji+1,jj  ) * sshn(ji+1,jj  )
+            zvt_jp1       = e1e2t(ji  ,jj+1) * sshn(ji  ,jj+1)
+            zvt_ip1jp1    = e1e2t(ji+1,jj+1) * sshn(ji+1,jj+1)
+            sshu_n(ji,jj) = zcoefu * ( zvt + zvt_ip1 )
+            sshv_n(ji,jj) = zcoefv * ( zvt + zvt_jp1 )
+            sshf_n(ji,jj) = zcoeff * ( zvt + zvt_ip1 + zvt_jp1 + zvt_ip1jp1 )
+         END DO
+      END DO
+      CALL lbc_lnk( sshu_n, 'U', 1. )   ;   CALL lbc_lnk( sshu_b, 'U', 1. )      ! lateral boundary conditions
+      CALL lbc_lnk( sshv_n, 'V', 1. )   ;   CALL lbc_lnk( sshv_b, 'V', 1. )
+      CALL lbc_lnk( sshf_n, 'F', 1. )
+      !
+      CALL wrk_dealloc( jpi, jpj, zee_t, zee_u, zee_v, zee_f )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl')
+      !
+   END SUBROUTINE dom_vvl
+
+
+   SUBROUTINE dom_vvl_2( kt, pe3u_b, pe3v_b )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_vvl_2  ***
+      !!                   
+      !! ** Purpose :   compute the vertical scale factors at u- and v-points
+      !!              in variable volume case.
+      !!
+      !! ** Method  :   In variable volume case (non linear sea surface) the 
+      !!              the vertical scale factor at velocity points is computed
+      !!              as the average of the cell surface weighted e3t.
+      !!                It uses the sea surface heigth so it have to be initialized
+      !!              after ssh is read/set
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in   ) ::   kt               ! ocean time-step index
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pe3u_b, pe3v_b   ! before vertical scale factor at u- & v-pts
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   iku, ikv     ! local integers    
+      INTEGER  ::   ii0, ii1, ij0, ij1   ! temporary integers
+      REAL(wp) ::   zvt          ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_vvl_2')
+      !
+      IF( lwp .AND. kt == nit000 ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_vvl_2 : Variable volume, fse3t_b initialization'
+         WRITE(numout,*) '~~~~~~~~~ '
+         pe3u_b(:,:,jpk) = fse3u_0(:,:,jpk)
+         pe3v_b(:,:,jpk) = fse3u_0(:,:,jpk)
+      ENDIF
+      
+      DO jk = 1, jpkm1           ! set the before scale factors at u- & v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               zvt = fse3t_b(ji,jj,jk) * e1e2t(ji,jj)
+               pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1e2t(ji+1,jj) ) / ( e1u(ji,jj) * e2u(ji,jj) )
+               pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e1e2t(ji,jj+1) ) / ( e1v(ji,jj) * e2v(ji,jj) )
+            END DO
+         END DO
+      END DO
+
+      ! Correct scale factors at locations that have been individually modified in domhgr
+      ! Such modifications break the relationship between e1e2t and e1u*e2u etc. Recompute
+      ! scale factors ignoring the modified metric.
+      !                                                ! =====================
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+         !                                             ! =====================
+         IF( nn_cla == 0 ) THEN
+            !
+            ii0 = 139   ;   ii1 = 140        ! Gibraltar Strait (e2u was modified)
+            ij0 = 102   ;   ij1 = 102   
+            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+                  END DO
+               END DO
+            END DO
+            !
+            ii0 = 160   ;   ii1 = 160        ! Bab el Mandeb (e2u and e1v were modified)
+            ij0 =  88   ;   ij1 =  88   
+            DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                     pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+                  END DO
+               END DO
+            END DO
+            DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                     pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         ii0 = 145   ;   ii1 = 146        ! Danish Straits (e2u was modified)
+         ij0 = 116   ;   ij1 = 116   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+         !                                             ! =====================
+      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN    ! ORCA R1 configuration
+         !                                             ! =====================
+
+         ii0 = 281   ;   ii1 = 282        ! Gibraltar Strait (e2u was modified)
+         ij0 = 200   ;   ij1 = 200   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait (e2u was modified)
+         ij0 = 208   ;   ij1 = 208   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  44   ;   ii1 =  44        ! Lombok Strait (e1v was modified)
+         ij0 = 124   ;   ij1 = 125   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  48   ;   ii1 =  48        ! Sumba Strait (e1v was modified) [closed from bathy_11 on]
+         ij0 = 124   ;   ij1 = 125   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  53   ;   ii1 =  53        ! Ombai Strait (e1v was modified)
+         ij0 = 124   ;   ij1 = 125   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  56   ;   ii1 =  56        ! Timor Passage (e1v was modified)
+         ij0 = 124   ;   ij1 = 125   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  55   ;   ii1 =  55        ! West Halmahera Strait (e1v was modified)
+         ij0 = 141   ;   ij1 = 142   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         ii0 =  58   ;   ii1 =  58        ! East Halmahera Strait (e1v was modified)
+         ij0 = 141   ;   ij1 = 142   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+
+         !
+      ENDIF
+      !                                                ! ======================
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
+         !                                             ! ======================
+         ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u was modified)
+         ij0 = 327   ;   ij1 = 327   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 = 627   ;   ii1 = 628        ! Bosphore Strait (e2u was modified)
+         ij0 = 343   ;   ij1 = 343   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 =  93   ;   ii1 =  94        ! Sumba Strait (e2u was modified)
+         ij0 = 232   ;   ij1 = 232   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 = 103   ;   ii1 = 103        ! Ombai Strait (e2u was modified)
+         ij0 = 232   ;   ij1 = 232   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 =  15   ;   ii1 =  15        ! Palk Strait (e2u was modified)
+         ij0 = 270   ;   ij1 = 270   
+         DO jk = 1, jpkm1                 ! set the before scale factors at u-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e1t(ji,jj)
+                  pe3u_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji+1,jj,jk) * e1t(ji+1,jj) ) / ( e1u(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 =  87   ;   ii1 =  87        ! Lombok Strait (e1v was modified)
+         ij0 = 232   ;   ij1 = 233   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+         ii0 = 662   ;   ii1 = 662        ! Bab el Mandeb (e1v was modified)
+         ij0 = 276   ;   ij1 = 276   
+         DO jk = 1, jpkm1                 ! set the before scale factors at v-points
+            DO jj = mj0(ij0), mj1(ij1)
+               DO ji = mi0(ii0), mi1(ii1)
+                  zvt = fse3t_b(ji,jj,jk) * e2t(ji,jj)
+                  pe3v_b(ji,jj,jk) = 0.5_wp * ( zvt + fse3t_b(ji,jj+1,jk) * e2t(ji,jj+1) ) / ( e2v(ji,jj) )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      ! End of individual corrections to scale factors
+
+      IF( ln_zps ) THEN          ! minimum of the e3t at partial cell level
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               pe3u_b(ji,jj,iku) = MIN( fse3t_b(ji,jj,iku), fse3t_b(ji+1,jj  ,iku) ) 
+               pe3v_b(ji,jj,ikv) = MIN( fse3t_b(ji,jj,ikv), fse3t_b(ji  ,jj+1,ikv) ) 
+            END DO
+         END DO
+      ENDIF
+
+      pe3u_b(:,:,:) = pe3u_b(:,:,:) - fse3u_0(:,:,:)      ! anomaly to avoid zero along closed boundary/extra halos
+      pe3v_b(:,:,:) = pe3v_b(:,:,:) - fse3v_0(:,:,:)
+      CALL lbc_lnk( pe3u_b(:,:,:), 'U', 1. )               ! lateral boundary conditions
+      CALL lbc_lnk( pe3v_b(:,:,:), 'V', 1. )
+      pe3u_b(:,:,:) = pe3u_b(:,:,:) + fse3u_0(:,:,:)      ! recover the full scale factor
+      pe3v_b(:,:,:) = pe3v_b(:,:,:) + fse3v_0(:,:,:)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_2')
+      !
+   END SUBROUTINE dom_vvl_2
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                      Empty routine
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dom_vvl
+   END SUBROUTINE dom_vvl
+   SUBROUTINE dom_vvl_2(kdum, pudum, pvdum )
+      USE par_kind
+      INTEGER                   , INTENT(in   ) ::   kdum       
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pudum, pvdum
+   END SUBROUTINE dom_vvl_2
+#endif
+
+   !!======================================================================
+END MODULE domvvl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90	(revision 3437)
@@ -0,0 +1,317 @@
+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  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dom_wri        : create and write mesh and mask file(s)
+   !!   dom_uniq       :
+   !!----------------------------------------------------------------------
+   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
+
+   !! * 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 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' )
+      zprt = tmask(:,:,1) * zprw                               !    ! unique point mask
+      CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'U' )
+      zprt = umask(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'V' )
+      zprt = vmask(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )  
+      CALL dom_uniq( zprw, 'F' )
+      zprt = fmask(:,:,1) * zprw
+      CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )  
+
+      !                                                         ! horizontal mesh (inum3)
+      CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r4 )     !    ! latitude
+      CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r4 )
+      
+      CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r4 )     !    ! longitude
+      CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r4 )
+      CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r4 )
+      
+      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', ff, ktype = jp_r8 )           !    ! coriolis factor
+      
+      ! note that mbkt is set to 1 over land ==> use surface tmask
+      zprt(:,:) = tmask(:,:,1) * REAL( mbkt(:,:) , wp )
+      CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 )     !    ! nb of ocean T-points
+            
+      IF( ln_sco ) THEN                                         ! s-coordinate
+         CALL iom_rstput( 0, 0, inum4, 'hbatt', hbatt )         !    ! depth
+         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', e3t )             !    ! scale factors
+         CALL iom_rstput( 0, 0, inum4, 'e3u', e3u )
+         CALL iom_rstput( 0, 0, inum4, 'e3v', e3v )
+         CALL iom_rstput( 0, 0, inum4, 'e3w', e3w )
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0' , gdept_0 )    !    ! stretched system
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0' , gdepw_0 )
+      ENDIF
+      
+      IF( ln_zps ) THEN                                         ! z-coordinate - partial steps
+         !
+         IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors
+            CALL iom_rstput( 0, 0, inum4, 'e3t', e3t )         
+            CALL iom_rstput( 0, 0, inum4, 'e3u', e3u )
+            CALL iom_rstput( 0, 0, inum4, 'e3v', e3v )
+            CALL iom_rstput( 0, 0, inum4, 'e3w', e3w )
+         ELSE                                                   !    ! 2D masked bottom ocean scale factors
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  e3tp(ji,jj) = e3t(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)
+                  e3wp(ji,jj) = e3w(ji,jj,mbkt(ji,jj)) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )      
+            CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp )
+         END IF
+         !
+         IF( nmsh <= 3 ) THEN                                   !    ! 3D depth
+            CALL iom_rstput( 0, 0, inum4, 'gdept', gdept, ktype = jp_r4 )     
+            DO jk = 1,jpk   
+               DO jj = 1, jpjm1   
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zdepu(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji+1,jj  ,jk) )
+                     zdepv(ji,jj,jk) = MIN( gdept(ji,jj,jk) , gdept(ji  ,jj+1,jk) )
+                  END DO   
+               END DO   
+            END DO
+            CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL 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, ktype = jp_r4 )
+         ELSE                                                   !    ! 2D bottom depth
+            DO jj = 1,jpj   
+               DO ji = 1,jpi
+                  zprt(ji,jj) = gdept(ji,jj,mbkt(ji,jj)  ) * tmask(ji,jj,1)
+                  zprw(ji,jj) = gdepw(ji,jj,mbkt(ji,jj)+1) * tmask(ji,jj,1)
+               END DO
+            END DO
+            CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 )     
+            CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 
+         ENDIF
+         !
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! reference z-coord.
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )
+         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+      ENDIF
+      
+      IF( ln_zco ) THEN
+         !                                                      ! z-coordinate - full steps
+         CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0 )     !    ! depth
+         CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0 )
+         CALL iom_rstput( 0, 0, inum4, 'e3t_0'  , e3t_0   )     !    ! scale factors
+         CALL iom_rstput( 0, 0, inum4, 'e3w_0'  , e3w_0   )
+      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
+
+   !!======================================================================
+END MODULE domwri
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90	(revision 3437)
@@ -0,0 +1,1602 @@
+MODULE domzgr
+   !!==============================================================================
+   !!                       ***  MODULE domzgr   ***
+   !! Ocean initialization : domain initialization
+   !!==============================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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        : sigma coordinate non-dimensional function
+   !!       dfssig       : derivative of the sigma coordinate function    !!gm  (currently missing!)
+   !!---------------------------------------------------------------------
+   USE oce               ! ocean variables
+   USE dom_oce           ! ocean domain
+   USE closea            ! closed seas
+   USE c1d               ! 1D vertical configuration
+   USE in_out_manager    ! I/O manager
+   USE iom               ! I/O library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dom_zgr        ! called by dom_init.F90
+
+   !                                       !!* Namelist namzgr_sco *
+   REAL(wp) ::   rn_sbot_min =  300._wp     ! minimum depth of s-bottom surface (>0) (m)
+   REAL(wp) ::   rn_sbot_max = 5250._wp     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m)
+   REAL(wp) ::   rn_theta    =    6.00_wp   ! surface control parameter (0<=rn_theta<=20)
+   REAL(wp) ::   rn_thetb    =    0.75_wp   ! bottom control parameter  (0<=rn_thetb<= 1)
+   REAL(wp) ::   rn_rmax     =    0.15_wp   ! maximum cut-off r-value allowed (0<rn_rmax<1)
+   LOGICAL  ::   ln_s_sigma  = .false.      ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T)
+   REAL(wp) ::   rn_bb       =    0.80_wp   ! stretching parameter for song and haidvogel stretching
+   !                                        ! ( rn_bb=0; top only, rn_bb =1; top and bottom)
+   REAL(wp) ::   rn_hc       =  150._wp     ! Critical depth for s-sigma coordinates
+
+  !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE dom_zgr  ***
+      !!                   
+      !! ** Purpose :  set the depth of model levels and the resulting 
+      !!      vertical scale factors.
+      !!
+      !! ** Method  : - reference 1D vertical coordinate (gdep._0, e3._0)
+      !!              - read/set ocean depth and ocean levels (bathy, mbathy)
+      !!              - vertical coordinate (gdep., e3.) depending on the 
+      !!                coordinate chosen :
+      !!                   ln_zco=T   z-coordinate   
+      !!                   ln_zps=T   z-coordinate with partial steps
+      !!                   ln_zco=T   s-coordinate 
+      !!
+      !! ** Action  :   define gdep., e3., mbathy and bathy
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio = 0   ! temporary integer
+      !
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dom_zgr')
+      !
+      REWIND( numnam )                 ! Read Namelist namzgr : vertical coordinate'
+      READ  ( numnam, namzgr )
+
+      IF(lwp) THEN                     ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr : vertical coordinate'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate'
+         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco
+         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps
+         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco = ', ln_sco
+      ENDIF
+
+      ioptio = 0                       ! Check Vertical coordinate options
+      IF( ln_zco ) ioptio = ioptio + 1
+      IF( ln_zps ) ioptio = ioptio + 1
+      IF( ln_sco ) ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( ' none or several vertical coordinate options used' )
+      !
+      ! Build the vertical coordinate system
+      ! ------------------------------------
+                          CALL zgr_z            ! Reference z-coordinate system (always called)
+                          CALL zgr_bat          ! Bathymetry fields (levels and meters)
+      IF( ln_zco      )   CALL zgr_zco          ! z-coordinate
+      IF( ln_zps      )   CALL zgr_zps          ! Partial step z-coordinate
+      IF( ln_sco      )   CALL zgr_sco          ! s-coordinate or hybrid z-s coordinate
+      !
+      ! final adjustment of mbathy & check 
+      ! -----------------------------------
+      IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain
+      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points
+                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points
+      !
+      !
+
+      IF( nprint == 1 .AND. lwp )   THEN
+         WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) )
+         WRITE(numout,*) ' MIN val depth t ', MINVAL( fsdept(:,:,:) ),   &
+            &                   ' w ',   MINVAL( fsdepw(:,:,:) ), '3w ', MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t(:,:,:) ), ' f ', MINVAL( fse3f(:,:,:) ),  &
+            &                   ' u ',   MINVAL( fse3u(:,:,:) ), ' u ', MINVAL( fse3v(:,:,:) ),  &
+            &                   ' uw',   MINVAL( fse3uw(:,:,:)), ' vw', MINVAL( fse3vw(:,:,:)),   &
+            &                   ' w ',   MINVAL( fse3w(:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                   ' w ',   MAXVAL( fsdepw(:,:,:) ), '3w ', MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t(:,:,:) ), ' f ', MAXVAL( fse3f(:,:,:) ),  &
+            &                   ' u ',   MAXVAL( fse3u(:,:,:) ), ' u ', MAXVAL( fse3v(:,:,:) ),  &
+            &                   ' uw',   MAXVAL( fse3uw(:,:,:)), ' vw', MAXVAL( fse3vw(:,:,:)),   &
+            &                   ' w ',   MAXVAL( fse3w(:,:,:) )
+      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_0  = fsdep(k)
+      !!                       e3w_0(k) = dk(fsdep)(k)     = fse3(k)
+      !!              t-level: gdept_0  = fsdep(k+0.5)
+      !!                       e3t_0(k) = dk(fsdep)(k+0.5) = fse3(k+0.5)
+      !!
+      !! ** Action  : - gdept_0, gdepw_0 : depth of T- and W-point (m)
+      !!              - e3t_0  , e3w_0   : 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_0(jk) = ( zw - 1 ) * za1
+            gdept_0(jk) = ( zt - 1 ) * za1
+            e3w_0  (jk) =  za1
+            e3t_0  (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_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth) / zacr ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth) / zacr ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth) / zacr   )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth) / zacr   )
+            END DO
+         ELSE
+            DO jk = 1, jpk
+               zw = FLOAT( jk )
+               zt = FLOAT( jk ) + 0.5_wp
+               ! Double tanh function
+               gdepw_0(jk) = ( zsur + za0 * zw + za1 * zacr * LOG ( COSH( (zw-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zw-zkth2) / zacr2 ) )  )
+               gdept_0(jk) = ( zsur + za0 * zt + za1 * zacr * LOG ( COSH( (zt-zkth ) / zacr  ) )    &
+                  &                            + za2 * zacr2* LOG ( COSH( (zt-zkth2) / zacr2 ) )  )
+               e3w_0  (jk) =          za0      + za1        * TANH(       (zw-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zw-zkth2) / zacr2 )
+               e3t_0  (jk) =          za0      + za1        * TANH(       (zt-zkth ) / zacr  )    &
+                  &                            + za2        * TANH(       (zt-zkth2) / zacr2 )
+            END DO
+         ENDIF
+         gdepw_0(1) = 0._wp                    ! force first w-level to be exactly at zero
+      ENDIF
+
+!!gm BUG in s-coordinate this does not work!
+      ! deepest/shallowest W level Above/Below ~10m
+      zrefdep = 10._wp - 0.1_wp * MINVAL( e3w_0 )                    ! ref. depth with tolerance (10% of minimum layer thickness)
+      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m
+      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m
+!!gm end bug
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:'
+         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" )
+         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk )
+      ENDIF
+      DO jk = 1, jpk                      ! control positivity
+         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( 'dom:zgr_z: e3w or e3t =< 0 '    )
+         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )   CALL ctl_stop( 'dom:zgr_z: gdepw or gdept < 0 ' )
+      END DO
+      !
+      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, jl, jk            ! dummy loop indices
+      INTEGER  ::   inum                      ! temporary logical unit
+      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 , POINTER, DIMENSION(:,:) ::   idta   ! global domain integer data
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdta   ! global domain scalar data
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_bat')
+      !
+      CALL wrk_alloc( jpidta, jpjdta, idta )
+      CALL wrk_alloc( jpidta, jpjdta, zdta )
+      !
+      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)
+         !
+         IF( ntopo == 0 ) THEN                        ! flat basin
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '         bathymetry field: flat basin'
+            idta(:,:) = jpkm1                            ! before last level
+            zdta(:,:) = gdepw_0(jpk)                     ! last w-point depth
+            h_oce     = gdepw_0(jpk)
+         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_0(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_0(jk) < zdta(:,:) .AND. zdta(:,:) <= gdept_0(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
+         !
+         !                                            ! ================ !
+      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(:,:) )
+            !
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !
+               IF( nn_cla == 0 ) THEN
+                  ii0 = 140   ;   ii1 = 140                  ! Gibraltar Strait open 
+                  ij0 = 102   ;   ij1 = 102                  ! (Thomson, Ocean Modelling, 1995)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     DO jj = mj0(ij0), mj1(ij1)
+                        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
+            !
+         ENDIF
+         IF( ln_zps .OR. ln_sco )   THEN              ! zps or sco : read meter bathymetry
+            CALL iom_open ( 'bathy_meter.nc', inum ) 
+            CALL iom_get  ( inum, jpdom_data, 'Bathymetry', bathy )
+            CALL iom_close( inum )
+            !                                                
+            IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
+               !
+              IF( nn_cla == 0 ) THEN
+                 ii0 = 140   ;   ii1 = 140                   ! Gibraltar Strait open 
+                 ij0 = 102   ;   ij1 = 102                   ! (Thomson, Ocean Modelling, 1995)
+                 DO ji = mi0(ii0), mi1(ii1)
+                    DO jj = mj0(ij0), mj1(ij1)
+                       bathy(ji,jj) = 284._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
+            !
+        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_0, mask = gdepw_0 > rn_hmin, dim = 1 )  ! from a depth
+         ENDIF
+         zhmin = gdepw_0(ik+1)                                                         ! minimum depth = ik+1 w-levels 
+         WHERE( bathy(:,:) <= 0._wp )   ;   bathy(:,:) = 0._wp                         ! min=0     over the lands
+         ELSE WHERE                     ;   bathy(:,:) = 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
+      !
+      CALL wrk_dealloc( jpidta, jpjdta, idta )
+      CALL wrk_dealloc( jpidta, jpjdta, zdta )
+      !
+      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. lzoom_arct ) 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( 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
+
+      IF( lwp .AND. nprint == 1 ) THEN      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' bathymetric field :   number of non-zero T-levels '
+         WRITE(numout,*) ' ------------------'
+         CALL prihin( mbathy, jpi, jpj, 1, jpi, 1, 1, jpj, 1, 3, numout )
+         WRITE(numout,*)
+      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_zco
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zgr_zco  ***
+      !!
+      !! ** Purpose :   define the 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(:,:,jk) = gdept_0(jk)
+            gdepw(:,:,jk) = gdepw_0(jk)
+            gdep3w(:,:,jk) = gdepw_0(jk)
+            e3t (:,:,jk) = e3t_0(jk)
+            e3u (:,:,jk) = e3t_0(jk)
+            e3v (:,:,jk) = e3t_0(jk)
+            e3f (:,:,jk) = e3t_0(jk)
+            e3w (:,:,jk) = e3w_0(jk)
+            e3uw(:,:,jk) = e3w_0(jk)
+            e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      !
+      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
+      !!      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(i,j,k)  = fsdep(k)
+      !!                       e3w(i,j,k) = dk(fsdep)(k)     = fse3(i,j,k)
+      !!              t-level: gdept(i,j,k)  = fsdep(k+0.5)
+      !!                       e3t(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.
+      !!
+      !!         c a u t i o n : gdept_0, gdepw_0 and e3._0 are positives
+      !!         - - - - - - -   gdept, gdepw and e3. are positives
+      !!      
+      !!  Reference :   Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270.
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk       ! dummy loop indices
+      INTEGER  ::   ik, it           ! temporary integers
+      LOGICAL  ::   ll_print         ! Allow  control print for debugging
+      REAL(wp) ::   ze3tp , ze3wp    ! Last ocean level thickness at T- and W-points
+      REAL(wp) ::   zdepwp, zdepth   ! Ajusted ocean depth to avoid too small e3t
+      REAL(wp) ::   zmax             ! Maximum depth
+      REAL(wp) ::   zdiff            ! temporary scalar
+      REAL(wp) ::   zrefdep          ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zprt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_zps')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zprt )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '    zgr_zps : z-coordinate with partial steps'
+      IF(lwp) WRITE(numout,*) '    ~~~~~~~ '
+      IF(lwp) WRITE(numout,*) '              mbathy is recomputed : bathy_level file is NOT used'
+
+      ll_print = .FALSE.                   ! Local variable for debugging
+      
+      IF(lwp .AND. ll_print) THEN          ! control print of the ocean depth
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_zgr_zps:  bathy (in hundred of meters)'
+         CALL prihre( bathy, jpi, jpj, 1,jpi, 1, 1, jpj, 1, 1.e-2, numout )
+      ENDIF
+
+
+      ! bathymetry in level (from bathy_meter)
+      ! ===================
+      zmax = gdepw_0(jpk) + e3t_0(jpk)          ! maximum depth (i.e. the last ocean level thickness <= 2*e3t_0(jpkm1) )
+      bathy(:,:) = MIN( zmax ,  bathy(:,:) )    ! bounded value of bathy (min already set at the end of zgr_bat)
+      WHERE( bathy(:,:) == 0._wp )   ;   mbathy(:,:) = 0       ! land  : set mbathy to 0
+      ELSE WHERE                     ;   mbathy(:,:) = jpkm1   ! ocean : initialize mbathy to the max ocean level
+      END WHERE
+
+      ! Compute mbathy for ocean points (i.e. the number of ocean levels)
+      ! find the number of ocean levels such that the last level thickness
+      ! is larger than the minimum of e3zps_min and e3zps_rat * e3t_0 (where
+      ! e3t_0 is the reference level thickness
+      DO jk = jpkm1, 1, -1
+         zdepth = gdepw_0(jk) + MIN( e3zps_min, e3t_0(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(:,:,jk) = gdept_0(jk)
+         gdepw(:,:,jk) = gdepw_0(jk)
+         e3t  (:,:,jk) = e3t_0  (jk)
+         e3w  (:,:,jk) = e3w_0  (jk)
+      END DO
+      ! 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ik = mbathy(ji,jj)
+            IF( ik > 0 ) THEN               ! ocean point only
+               ! max ocean level case
+               IF( ik == jpkm1 ) THEN
+                  zdepwp = bathy(ji,jj)
+                  ze3tp  = bathy(ji,jj) - gdepw_0(ik)
+                  ze3wp = 0.5_wp * e3w_0(ik) * ( 1._wp + ( ze3tp/e3t_0(ik) ) )
+                  e3t(ji,jj,ik  ) = ze3tp
+                  e3t(ji,jj,ik+1) = ze3tp
+                  e3w(ji,jj,ik  ) = ze3wp
+                  e3w(ji,jj,ik+1) = ze3tp
+                  gdepw(ji,jj,ik+1) = zdepwp
+                  gdept(ji,jj,ik  ) = gdept_0(ik-1) + ze3wp
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + ze3tp
+                  !
+               ELSE                         ! standard case
+                  IF( bathy(ji,jj) <= gdepw_0(ik+1) ) THEN   ;   gdepw(ji,jj,ik+1) = bathy(ji,jj)
+                  ELSE                                       ;   gdepw(ji,jj,ik+1) = gdepw_0(ik+1)
+                  ENDIF
+!gm Bug?  check the gdepw_0
+                  !       ... on ik
+                  gdept(ji,jj,ik) = gdepw_0(ik) + ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   &
+                     &                          * ((gdept_0(      ik  ) - gdepw_0(ik) )   &
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ))
+                  e3t  (ji,jj,ik) = e3t_0  (ik) * ( gdepw  (ji,jj,ik+1) - gdepw_0(ik) )   & 
+                     &                          / ( gdepw_0(      ik+1) - gdepw_0(ik) ) 
+                  e3w  (ji,jj,ik) = 0.5_wp * ( gdepw(ji,jj,ik+1) + gdepw_0(ik+1) - 2._wp * gdepw_0(ik) )   &
+                     &                     * ( e3w_0(ik) / ( gdepw_0(ik+1) - gdepw_0(ik) ) )
+                  !       ... on ik+1
+                  e3w  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  e3t  (ji,jj,ik+1) = e3t  (ji,jj,ik)
+                  gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(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(ji,jj,ik  )
+               e3wp (ji,jj) = e3w(ji,jj,ik  )
+               ! test
+               zdiff= gdepw(ji,jj,ik+1) - gdept(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 = ', gdept(ji,jj,ik), ' gdepw = ', gdepw(ji,jj,ik+1), ' zdiff = ', zdiff
+                  WRITE(numout,*) ' e3tp  = ', e3t  (ji,jj,ik), ' e3wp  = ', e3w  (ji,jj,ik  )
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+
+      ! Scale factors and depth at U-, V-, UW and VW-points
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3u (:,:,jk) = e3t_0(jk)
+         e3v (:,:,jk) = e3t_0(jk)
+         e3uw(:,:,jk) = e3w_0(jk)
+         e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3u (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )
+               e3v (ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )
+               e3uw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji+1,jj,jk) )
+               e3vw(ji,jj,jk) = MIN( e3w(ji,jj,jk), e3w(ji,jj+1,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3u , 'U', 1._wp )   ;   CALL lbc_lnk( e3uw, 'U', 1._wp )   ! lateral boundary conditions
+      CALL lbc_lnk( e3v , 'V', 1._wp )   ;   CALL lbc_lnk( e3vw, 'V', 1._wp )
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3u (:,:,jk) == 0._wp )   e3u (:,:,jk) = e3t_0(jk)
+         WHERE( e3v (:,:,jk) == 0._wp )   e3v (:,:,jk) = e3t_0(jk)
+         WHERE( e3uw(:,:,jk) == 0._wp )   e3uw(:,:,jk) = e3w_0(jk)
+         WHERE( e3vw(:,:,jk) == 0._wp )   e3vw(:,:,jk) = e3w_0(jk)
+      END DO
+      
+      ! Scale factor at F-point
+      DO jk = 1, jpk                        ! initialisation to z-scale factors
+         e3f(:,:,jk) = e3t_0(jk)
+      END DO
+      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               e3f(ji,jj,jk) = MIN( e3v(ji,jj,jk), e3v(ji+1,jj,jk) )
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( e3f, 'F', 1._wp )       ! Lateral boundary conditions
+      !
+      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
+         WHERE( e3f(:,:,jk) == 0._wp )   e3f(:,:,jk) = e3t_0(jk)
+      END DO
+!!gm  bug ? :  must be a do loop with mj0,mj1
+      ! 
+      e3t(:,mj0(1),:) = e3t(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
+      e3w(:,mj0(1),:) = e3w(:,mj0(2),:) 
+      e3u(:,mj0(1),:) = e3u(:,mj0(2),:) 
+      e3v(:,mj0(1),:) = e3v(:,mj0(2),:) 
+      e3f(:,mj0(1),:) = e3f(:,mj0(2),:) 
+
+      ! Control of the sign
+      IF( MINVAL( e3t  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t   <= 0' )
+      IF( MINVAL( e3w  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w   <= 0' )
+      IF( MINVAL( gdept(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+      IF( MINVAL( gdepw(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw <  0' )
+     
+      ! Compute gdep3w (vertical sum of e3w)
+      gdep3w(:,:,1) = 0.5_wp * e3w(:,:,1)
+      DO jk = 2, jpk
+         gdep3w(:,:,jk) = gdep3w(:,:,jk-1) + e3w(:,:,jk) 
+      END DO
+        
+      !                                               ! ================= !
+      IF(lwp .AND. ll_print) THEN                     !   Control print   !
+         !                                            ! ================= !
+         DO jj = 1,jpj
+            DO ji = 1, jpi
+               ik = MAX( mbathy(ji,jj), 1 )
+               zprt(ji,jj,1) = e3t   (ji,jj,ik)
+               zprt(ji,jj,2) = e3w   (ji,jj,ik)
+               zprt(ji,jj,3) = e3u   (ji,jj,ik)
+               zprt(ji,jj,4) = e3v   (ji,jj,ik)
+               zprt(ji,jj,5) = e3f   (ji,jj,ik)
+               zprt(ji,jj,6) = gdep3w(ji,jj,ik)
+            END DO
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3t(mbathy)'      ;   CALL prihre(zprt(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3w(mbathy)'      ;   CALL prihre(zprt(:,:,2),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3u(mbathy)'      ;   CALL prihre(zprt(:,:,3),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3v(mbathy)'      ;   CALL prihre(zprt(:,:,4),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr e3f(mbathy)'      ;   CALL prihre(zprt(:,:,5),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'domzgr gdep3w(mbathy)'   ;   CALL prihre(zprt(:,:,6),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF  
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zprt )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_zps')
+      !
+   END SUBROUTINE zgr_zps
+
+
+   FUNCTION fssig( pk ) RESULT( pf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!       
+      !! ** 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 eos_init  ***
+      !!
+      !! ** 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
+
+
+   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 gsigt, gsigw, esigt, esigw from an analytical
+      !!         function and its derivative given as function.
+      !!            gsigt(k) = fssig (k    )
+      !!            gsigw(k) = fssig (k-0.5)
+      !!            esigt(k) = fsdsig(k    )
+      !!            esigw(k) = fsdsig(k-0.5)
+      !!      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 a!!uracy
+      !!      schemes.
+      !!
+      !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk, jl           ! dummy loop argument
+      INTEGER  ::   iip1, ijp1, iim1, ijm1   ! temporary integers
+      REAL(wp) ::   zcoeft, zcoefw, zrmax, ztaper   ! temporary scalars
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zenv, ztmp, zmsk, zri, zrj, zhbat
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: gsigw3, gsigt3, gsi3w3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3           
+
+      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zgr_sco')
+      !
+      CALL wrk_alloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      CALL wrk_alloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_alloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+      !
+      REWIND( numnam )                       ! Read Namelist namzgr_sco : sigma-stretching parameters
+      READ  ( numnam, namzgr_sco )
+
+      IF(lwp) THEN                           ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzgr_sco'
+         WRITE(numout,*) '      sigma-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,*) '      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,*) '      maximum cut-off r-value allowed              rn_rmax       = ', rn_rmax
+         WRITE(numout,*) '      Hybrid s-sigma-coordinate                    ln_s_sigma    = ', ln_s_sigma
+         WRITE(numout,*) '      stretching parameter (song and haidvogel)    rn_bb         = ', rn_bb
+         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc
+      ENDIF
+
+      gsigw3  = 0._wp   ;   gsigt3  = 0._wp   ;   gsi3w3  = 0._wp
+      esigt3  = 0._wp   ;   esigw3  = 0._wp 
+      esigtu3 = 0._wp   ;   esigtv3 = 0._wp   ;   esigtf3 = 0._wp
+      esigwu3 = 0._wp   ;   esigwv3 = 0._wp
+
+      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate
+      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
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zenv(ji,jj) = MAX( bathy(ji,jj), rn_sbot_min )
+         END DO
+      END DO
+      ! 
+      ! 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
+      !                                                     ! ================ !
+      DO WHILE( jl <= 10000 .AND. zrmax > rn_rmax )         !  Iterative loop  !
+         !                                                  ! ================ !
+         jl = jl + 1
+         zrmax = 0._wp
+         zmsk(:,:) = 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)
+               zri(ji,jj) = ABS( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
+               zrj(ji,jj) = ABS( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
+               zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) )
+               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1._wp
+               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1._wp
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_max( zrmax )   ! max over the global domain
+         ! lateral boundary condition on zmsk: keep 1 along closed boundary (use of MAX)
+         ztmp(:,:) = zmsk(:,:)   ;   CALL lbc_lnk( zmsk, 'T', 1._wp )
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+                zmsk(ji,jj) = MAX( zmsk(ji,jj), ztmp(ji,jj) )
+            END DO
+         END DO
+         !
+         IF(lwp)WRITE(numout,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax, ' nb of pt= ', INT( SUM(zmsk(:,:) ) )
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               iip1 = MIN( ji+1, nlci )     ! last  line (ji=nlci)
+               ijp1 = MIN( jj+1, nlcj )     ! last  raw  (jj=nlcj)
+               iim1 = MAX( ji-1,  1  )      ! first line (ji=nlci)
+               ijm1 = MAX( jj-1,  1  )      ! first raw  (jj=nlcj)
+               IF( zmsk(ji,jj) == 1._wp ) THEN
+                  ztmp(ji,jj) =   (                                                                                   &
+             &      zenv(iim1,ijp1)*zmsk(iim1,ijp1) + zenv(ji,ijp1)*zmsk(ji,ijp1) + zenv(iip1,ijp1)*zmsk(iip1,ijp1)   &
+             &    + zenv(iim1,jj  )*zmsk(iim1,jj  ) + zenv(ji,jj  )*    2._wp     + zenv(iip1,jj  )*zmsk(iip1,jj  )   &
+             &    + zenv(iim1,ijm1)*zmsk(iim1,ijm1) + zenv(ji,ijm1)*zmsk(ji,ijm1) + zenv(iip1,ijm1)*zmsk(iip1,ijm1)   &
+             &                    ) / (                                                                               &
+             &                      zmsk(iim1,ijp1) +               zmsk(ji,ijp1) +                 zmsk(iip1,ijp1)   &
+             &    +                 zmsk(iim1,jj  ) +                   2._wp     +                 zmsk(iip1,jj  )   &
+             &    +                 zmsk(iim1,ijm1) +               zmsk(ji,ijm1) +                 zmsk(iip1,ijm1)   &
+             &                        )
+               ENDIF
+            END DO
+         END DO
+         !
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               IF( zmsk(ji,jj) == 1._wp )   zenv(ji,jj) = MAX( ztmp(ji,jj), bathy(ji,jj) )
+            END DO
+         END DO
+         !
+         ! Apply lateral boundary condition   CAUTION: kept the value when the lbc field is zero
+         ztmp(:,:) = zenv(:,:)   ;   CALL lbc_lnk( zenv, 'T', 1._wp )
+         DO jj = 1, nlcj
+            DO ji = 1, nlci
+               IF( zenv(ji,jj) == 0._wp )   zenv(ji,jj) = ztmp(ji,jj)
+            END DO
+         END DO
+         !                                                  ! ================ !
+      END DO                                                !     End loop     !
+      !                                                     ! ================ !
+      !
+      !                                        ! envelop 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 )
+               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper )
+            END DO
+         END DO
+      ENDIF
+      !
+      IF(lwp) THEN                             ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' domzgr: hbatt field; ocean depth in meters'
+         WRITE(numout,*)
+         CALL prihre( hbatt(1,1), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 0._wp, numout )
+         IF( nprint == 1 )   THEN        
+            WRITE(numout,*) ' bathy  MAX ', MAXVAL( bathy(:,:) ), ' MIN ', MINVAL( bathy(:,:) )
+            WRITE(numout,*) ' hbatt  MAX ', MAXVAL( hbatt(:,:) ), ' MIN ', MINVAL( hbatt(:,:) )
+         ENDIF
+      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
+               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
+
+      IF( ln_s_sigma ) THEN        ! Song and Haidvogel style stretched sigma for depths
+         !                         ! below rn_hc, with uniform sigma in shallower waters
+         DO ji = 1, jpi
+            DO jj = 1, jpj
+
+               IF( hbatt(ji,jj) > rn_hc ) THEN    !deep water, stretched sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb )
+                     gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb )
+                  END DO
+               ELSE ! shallow water, uniform sigma
+                  DO jk = 1, jpk
+                     gsigw3(ji,jj,jk) =   REAL(jk-1,wp)            / REAL(jpk-1,wp)
+                     gsigt3(ji,jj,jk) = ( REAL(jk-1,wp) + 0.5_wp ) / REAL(jpk-1,wp)
+                  END DO
+               ENDIF
+               IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw3 1 jpk    ', gsigw3(ji,jj,1), gsigw3(ji,jj,jpk)
+               !
+               DO jk = 1, jpkm1
+                  esigt3(ji,jj,jk  ) = gsigw3(ji,jj,jk+1) - gsigw3(ji,jj,jk)
+                  esigw3(ji,jj,jk+1) = gsigt3(ji,jj,jk+1) - gsigt3(ji,jj,jk)
+               END DO
+               esigw3(ji,jj,1  ) = 2._wp * ( gsigt3(ji,jj,1  ) - gsigw3(ji,jj,1  ) )
+               esigt3(ji,jj,jpk) = 2._wp * ( gsigt3(ji,jj,jpk) - gsigw3(ji,jj,jpk) )
+               !
+               ! Coefficients for vertical depth as the sum of e3w scale factors
+               gsi3w3(ji,jj,1) = 0.5_wp * esigw3(ji,jj,1)
+               DO jk = 2, jpk
+                  gsi3w3(ji,jj,jk) = gsi3w3(ji,jj,jk-1) + esigw3(ji,jj,jk)
+               END DO
+               !
+               DO jk = 1, jpk
+                  zcoeft = ( REAL(jk,wp) - 0.5_wp ) / REAL(jpkm1,wp)
+                  zcoefw = ( REAL(jk,wp) - 1.0_wp ) / REAL(jpkm1,wp)
+                  gdept (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft )
+                  gdepw (ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw )
+                  gdep3w(ji,jj,jk) = ( scosrf(ji,jj) + (hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoeft )
+               END DO
+               !
+            END DO   ! for all jj's
+         END DO    ! for all ji's
+
+         DO ji = 1, jpim1
+            DO jj = 1, jpjm1
+               DO jk = 1, jpk
+                  esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigtv3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji,jj+1)*esigt3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  esigtf3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk)     &
+                     &                + hbatt(ji,jj+1)*esigt3(ji,jj+1,jk)+hbatt(ji+1,jj+1)*esigt3(ji+1,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj)+hbatt(ji,jj+1)+hbatt(ji+1,jj+1) )
+                  esigwu3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji+1,jj)*esigw3(ji+1,jj,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji+1,jj) )
+                  esigwv3(ji,jj,jk) = ( hbatt(ji,jj)*esigw3(ji,jj,jk)+hbatt(ji,jj+1)*esigw3(ji,jj+1,jk) )   &
+                     &              / ( hbatt(ji,jj)+hbatt(ji,jj+1) )
+                  !
+                  e3t(ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigt3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3u(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3v(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3f(ji,jj,jk) = ( (hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  !
+                  e3w (ji,jj,jk) = ( (hbatt(ji,jj)-rn_hc)*esigw3 (ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+                  e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1) )
+               END DO
+            END DO
+         END DO
+
+         CALL lbc_lnk( e3t , 'T', 1._wp )
+         CALL lbc_lnk( e3u , 'U', 1._wp )
+         CALL lbc_lnk( e3v , 'V', 1._wp )
+         CALL lbc_lnk( e3f , 'F', 1._wp )
+         CALL lbc_lnk( e3w , 'W', 1._wp )
+         CALL lbc_lnk( e3uw, 'U', 1._wp )
+         CALL lbc_lnk( e3vw, 'V', 1._wp )
+
+         !
+      ELSE   ! not ln_s_sigma
+         !
+         DO jk = 1, jpk
+           gsigw(jk) = -fssig( REAL(jk,wp)-0.5_wp )
+           gsigt(jk) = -fssig( REAL(jk,wp)        )
+         END DO
+         IF( nprint == 1 .AND. lwp )   WRITE(numout,*) 'gsigw 1 jpk    ', gsigw(1), gsigw(jpk)
+         !
+         ! 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
+            esigt(jk  ) = gsigw(jk+1) - gsigw(jk)
+            esigw(jk+1) = gsigt(jk+1) - gsigt(jk)
+         END DO
+         esigw( 1 ) = 2._wp * ( gsigt(1  ) - gsigw(1  ) ) 
+         esigt(jpk) = 2._wp * ( gsigt(jpk) - gsigw(jpk) )
+
+!!gm  original form
+!!org DO jk = 1, jpk
+!!org    esigt(jk)=fsdsig( FLOAT(jk)     )
+!!org    esigw(jk)=fsdsig( FLOAT(jk)-0.5 )
+!!org END DO
+!!gm
+         !
+         ! Coefficients for vertical depth as the sum of e3w scale factors
+         gsi3w(1) = 0.5_wp * esigw(1)
+         DO jk = 2, jpk
+            gsi3w(jk) = gsi3w(jk-1) + 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 (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigt(jk) + hift(:,:)*zcoeft )
+            gdepw (:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsigw(jk) + hift(:,:)*zcoefw )
+            gdep3w(:,:,jk) = ( scosrf(:,:) + (hbatt(:,:)-hift(:,:))*gsi3w(jk) + hift(:,:)*zcoeft )
+         END DO
+!!gm: e3uw, e3vw can be suppressed  (modif in dynzdf, dynzdf_iso, zdfbfr) (save 2 3D arrays)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               DO jk = 1, jpk
+                 e3t(ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigt(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3u(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigt(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3v(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigt(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+                 e3f(ji,jj,jk) = ( (hbatf(ji,jj)-hiff(ji,jj))*esigt(jk) + hiff(ji,jj)/REAL(jpkm1,wp) )
+                 !
+                 e3w (ji,jj,jk) = ( (hbatt(ji,jj)-hift(ji,jj))*esigw(jk) + hift(ji,jj)/REAL(jpkm1,wp) )
+                 e3uw(ji,jj,jk) = ( (hbatu(ji,jj)-hifu(ji,jj))*esigw(jk) + hifu(ji,jj)/REAL(jpkm1,wp) )
+                 e3vw(ji,jj,jk) = ( (hbatv(ji,jj)-hifv(ji,jj))*esigw(jk) + hifv(ji,jj)/REAL(jpkm1,wp) )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF ! ln_s_sigma
+
+
+      !
+      where (e3t   (:,:,:).eq.0.0)  e3t(:,:,:) = 1.0
+      where (e3u   (:,:,:).eq.0.0)  e3u(:,:,:) = 1.0
+      where (e3v   (:,:,:).eq.0.0)  e3v(:,:,:) = 1.0
+      where (e3f   (:,:,:).eq.0.0)  e3f(:,:,:) = 1.0
+      where (e3w   (:,:,:).eq.0.0)  e3w(:,:,:) = 1.0
+      where (e3uw  (:,:,:).eq.0.0)  e3uw(:,:,:) = 1.0
+      where (e3vw  (:,:,:).eq.0.0)  e3vw(:,:,:) = 1.0
+
+
+      fsdept(:,:,:) = gdept (:,:,:)
+      fsdepw(:,:,:) = gdepw (:,:,:)
+      fsde3w(:,:,:) = gdep3w(:,:,:)
+      fse3t (:,:,:) = e3t   (:,:,:)
+      fse3u (:,:,:) = e3u   (:,:,:)
+      fse3v (:,:,:) = e3v   (:,:,:)
+      fse3f (:,:,:) = e3f   (:,:,:)
+      fse3w (:,:,:) = e3w   (:,:,:)
+      fse3uw(:,:,:) = e3uw  (:,:,:)
+      fse3vw(:,:,:) = e3vw  (:,:,:)
+!!
+      ! HYBRID : 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            DO jk = 1, jpkm1
+               IF( scobot(ji,jj) >= fsdept(ji,jj,jk) )   mbathy(ji,jj) = MAX( 2, jk )
+               IF( scobot(ji,jj) == 0._wp            )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+      END DO
+      IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ),   &
+         &                                                       ' MAX ', MAXVAL( mbathy(:,:) )
+
+      !                                               ! =============
+      IF(lwp) THEN                                    ! Control print
+         !                                            ! =============
+         WRITE(numout,*) 
+         WRITE(numout,*) ' domzgr: vertical coefficients for model level'
+         WRITE(numout, "(9x,'  level    gsigt      gsigw      esigt      esigw      gsi3w')" )
+         WRITE(numout, "(10x,i4,5f11.4)" ) ( jk, gsigt(jk), gsigw(jk), esigt(jk), esigw(jk), gsi3w(jk), jk=1,jpk )
+      ENDIF
+      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( fsdept(:,:,:) ),   &
+            &                          ' w ', MINVAL( fsdepw(:,:,:) ), '3w '  , MINVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MIN val e3    t ', MINVAL( fse3t (:,:,:) ), ' f '  , MINVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MINVAL( fse3u (:,:,:) ), ' u '  , MINVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MINVAL( fse3uw(:,:,:) ), ' vw'  , MINVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MINVAL( fse3w (:,:,:) )
+
+         WRITE(numout,*) ' MAX val depth t ', MAXVAL( fsdept(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fsdepw(:,:,:) ), '3w '  , MAXVAL( fsde3w(:,:,:) )
+         WRITE(numout,*) ' MAX val e3    t ', MAXVAL( fse3t (:,:,:) ), ' f '  , MAXVAL( fse3f (:,:,:) ),   &
+            &                          ' u ', MAXVAL( fse3u (:,:,:) ), ' u '  , MAXVAL( fse3v (:,:,:) ),   &
+            &                          ' uw', MAXVAL( fse3uw(:,:,:) ), ' vw'  , MAXVAL( fse3vw(:,:,:) ),   &
+            &                          ' w ', MAXVAL( fse3w (:,:,:) )
+      ENDIF
+      !
+      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    gdepw    gde3w     e3t      e3w  ')")
+         WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(1,1,jk), fsdepw(1,1,jk),     &
+            &                                 fse3t (1,1,jk), fse3w (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    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (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    gdepw    gde3w     e3t      e3w  ')")
+               WRITE(numout,"(10x,i4,4f9.2)") ( jk, fsdept(ji,jj,jk), fsdepw(ji,jj,jk),     &
+                  &                                 fse3t (ji,jj,jk), fse3w (ji,jj,jk), jk=1,jpk )
+            END DO
+         END DO
+      ENDIF
+
+!!gm bug?  no more necessary?  if ! defined key_helsinki
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fse3w(ji,jj,jk) <= 0._wp .OR. fse3t(ji,jj,jk) <= 0._wp ) THEN
+                  WRITE(ctmp1,*) 'zgr_sco :   e3w   or e3t   =< 0  at point (i,j,k)= ', ji, jj, jk
+                  CALL ctl_stop( ctmp1 )
+               ENDIF
+               IF( fsdepw(ji,jj,jk) < 0._wp .OR. fsdept(ji,jj,jk) < 0._wp ) THEN
+                  WRITE(ctmp1,*) 'zgr_sco :   gdepw or gdept =< 0  at point (i,j,k)= ', ji, jj, jk
+                  CALL ctl_stop( ctmp1 )
+               ENDIF
+            END DO
+         END DO
+      END DO
+!!gm bug    #endif
+      !
+      CALL wrk_dealloc( jpi, jpj,      zenv, ztmp, zmsk, zri, zrj, zhbat                           )
+      CALL wrk_dealloc( jpi, jpj, jpk, gsigw3, gsigt3, gsi3w3                                      )
+      CALL wrk_dealloc( jpi, jpj, jpk, esigt3, esigw3, esigtu3, esigtv3, esigtf3, esigwu3, esigwv3 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zgr_sco')
+      !
+   END SUBROUTINE zgr_sco
+
+   !!======================================================================
+END MODULE domzgr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr_substitute.h90	(revision 3437)
@@ -0,0 +1,97 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  domzgr_substitute.h90   ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsdep. and fse.., the vert. depth and scale
+   !!      factors depending on the vertical coord. used, using CPP macro.
+   !!----------------------------------------------------------------------
+   !! History :  1.0  !  2005-10  (A. Beckmann, G. Madec) generalisation to all coord.
+   !!            3.1  !  2009-02  (G. Madec, M. Leclair)  pure z* coordinate
+   !!----------------------------------------------------------------------
+! reference for s- or zps-coordinate (3D no time dependency)
+#   define  fsdept_0(i,j,k)  gdept(i,j,k)
+#   define  fsdepw_0(i,j,k)  gdepw(i,j,k)
+#   define  fsde3w_0(i,j,k)  gdep3w(i,j,k)
+#   define  fse3t_0(i,j,k)   e3t(i,j,k)
+#   define  fse3u_0(i,j,k)   e3u(i,j,k)
+#   define  fse3v_0(i,j,k)   e3v(i,j,k)
+#   define  fse3f_0(i,j,k)   e3f(i,j,k)
+#   define  fse3w_0(i,j,k)   e3w(i,j,k)
+#   define  fse3uw_0(i,j,k)  e3uw(i,j,k)
+#   define  fse3vw_0(i,j,k)  e3vw(i,j,k)
+#if defined key_vvl
+! s* or z*-coordinate (3D + time dependency) + use of additional now arrays (..._1)
+#   define  fsdept(i,j,k)  gdept_1(i,j,k)
+#   define  fsdepw(i,j,k)  gdepw_1(i,j,k)
+#   define  fsde3w(i,j,k)  gdep3w_1(i,j,k)
+#   define  fse3t(i,j,k)   e3t_1(i,j,k)
+#   define  fse3u(i,j,k)   e3u_1(i,j,k)
+#   define  fse3v(i,j,k)   e3v_1(i,j,k)
+#   define  fse3f(i,j,k)   e3f_1(i,j,k)
+#   define  fse3w(i,j,k)   e3w_1(i,j,k)
+#   define  fse3uw(i,j,k)  e3uw_1(i,j,k)
+#   define  fse3vw(i,j,k)  e3vw_1(i,j,k)
+
+#   define  fse3t_b(i,j,k)   e3t_b(i,j,k)
+#   define  fse3u_b(i,j,k)   e3u_b(i,j,k)
+#   define  fse3v_b(i,j,k)   e3v_b(i,j,k)
+#   define  fse3uw_b(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_b(i,j)*muu(i,j,k)))
+#   define  fse3vw_b(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_b(i,j)*muv(i,j,k)))
+
+#   define  fsdept_n(i,j,k)  (fsdept_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k)))
+#   define  fsdepw_n(i,j,k)  (fsdepw_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k)))
+#   define  fsde3w_n(i,j,k)  (fsde3w_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k))-sshn(i,j))
+#   define  fse3t_n(i,j,k)   (fse3t_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k)))
+#   define  fse3u_n(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_n(i,j)*muu(i,j,k)))
+#   define  fse3v_n(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_n(i,j)*muv(i,j,k)))
+#   define  fse3f_n(i,j,k)   (fse3f_0(i,j,k)*(1.+sshf_n(i,j)*muf(i,j,k)))
+#   define  fse3w_n(i,j,k)   (fse3w_0(i,j,k)*(1.+sshn(i,j)*mut(i,j,k)))
+#   define  fse3uw_n(i,j,k)  (fse3uw_0(i,j,k)*(1.+sshu_n(i,j)*muu(i,j,k)))
+#   define  fse3vw_n(i,j,k)  (fse3vw_0(i,j,k)*(1.+sshv_n(i,j)*muv(i,j,k)))
+
+#   define  fse3t_m(i,j,k)   (fse3t_0(i,j,k)*(1.+ssh_m(i,j)*mut(i,j,k)))
+
+#   define  fse3t_a(i,j,k)   (fse3t_0(i,j,k)*(1.+ssha(i,j)*mut(i,j,k)))
+#   define  fse3u_a(i,j,k)   (fse3u_0(i,j,k)*(1.+sshu_a(i,j)*muu(i,j,k)))
+#   define  fse3v_a(i,j,k)   (fse3v_0(i,j,k)*(1.+sshv_a(i,j)*muv(i,j,k)))
+
+#else
+! z- or s-coordinate (1D or 3D + no time dependency) use reference in all cases
+#   define  fsdept(i,j,k)  fsdept_0(i,j,k)
+#   define  fsdepw(i,j,k)  fsdepw_0(i,j,k)
+#   define  fsde3w(i,j,k)  fsde3w_0(i,j,k)
+#   define  fse3t(i,j,k)   fse3t_0(i,j,k)
+#   define  fse3u(i,j,k)   fse3u_0(i,j,k)
+#   define  fse3v(i,j,k)   fse3v_0(i,j,k)
+#   define  fse3f(i,j,k)   fse3f_0(i,j,k)
+#   define  fse3w(i,j,k)   fse3w_0(i,j,k)
+#   define  fse3uw(i,j,k)  fse3uw_0(i,j,k)
+#   define  fse3vw(i,j,k)  fse3vw_0(i,j,k)
+
+#   define  fse3t_b(i,j,k)   fse3t_0(i,j,k)
+#   define  fse3u_b(i,j,k)   fse3u_0(i,j,k)
+#   define  fse3v_b(i,j,k)   fse3v_0(i,j,k)
+#   define  fse3uw_b(i,j,k)  fse3uw_0(i,j,k)
+#   define  fse3vw_b(i,j,k)  fse3vw_0(i,j,k)
+
+#   define  fsdept_n(i,j,k)  fsdept_0(i,j,k)
+#   define  fsdepw_n(i,j,k)  fsdepw_0(i,j,k)
+#   define  fsde3w_n(i,j,k)  fsde3w_0(i,j,k)
+#   define  fse3t_n(i,j,k)   fse3t_0(i,j,k)
+#   define  fse3u_n(i,j,k)   fse3u_0(i,j,k)
+#   define  fse3v_n(i,j,k)   fse3v_0(i,j,k)
+#   define  fse3f_n(i,j,k)   fse3f_0(i,j,k)
+#   define  fse3w_n(i,j,k)   fse3w_0(i,j,k)
+#   define  fse3uw_n(i,j,k)  fse3uw_0(i,j,k)
+#   define  fse3vw_n(i,j,k)  fse3vw_0(i,j,k)
+
+#   define  fse3t_m(i,j,k)   fse3t_0(i,j,k)
+
+#   define  fse3t_a(i,j,k)   fse3t_0(i,j,k)
+#   define  fse3u_a(i,j,k)   fse3u_0(i,j,k)
+#   define  fse3v_a(i,j,k)   fse3v_0(i,j,k)
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90	(revision 3437)
@@ -0,0 +1,308 @@
+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   = .FALSE.    !: T & S data flag
+   LOGICAL , PUBLIC ::   ln_tsd_tradmp = .FALSE.    !: internal damping toward input data flag
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: dtatem.F90 2392 2010-11-15 21:20:05Z gm $ 
+   !! 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
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init')
+      !
+      !  Initialisation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0
+      !
+      !                             ! set default namelist values 
+      cn_dir = './'                       ! directory in which the model is executed
+      !                                   ! sn_... default values (NB: frequency positive => hours, negative => months)
+      !            !   file    ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+      !            !   name    !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+      sn_tem = FLD_N( 'temperature',  -1.  , 'votemper',  .false.   , .true.  ,  'monthly'  , ''       , ''       )
+      sn_sal = FLD_N( 'salinity'   ,  -1.  , 'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''       )
+
+      REWIND( numnam )              ! read in namlist namdta_tsd 
+      READ  ( numnam, 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
+         IF( nn_cla == 1 ) THEN                          ! Cross Land advection
+            il0 = 138   ;   il1 = 138                          ! set T & S profile at Gibraltar Strait
+            ij0 = 101   ;   ij1 = 102
+            ii0 = 139   ;   ii1 = 139
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
+                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+            il0 = 164   ;   il1 = 164                          ! set T & S profile at Bab el Mandeb Strait
+            ij0 =  87   ;   ij1 =  88
+            ii0 = 161   ;   ii1 = 163
+            DO jl = mi0(il0), mi1(il1)
+               DO jj = mj0(ij0), mj1(ij1)
+                  DO ji = mi0(ii0), mi1(ii1)
+                     sf_tsd(jp_tem)%fnow(ji,jj,:) = sf_tsd(jp_tem)%fnow(jl,jj,:)
+                     sf_tsd(jp_sal)%fnow(ji,jj,:) = sf_tsd(jp_sal)%fnow(jl,jj,:)
+                  END DO
+               END DO
+            END DO
+         ELSE                                            ! No Cross Land advection
+            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
+      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 = fsdept_0(ji,jj,jk)
+                  IF(     zl < gdept_0(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_0(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_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN
+                           zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(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_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(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
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( lwp .AND. kt == nit000 ) THEN
+         WRITE(numout,*) ' temperature Levitus '
+         WRITE(numout,*)
+         WRITE(numout,*)'  level = 1'
+         CALL prihre( ptsd(:,:,1    ,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpk/2
+         CALL prihre( ptsd(:,:,jpk/2,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpkm1
+         CALL prihre( ptsd(:,:,jpkm1,jp_tem), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)
+         WRITE(numout,*) ' salinity Levitus '
+         WRITE(numout,*)
+         WRITE(numout,*)'  level = 1'
+         CALL prihre( ptsd(:,:,1    ,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpk/2
+         CALL prihre( ptsd(:,:,jpk/2,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)'  level = ', jpkm1
+         CALL prihre( ptsd(:,:,jpkm1,jp_sal), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+         WRITE(numout,*)
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90	(revision 3437)
@@ -0,0 +1,528 @@
+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 daymod          ! calendar
+   USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine)
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! physical constants
+   USE dtatsd          ! data temperature and salinity   (dta_tsd routine)
+   USE restart         ! ocean restart                   (rst_read routine)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE domvvl          ! varying vertical mesh
+   USE dynspg_oce      ! pressure gradient schemes
+   USE dynspg_flt      ! pressure gradient schemes
+   USE dynspg_exp      ! pressure gradient schemes
+   USE dynspg_ts       ! pressure gradient schemes
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   istate_init   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE istate_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE istate_init  ***
+      !! 
+      !! ** Purpose :   Initialization of the dynamics and tracer fields.
+      !!----------------------------------------------------------------------
+      ! - ML - needed for initialization of e3t_b
+      INTEGER  ::  jk     ! dummy loop indice
+      !!----------------------------------------------------------------------
+      !
+      IF( 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
+
+      rhd  (:,:,:  ) = 0.e0
+      rhop (:,:,:  ) = 0.e0
+      rn2  (:,:,:  ) = 0.e0 
+      tsa  (:,:,:,:) = 0.e0    
+
+      IF( ln_rstart ) THEN                    ! Restart from a file
+         !                                    ! -------------------
+         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog)
+         CALL rst_read                           ! Read the restart file
+         !                                       ! define e3u_b, e3v_b from e3t_b read in restart file
+         CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+         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  
+         rotb (:,:,:) = 0._wp   ;   rotn (:,:,:) = 0._wp
+         hdivb(:,:,:) = 0._wp   ;   hdivn(:,:,:) = 0._wp
+         !
+         !                                       ! define e3u_b, e3v_b from e3t_b initialized in domzgr
+         CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+         !
+         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
+         ELSEIF( ln_tsd_init      ) THEN         ! Initial T-S fields read in files
+            CALL dta_tsd( nit000, tsb )                  ! read 3D T and S data at nit000
+            tsn(:,:,:,:) = tsb(:,:,:,:)
+            !
+         ELSE                                    ! Initial T-S fields defined analytically
+            CALL istate_t_s
+         ENDIF
+         !
+         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities
+#if ! defined key_c1d
+         IF( ln_zps )   CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv,  & ! zps: before hor. gradient
+            &                                       rhd, gru , grv  )   ! of t,s,rd at ocean bottom
+#endif
+         !   
+         ! - ML - sshn could be modified by istate_eel, so that initialization of fse3t_b is done here
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            ENDDO
+         ENDIF
+         ! 
+      ENDIF
+      !
+      IF( lk_agrif ) THEN                  ! read free surface arrays in restart file
+         IF( ln_rstart ) THEN
+            IF( lk_dynspg_flt )   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields
+            !                                                         ! gcx, gcxb for agrif_opa_init
+         ENDIF                                                        ! explicit case not coded yet with AGRIF
+      ENDIF
+      !
+      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
+      !!----------------------------------------------------------------------
+      !
+      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((fsdept(:,:,jk)-80.)/30.) )   &
+            &                + 10. * ( 5000. - fsdept(:,:,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 divcur     ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE iom
+ 
+      INTEGER  ::   inum              ! temporary logical unit
+      INTEGER  ::   ji, jj, jk        ! dummy loop indices
+      INTEGER  ::   ijloc
+      REAL(wp) ::   zh1, zh2, zslope, zcst, zfcor   ! temporary scalars
+      REAL(wp) ::   zt1  = 15._wp                   ! surface temperature value (EEL R5)
+      REAL(wp) ::   zt2  =  5._wp                   ! bottom  temperature value (EEL R5)
+      REAL(wp) ::   zsal = 35.0_wp                  ! constant salinity (EEL R2, R5 and R6)
+      REAL(wp) ::   zueel = 0.1_wp                  ! constant uniform zonal velocity (EEL R5)
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zssh  ! initial ssh over the global domain
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jp_cfg ) 
+         !                                              ! ====================
+         CASE ( 5 )                                     ! EEL R5 configuration
+            !                                           ! ====================
+            !
+            ! set temperature field with a linear profile
+            ! -------------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            zh1 = gdept_0(  1  )
+            zh2 = gdept_0(jpkm1)
+            !
+            zslope = ( zt1 - zt2 ) / ( zh1 - zh2 )
+            zcst   = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 )
+            !
+            DO jk = 1, jpk
+               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)
+               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem)
+            END DO
+            !
+            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                             1     , jpi   , 5     , 1     , jpk   ,   &
+               &                             1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:)
+            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal)
+            !
+            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary)
+            ! ----------------
+            ! Start EEL5 configuration with barotropic geostrophic velocities 
+            ! according the sshb and sshn SSH imposed.
+            ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y)
+            ! we use the Coriolis frequency at mid-channel.   
+            ub(:,:,:) = zueel * umask(:,:,:)
+            un(:,:,:) = ub(:,:,:)
+            ijloc = mj0(INT(jpjglo-1)/2)
+            zfcor = ff(1,ijloc)
+            !
+            DO jj = 1, jpjglo
+               zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 
+            END DO
+            !
+            IF(lwp) THEN
+               WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel
+               WRITE(numout,*) ' Geostrophic SSH profile as a function of y:'
+               WRITE(numout,'(12(1x,f6.2))') zssh(1,:)
+            ENDIF
+            !
+            DO jj = 1, nlcj
+               DO ji = 1, nlci
+                  sshb(ji,jj) = zssh( mig(ji) , mjg(jj) ) * tmask(ji,jj,1)
+               END DO
+            END DO
+            sshb(nlci+1:jpi,      :   ) = 0.e0      ! set to zero extra mpp columns
+            sshb(      :   ,nlcj+1:jpj) = 0.e0      ! set to zero extra mpp rows
+            !
+            sshn(:,:) = sshb(:,:)                   ! set now ssh to the before value
+            !
+            IF( nn_rstssh /= 0 ) THEN  
+               nn_rstssh = 0                        ! hand-made initilization of ssh 
+               CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' )
+            ENDIF
+            !
+            CALL div_cur( nit000 )                  ! horizontal divergence and relative vorticity (curl)
+            ! N.B. the vertical velocity will be computed from the horizontal divergence field
+            ! in istate by a call to wzv routine
+
+
+            !                                     ! ==========================
+         CASE ( 2 , 6 )                           ! EEL R2 or R6 configuration
+            !                                     ! ==========================
+            !
+            ! set temperature field with a NetCDF file
+            ! ----------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file'
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            CALL iom_open ( 'eel.initemp', inum )
+            CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb)
+            CALL iom_close( inum )
+            !
+            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb
+            !
+            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   &
+               &                            1     , jpi   , 5     , 1     , jpk   ,   &
+               &                            1     , 1.    , numout                  )
+            !
+            ! set salinity field to a constant value
+            ! --------------------------------------
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal
+            IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+            !
+            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( (fsdept(ji,jj,jk) - 400) / 700 )         )   &
+                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               &
+                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       &
+                       &                - 1.4 * TANH((fsdept(ji,jj,jk)-100.) / 100.)               &    
+                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   & 
+                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2
+                  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( (fsdept(ji,jj,jk) - 305) / 460 )  )  &
+                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          &
+                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         &
+                     &                - 1.62 * TANH( (fsdept(ji,jj,jk) - 60.  ) / 650. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 35.  ) / 100. )       &
+                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  &
+                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
+                  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_0   temperature   salinity   ')" )
+         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(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 dynspg          ! surface pressure gradient             (dyn_spg routine)
+      USE divcur          ! hor. divergence & rel. vorticity      (div_cur routine)
+      USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+
+      INTEGER ::   ji, jj, jk        ! dummy loop indices
+      INTEGER ::   indic             ! ???
+      REAL(wp) ::   zmsv, zphv, zmsu, zphu, zalfg     ! temporary scalars
+      REAL(wp), 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 * fse3w(:,:,1) * ( 1 + rhd(:,:,1) )       ! Surface value
+
+      DO jk = 2, jpkm1                                              ! Vertical integration from the surface
+         zprn(:,:,jk) = zprn(:,:,jk-1)   &
+            &         + zalfg * fse3w(:,:,jk) * ( 2. + rhd(:,:,jk) + rhd(:,:,jk-1) )
+      END DO  
+
+      ! Compute geostrophic balance
+      ! ---------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vertor opt.
+               zmsv = 1. / MAX(  umask(ji-1,jj+1,jk) + umask(ji  ,jj+1,jk)   &
+                               + umask(ji-1,jj  ,jk) + umask(ji  ,jj  ,jk) , 1.  )
+               zphv = ( zprn(ji  ,jj+1,jk) - zprn(ji-1,jj+1,jk) ) * umask(ji-1,jj+1,jk) / e1u(ji-1,jj+1)   &
+                    + ( zprn(ji+1,jj+1,jk) - zprn(ji  ,jj+1,jk) ) * umask(ji  ,jj+1,jk) / e1u(ji  ,jj+1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji-1,jj  ,jk) ) * umask(ji-1,jj  ,jk) / e1u(ji-1,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji  ,jj  ,jk) ) * umask(ji  ,jj  ,jk) / e1u(ji  ,jj  )
+               zphv = 1. / rau0 * zphv * zmsv * vmask(ji,jj,jk)
+
+               zmsu = 1. / MAX(  vmask(ji+1,jj  ,jk) + vmask(ji  ,jj  ,jk)   &
+                               + vmask(ji+1,jj-1,jk) + vmask(ji  ,jj-1,jk) , 1.  )
+               zphu = ( zprn(ji+1,jj+1,jk) - zprn(ji+1,jj  ,jk) ) * vmask(ji+1,jj  ,jk) / e2v(ji+1,jj  )   &
+                    + ( zprn(ji  ,jj+1,jk) - zprn(ji  ,jj  ,jk) ) * vmask(ji  ,jj  ,jk) / e2v(ji  ,jj  )   &
+                    + ( zprn(ji+1,jj  ,jk) - zprn(ji+1,jj-1,jk) ) * vmask(ji+1,jj-1,jk) / e2v(ji+1,jj-1)   &
+                    + ( zprn(ji  ,jj  ,jk) - zprn(ji  ,jj-1,jk) ) * vmask(ji  ,jj-1,jk) / e2v(ji  ,jj-1)
+               zphu = 1. / rau0 * zphu * zmsu * umask(ji,jj,jk)
+
+               ! Compute the geostrophic velocities
+               un(ji,jj,jk) = -2. * zphu / ( ff(ji,jj) + ff(ji  ,jj-1) )
+               vn(ji,jj,jk) =  2. * zphv / ( ff(ji,jj) + ff(ji-1,jj  ) )
+            END DO
+         END DO
+      END DO
+
+      IF(lwp) WRITE(numout,*) '         we force to zero bottom velocity'
+
+      ! Susbtract the bottom velocity (level jpk-1 for flat bottom case)
+      ! to have a zero bottom velocity
+
+      DO jk = 1, jpkm1
+         un(:,:,jk) = ( un(:,:,jk) - un(:,:,jpkm1) ) * umask(:,:,jk)
+         vn(:,:,jk) = ( vn(:,:,jk) - vn(:,:,jpkm1) ) * vmask(:,:,jk)
+      END DO
+
+      CALL lbc_lnk( un, 'U', -1. )
+      CALL lbc_lnk( vn, 'V', -1. )
+      
+      ub(:,:,:) = un(:,:,:)
+      vb(:,:,:) = vn(:,:,:)
+      
+      ! WARNING !!!!!
+      ! after initializing u and v, we need to calculate the initial streamfunction bsf.
+      ! Otherwise, only the trend will be computed and the model will blow up (inconsistency).
+      ! to do that, we call dyn_spg with a special trick:
+      ! we fill ua and va with the velocities divided by dt, and the streamfunction will be brought to the
+      ! right value assuming the velocities have been set up in one time step.
+      ! we then set bsfd to zero (first guess for next step is d(psi)/dt = 0.)
+      !  sets up s false trend to calculate the barotropic streamfunction.
+
+      ua(:,:,:) = ub(:,:,:) / rdt
+      va(:,:,:) = vb(:,:,:) / rdt
+
+      ! calls dyn_spg. we assume euler time step, starting from rest.
+      indic = 0
+      CALL dyn_spg( nit000, indic )       ! surface pressure gradient
+
+      ! the new velocity is ua*rdt
+
+      CALL lbc_lnk( ua, 'U', -1. )
+      CALL lbc_lnk( va, 'V', -1. )
+
+      ub(:,:,:) = ua(:,:,:) * rdt
+      vb(:,:,:) = va(:,:,:) * rdt
+      ua(:,:,:) = 0.e0
+      va(:,:,:) = 0.e0
+      un(:,:,:) = ub(:,:,:)
+      vn(:,:,:) = vb(:,:,:)
+       
+      ! Compute the divergence and curl
+
+      CALL div_cur( nit000 )            ! now horizontal divergence and curl
+
+      hdivb(:,:,:) = hdivn(:,:,:)       ! set the before to the now value
+      rotb (:,:,:) = rotn (:,:,:)       ! set the before to the now value
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zprn)
+      !
+   END SUBROUTINE istate_uvg
+
+   !!=====================================================================
+END MODULE istate
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90	(revision 3437)
@@ -0,0 +1,193 @@
+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 = 7.292115083046061e-5_wp ,  &  !: change the last digit!
+   REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter
+   REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter)
+   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 water (Kelvin)
+#if defined key_lim3
+   REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin)
+   REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin)
+#else
+   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)
+#endif
+
+#if defined key_cice
+   REAL(wp), PUBLIC ::   rau0     = 1026._wp      !: reference volumic mass (density)  (kg/m3)
+#else
+   REAL(wp), PUBLIC ::   rau0     = 1035._wp      !: reference volumic mass (density)  (kg/m3)
+#endif
+   REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg)
+   REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat
+   REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp )
+
+#if defined key_lim3 || defined key_cice
+   REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow
+   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice
+   REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice
+   REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1)
+   REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1)
+   REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3)
+   REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity
+#else
+   REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow
+   REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice
+   REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow
+   REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice
+   REAL(wp), PUBLIC ::   lfus    =   0.3337e+6    !: latent heat of fusion of fresh ice   (J.kg-1) 	
+   REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow
+   REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice
+   REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow
+   REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3)
+#endif
+   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       !: reference salinity of ice (psu)
+   REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference 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 
+   !!----------------------------------------------------------------------
+   !! 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 :   Print model parameters and set and print the constants
+      !!----------------------------------------------------------------------
+      CHARACTER (len=64) ::   cform = "(A12, 3(A13, I7) )" 
+      !!----------------------------------------------------------------------
+
+      !                                   ! Define additional parameters
+      rsiyea = 365.25 * rday * 2. * rpi / 6.283076
+      rsiday = rday / ( 1. + rday / rsiyea )
+#if defined key_cice
+      omega =  7.292116e-05
+#else
+      omega  = 2. * rpi / rsiday 
+#endif
+
+      rau0r  = 1. /   rau0  
+      ro0cpr = 1. / ( rau0 * rcp )
+
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants'
+         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, '   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
+         WRITE(numout,*)
+         WRITE(numout,*) '       Constants'
+         WRITE(numout,*)
+         WRITE(numout,*) '          mathematical constant                 rpi = ', rpi
+         WRITE(numout,*) '          day                                rday   = ', rday,   ' s'
+         WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s'
+         WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s'
+         WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1'
+         WRITE(numout,*)
+         WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months'
+         WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours'
+         WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn'
+         WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s'
+         WRITE(numout,*)
+         WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m'
+         WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2'
+         WRITE(numout,*)
+         WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K'
+         WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K'
+         WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K'
+         WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K'
+         WRITE(numout,*)
+         WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3'
+         WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg'
+         WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp
+         WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr
+         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'
+#if defined key_lim3
+         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,*) '          latent heat of subl.  of fresh ice / snow = ', lsub    , ' J/kg'
+#elif defined key_cice
+         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' 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,*) '          volumetric latent heat fusion of snow     = ', xlsn    , ' J/m' 
+         WRITE(numout,*) '          latent heat of sublimation of snow        = ', xsn     , ' J/kg' 
+#endif
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90	(revision 3437)
@@ -0,0 +1,336 @@
+MODULE divcur
+   !!==============================================================================
+   !!                       ***  MODULE  divcur  ***
+   !! Ocean diagnostic variable : horizontal divergence and relative vorticity
+   !!==============================================================================
+   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
+   !!            4.0  ! 1991-11  (G. Madec)
+   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
+   !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
+   !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
+   !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
+   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+   !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+   !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+   !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+   !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+   !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+   !!             -   ! 2010-10  (R. Furner, G. Madec) runoff and cla added directly here
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   div_cur    : Compute the horizontal divergence and relative
+   !!                vorticity fields
+   !!----------------------------------------------------------------------
+   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 cla             ! cross land advection             (cla_div routine)
+   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_cur    ! routine called by step.F90 and istate.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_noslip_accurate
+   !!----------------------------------------------------------------------
+   !!   'key_noslip_accurate'   2nd order interior + 4th order at the coast
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE div_cur( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_cur  ***
+      !!
+      !! ** Purpose :   compute the horizontal divergence and the relative
+      !!              vorticity at before and now time-step
+      !!
+      !! ** Method  : I.  divergence :
+      !!         - save the divergence computed at the previous time-step
+      !!      (note that the Asselin filter has not been applied on hdivb)
+      !!         - compute the now divergence given by :
+      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!              II. vorticity :
+      !!         - save the curl computed at the previous time-step
+      !!            rotb = rotn
+      !!      (note that the Asselin time filter has not been applied to rotb)
+      !!         - compute the now curl in tensorial formalism:
+      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
+      !!         - Coastal boundary condition: 'key_noslip_accurate' defined,
+      !!      the no-slip boundary condition is computed using Schchepetkin
+      !!      and O'Brien (1996) scheme (i.e. 4th order at the coast).
+      !!      For example, along east coast, the one-sided finite difference
+      !!      approximation used for di[v] is:
+      !!         di[e2v vn] =  1/(e1f*e2f) * ( (e2v vn)(i) + (e2v vn)(i-1) + (e2v vn)(i-2) )
+      !!
+      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
+      !!              - update rotb , rotn , the before & now rel. vorticity
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk, jl           ! dummy loop indices
+      INTEGER ::   ii, ij, ijt, iju, ierr   ! local integer
+      REAL(wp) ::  zraur, zdep              ! local scalar
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwu   ! specific 2D workspace
+      REAL(wp), POINTER,  DIMENSION(:,:) ::   zwv   ! specific 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('div_cur')
+      !
+      CALL wrk_alloc( jpi  , jpj+2, zwu               )
+      CALL wrk_alloc( jpi+4, jpj  , zwv, kjstart = -1 )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case'
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
+         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
+         !
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               hdivn(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)  )    &
+                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
+            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
+            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
+            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
+         ENDIF
+
+         !                                             ! --------
+         ! relative vorticity                          !   rot 
+         !                                             ! --------
+         ! contravariant velocity (extended for lateral b.c.)
+         ! inside the model domain
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwu(ji,jj) = e1u(ji,jj) * un(ji,jj,jk)
+               zwv(ji,jj) = e2v(ji,jj) * vn(ji,jj,jk)
+            END DO  
+         END DO  
+ 
+         ! East-West boundary conditions
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN
+            zwv(  0  ,:) = zwv(jpi-2,:)
+            zwv( -1  ,:) = zwv(jpi-3,:)
+            zwv(jpi+1,:) = zwv(  3  ,:)
+            zwv(jpi+2,:) = zwv(  4  ,:)
+         ELSE
+            zwv(  0  ,:) = 0.e0
+            zwv( -1  ,:) = 0.e0
+            zwv(jpi+1,:) = 0.e0
+            zwv(jpi+2,:) = 0.e0
+         ENDIF
+
+         ! North-South boundary conditions
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            ! north fold ( Grid defined with a T-point pivot) ORCA 2 degre
+            zwu(jpi,jpj+1) = 0.e0
+            zwu(jpi,jpj+2) = 0.e0
+            DO ji = 1, jpi-1
+               iju = jpi - ji + 1
+               zwu(ji,jpj+1) = - zwu(iju,jpj-3)
+               zwu(ji,jpj+2) = - zwu(iju,jpj-4)
+            END DO
+         ELSEIF( nperio == 5 .OR. nperio == 6 ) THEN
+            ! north fold ( Grid defined with a F-point pivot) ORCA 0.5 degre\
+            zwu(jpi,jpj+1) = 0.e0
+            zwu(jpi,jpj+2) = 0.e0
+            DO ji = 1, jpi-1
+               iju = jpi - ji
+               zwu(ji,jpj  ) = - zwu(iju,jpj-1)
+               zwu(ji,jpj+1) = - zwu(iju,jpj-2)
+               zwu(ji,jpj+2) = - zwu(iju,jpj-3)
+            END DO
+            DO ji = -1, jpi+2
+               ijt = jpi - ji + 1
+               zwv(ji,jpj) = - zwv(ijt,jpj-2)
+            END DO
+            DO ji = jpi/2+1, jpi+2
+               ijt = jpi - ji + 1
+               zwv(ji,jpjm1) = - zwv(ijt,jpjm1)
+            END DO
+         ELSE
+            ! closed
+            zwu(:,jpj+1) = 0.e0
+            zwu(:,jpj+2) = 0.e0
+         ENDIF
+
+         ! relative vorticity (vertical component of the velocity curl) 
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               rotn(ji,jj,jk) = (  zwv(ji+1,jj  ) - zwv(ji,jj)      &
+                  &              - zwu(ji  ,jj+1) + zwu(ji,jj)  ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
+            END DO
+         END DO
+
+         ! second order accurate scheme along straight coast
+         DO jl = 1, npcoa(1,jk)
+            ii = nicoa(jl,1,jk)
+            ij = njcoa(jl,1,jk)
+            rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) )   &
+                           * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) )
+         END DO
+         DO jl = 1, npcoa(2,jk)
+            ii = nicoa(jl,2,jk)
+            ij = njcoa(jl,2,jk)
+            rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij))   &
+               *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij))
+         END DO
+         DO jl = 1, npcoa(3,jk)
+            ii = nicoa(jl,3,jk)
+            ij = njcoa(jl,3,jk)
+            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
+               * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) )
+         END DO
+         DO jl = 1, npcoa(4,jk)
+            ii = nicoa(jl,4,jk)
+            ij = njcoa(jl,4,jk)
+            rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) )   &
+               * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) )
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (Update Hor. divergence)
+      
+      ! 4. Lateral boundary conditions on hdivn and rotn
+      ! ---------------------------------=======---======
+      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )    ! lateral boundary cond. (no sign change)
+      !
+      CALL wrk_dealloc( jpi  , jpj+2, zwu               )
+      CALL wrk_dealloc( jpi+4, jpj  , zwv, kjstart = -1 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
+      !
+   END SUBROUTINE div_cur
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                           2nd order centered schemes
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE div_cur( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE div_cur  ***
+      !!                    
+      !! ** Purpose :   compute the horizontal divergence and the relative
+      !!      vorticity at before and now time-step
+      !!
+      !! ** Method  : - Divergence:
+      !!      - save the divergence computed at the previous time-step
+      !!      (note that the Asselin filter has not been applied on hdivb)
+      !!      - compute the now divergence given by :
+      !!         hdivn = 1/(e1t*e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] )
+      !!      correct hdiv with runoff inflow (div_rnf) and cross land flow (div_cla) 
+      !!              - Relavtive Vorticity :
+      !!      - save the curl computed at the previous time-step (rotb = rotn)
+      !!      (note that the Asselin time filter has not been applied to rotb)
+      !!      - compute the now curl in tensorial formalism:
+      !!            rotn = 1/(e1f*e2f) ( di[e2v vn] - dj[e1u un] )
+      !!      Note: Coastal boundary condition: lateral friction set through
+      !!      the value of fmask along the coast (see dommsk.F90) and shlat
+      !!      (namelist parameter)
+      !!
+      !! ** Action  : - update hdivb, hdivn, the before & now hor. divergence
+      !!              - update rotb , rotn , the before & now rel. vorticity
+      !!----------------------------------------------------------------------
+      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_cur')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   relative vorticity'
+      ENDIF
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         hdivb(:,:,jk) = hdivn(:,:,jk)    ! time swap of div arrays
+         rotb (:,:,jk) = rotn (:,:,jk)    ! time swap of rot arrays
+         !
+         !                                             ! --------
+         ! Horizontal divergence                       !   div 
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               hdivn(ji,jj,jk) =   &
+                  (  e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk)       &
+                   + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk)  )    &
+                  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO  
+         END DO  
+
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east
+            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west
+            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north
+            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south
+         ENDIF
+
+         !                                             ! --------
+         ! relative vorticity                          !   rot 
+         !                                             ! --------
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               rotn(ji,jj,jk) = (  e2v(ji+1,jj  ) * vn(ji+1,jj  ,jk) - e2v(ji,jj) * vn(ji,jj,jk)    &
+                  &              - e1u(ji  ,jj+1) * un(ji  ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk)  ) &
+                  &           * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field)
+      IF( nn_cla == 1 )   CALL cla_div    ( kt )             ! Cross Land Advection (update hdivn field)
+      !
+      CALL lbc_lnk( hdivn, 'T', 1. )   ;   CALL lbc_lnk( rotn , 'F', 1. )     ! lateral boundary cond. (no sign change)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('div_cur')
+      !
+   END SUBROUTINE div_cur
+   
+#endif
+   !!======================================================================
+END MODULE divcur
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90	(revision 3437)
@@ -0,0 +1,133 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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
+ 
+   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    !: vector form flag
+   LOGICAL, PUBLIC ::   ln_dynadv_cen2 = .FALSE.   !: flux form - 2nd order centered scheme flag
+   LOGICAL, PUBLIC ::   ln_dynadv_ubs  = .FALSE.   !: flux form - 3rd order UBS scheme flag
+   
+   INTEGER ::   nadv   ! choice of the formulation and scheme for the advection
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 )    ! vector form : horizontal gradient of kinetic energy
+                      CALL dyn_zad     ( kt )    ! vector form : vertical advection
+      CASE ( 1 ) 
+                      CALL dyn_adv_cen2( kt )    ! 2nd order centered scheme
+      CASE ( 2 )   
+                      CALL dyn_adv_ubs ( kt )    ! 3rd order UBS      scheme
+      !
+      CASE (-1 )                                 ! esopa: test all possibility with control print
+                      CALL dyn_keg     ( kt )
+                      CALL dyn_zad     ( kt )
+                      CALL dyn_adv_cen2( kt )
+                      CALL dyn_adv_ubs ( kt )
+      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
+      !!
+      NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )               ! Read Namelist namdyn_adv : momentum advection scheme
+      READ   ( numnam, 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,*) '          2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2
+         WRITE(numout,*) '          3rd order UBS advection scheme     ln_dynadv_ubs  = ', ln_dynadv_ubs
+      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( lk_esopa       )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' )
+
+      !                               ! Set nadv
+      IF( ln_dynadv_vec  )   nadv =  0 
+      IF( ln_dynadv_cen2 )   nadv =  1
+      IF( ln_dynadv_ubs  )   nadv =  2
+      IF( lk_esopa       )   nadv = -1
+
+      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,*) '         flux form   : 2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         flux form   : UBS       scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection formulation'
+      ENDIF
+      !
+   END SUBROUTINE dyn_adv_init
+
+  !!======================================================================
+END MODULE dynadv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90	(revision 3437)
@@ -0,0 +1,168 @@
+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)
+   !!                        trends using a 2nd order centred scheme  
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE trdmod_oce     ! ocean variables trends
+   USE trdmod         ! ocean dynamics trends
+   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 "domzgr_substitute.h90"
+#  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) ::   zbu, zbv     ! local scalars
+      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           ! Save ua and va trends
+         zfu_uw(:,:,:) = ua(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:)
+      ENDIF
+
+      !                                      ! ====================== !
+      !                                      !  Horizontal advection  !
+      DO jk = 1, jpkm1                       ! ====================== !
+         !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,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.
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               !
+               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)  ) / zbu
+               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)  ) / zbv
+            END DO
+         END DO
+      END DO
+      !
+      IF( l_trddyn ) THEN                          ! save the horizontal advection trend for diagnostic
+         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
+         CALL trd_mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt )
+         zfu_t(:,:,:) = ua(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:)
+      ENDIF
+      !
+
+      !                                      ! ==================== !
+      !                                      !  Vertical advection  !
+      DO jk = 1, jpkm1                       ! ==================== !
+         !                                         ! Vertical volume fluxesÊ
+         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
+         !
+         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
+            zfu_uw(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
+            zfv_vw(:,:,jpk) = 0.e0
+            !                                           ! Surface value :
+            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
+               zfu_uw(:,:, 1 ) = 0.e0    
+               zfv_vw(:,:, 1 ) = 0.e0
+            ELSE                                             ! constant volume : advection through the surface
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zfu_uw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji+1,jj  ,1) ) * un(ji,jj,1)
+                     zfv_vw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji  ,jj+1,1) ) * vn(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ELSE                                      ! interior fluxes
+            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
+         ENDIF
+      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) )    &
+                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
+                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(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_mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90	(revision 3437)
@@ -0,0 +1,261 @@
+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 trdmod         ! ocean dynamics trends
+   USE trdmod_oce     ! ocean variables trends
+   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/8._wp  ! =0   2nd order  ; =1/8  4th order centred
+
+   PUBLIC   dyn_adv_ubs   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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/8  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/8.
+      !!
+      !! ** 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) ::   zbu, zbv    ! temporary scalars
+      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary 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           ! Save ua and va trends
+         zfu_uw(:,:,:) = ua(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:)
+      ENDIF
+
+      !                                      ! =========================== !
+      DO jk = 1, jpkm1                       !  Laplacian of the velocity  !
+         !                                   ! =========================== !
+         !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = e1v(:,:) * fse3v(:,:,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)-2.*ub (ji,jj,jk)+ub (ji,jj-1,jk) ) * umask(ji,jj,jk)
+               zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj,jk)-2.*vb (ji,jj,jk)+vb (ji-1,jj,jk) ) * vmask(ji,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)-2.*zfu(ji,jj,jk)+zfu(ji,jj-1,jk) ) * umask(ji,jj,jk)
+               zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj,jk)-2.*zfv(ji,jj,jk)+zfv(ji-1,jj,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+!!gm BUG !!!  just below this should be +1 in all the communications
+!      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.)
+!
+!!gm corrected:
+      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. ) 
+!!gm end
+      
+      !                                      ! ====================== !
+      !                                      !  Horizontal advection  !
+      DO jk = 1, jpkm1                       ! ====================== !
+         !                                         ! horizontal volume fluxes
+         zfu(:,:,jk) = 0.25 * e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zfv(:,:,jk) = 0.25 * e1v(:,:) * fse3v(:,:,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.
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               !
+               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)  ) / zbu
+               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)  ) / zbv
+            END DO
+         END DO
+      END DO
+      IF( l_trddyn ) THEN                          ! save the horizontal advection trend for diagnostic
+         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:)
+         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:)
+         CALL trd_mod( zfu_uw, zfv_vw, jpdyn_trd_had, 'DYN', kt )
+         zfu_t(:,:,:) = ua(:,:,:)
+         zfv_t(:,:,:) = va(:,:,:)
+      ENDIF
+
+      !                                      ! ==================== !
+      !                                      !  Vertical advection  !
+      DO jk = 1, jpkm1                       ! ==================== !
+         !                                         ! Vertical volume fluxesÊ
+         zfw(:,:,jk) = 0.25 * e1t(:,:) * e2t(:,:) * wn(:,:,jk)
+         !
+         IF( jk == 1 ) THEN                        ! surface/bottom advective fluxes                   
+            zfu_uw(:,:,jpk) = 0.e0                      ! Bottom  value : flux set to zero
+            zfv_vw(:,:,jpk) = 0.e0
+            !                                           ! Surface value :
+            IF( lk_vvl ) THEN                                ! variable volume : flux set to zero
+               zfu_uw(:,:, 1 ) = 0.e0    
+               zfv_vw(:,:, 1 ) = 0.e0
+            ELSE                                             ! constant volume : advection through the surface
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     zfu_uw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji+1,jj  ,1) ) * un(ji,jj,1)
+                     zfv_vw(ji,jj, 1 ) = 2.e0 * ( zfw(ji,jj,1) + zfw(ji  ,jj+1,1) ) * vn(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ELSE                                      ! interior fluxes
+            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
+         ENDIF
+      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) )    &
+                  &  / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) )    &
+                  &  / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(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_mod( zfu_t, zfv_t, jpdyn_trd_zad, 'DYN', 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynbfr.F90	(revision 3437)
@@ -0,0 +1,105 @@
+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 trdmod          ! ocean active dynamics and tracers trends 
+   USE trdmod_oce      ! ocean variables trends
+   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 "domzgr_substitute.h90"
+#  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 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')
+      !
+      IF( .NOT.ln_bfrimp) THEN     ! only for explicit bottom friction form
+                                    ! implicit bfr is implemented in dynzdf_imp
+
+        zm1_2dt = - 1._wp / ( 2._wp * rdt )
+
+        IF( l_trddyn )   THEN                      ! temporary save of ua and va trends
+           CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )
+           ztrdu(:,:,:) = ua(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:)
+        ENDIF
+
+
+# if defined key_vectopt_loop
+        DO jj = 1, 1
+           DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1
+# endif
+              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) / fse3u(ji,jj,ikbu) , zm1_2dt  ) * ub(ji,jj,ikbu)
+              va(ji,jj,ikbv) = va(ji,jj,ikbv) + MAX(  bfrva(ji,jj) / fse3v(ji,jj,ikbv) , zm1_2dt  ) * vb(ji,jj,ikbv)
+           END DO
+        END DO
+
+        !
+        IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
+           ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+           ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+           CALL trd_mod( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_trd_bfr, 'DYN', kt )
+           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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90	(revision 3437)
@@ -0,0 +1,1131 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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_djc  : s-coordinate (Density Jacobian with Cubic polynomial)
+   !!       hpg_prj  : s-coordinate (Pressure Jacobian with Cubic polynomial)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE lbclnk          ! lateral boundary condition 
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   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    = .TRUE.    !: z-coordinate - full steps
+   LOGICAL , PUBLIC ::   ln_hpg_zps    = .FALSE.   !: z-coordinate - partial steps (interpolation)
+   LOGICAL , PUBLIC ::   ln_hpg_sco    = .FALSE.   !: s-coordinate (standard jacobian formulation)
+   LOGICAL , PUBLIC ::   ln_hpg_djc    = .FALSE.   !: s-coordinate (Density Jacobian with Cubic polynomial)
+   LOGICAL , PUBLIC ::   ln_hpg_prj    = .FALSE.   !: s-coordinate (Pressure Jacobian scheme)
+   LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag
+
+   INTEGER  ::   nhpg  =  0   ! = 0 to 7, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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
+      !!             - Save the trend (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)
+      END SELECT
+      !
+      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_hpg, 'DYN', 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
+      !!
+      NAMELIST/namdyn_hpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco,     &
+         &                 ln_hpg_djc, ln_hpg_prj, ln_dynhpg_imp
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )               ! Read Namelist namdyn_hpg
+      READ  ( numnam, 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. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc
+         WRITE(numout,*) '      s-coord. (Pressure Jacobian: Cubic polynomial)    ln_hpg_prj    = ', ln_hpg_prj
+         WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp
+      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( lk_vvl .AND. .NOT. (ln_hpg_sco.OR.ln_hpg_prj) )   &
+         &   CALL ctl_stop('dyn_hpg_init : variable volume key_vvl requires:&
+                           & the standard jacobian formulation hpg_sco or &
+                           & the pressure jacobian formulation hpg_prj')
+      !
+      !                               ! 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
+      !
+      !                               ! 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( ioptio /= 1 )   CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' )
+      !
+   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 * fse3w(ji,jj,1)
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) / 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 * fse3w(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) )  ) / 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) )  ) / 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
+
+
+      ! 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 * fse3w(ji,jj,1)
+            ! hydrostatic pressure gradient
+            zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) / 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 * fse3w(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) )  ) / 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) )  ) / 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)
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            iku = mbku(ji,jj)
+            ikv = mbkv(ji,jj)
+            zcoef2 = zcoef0 * MIN( fse3w(ji,jj,iku), fse3w(ji+1,jj  ,iku) )
+            zcoef3 = zcoef0 * MIN( fse3w(ji,jj,ikv), fse3w(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) ) / 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) ) / e2v(ji,jj)
+               va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend
+            ENDIF
+# if ! defined key_vectopt_loop
+         END DO
+# endif
+      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                 ! dummy loop indices
+      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj 
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zhpj )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:hpg_sco : hydrostatic pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate case, OPA original scheme used'
+      ENDIF
+
+      ! Local constant initialization
+      zcoef0 = - grav * 0.5_wp
+      ! To use density and not density anomaly
+      IF ( lk_vvl ) THEN   ;     znad = 1._wp          ! Variable volume
+      ELSE                 ;     znad = 0._wp         ! Fixed volume
+      ENDIF
+
+      ! Surface value
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.   
+            ! hydrostatic pressure gradient along s-surfaces
+            zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( fse3w(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )   &
+               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
+            zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( fse3w(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )   &
+               &                                  - fse3w(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) ) )
+            ! s-coordinate pressure gradient correction
+            zuap = -zcoef0 * ( rhd   (ji+1,jj,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
+               &           * ( fsde3w(ji+1,jj,1) - fsde3w(ji,jj,1) ) / e1u(ji,jj)
+            zvap = -zcoef0 * ( rhd   (ji,jj+1,1) + rhd   (ji,jj,1) + 2._wp * znad )   &
+               &           * ( fsde3w(ji,jj+1,1) - fsde3w(ji,jj,1) ) / e2v(ji,jj)
+            ! add to the general momentum trend
+            ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap
+            va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap
+         END DO  
+      END DO   
+            
+      ! interior value (2=<jk=<jpkm1)
+      DO jk = 2, jpkm1                                  
+         DO jj = 2, jpjm1     
+            DO ji = fs_2, fs_jpim1   ! vector opt.      
+               ! hydrostatic pressure gradient along s-surfaces
+               zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
+                  &           * (  fse3w(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
+                  &              - fse3w(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  )
+               zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   &
+                  &           * (  fse3w(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   &
+                  &              - fse3w(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  )
+               ! s-coordinate pressure gradient correction
+               zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk) ) / e1u(ji,jj)
+               zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   &
+                  &           * ( fsde3w(ji  ,jj+1,jk) - fsde3w(ji,jj,jk) ) / e2v(ji,jj)
+               ! add to the general momentum trend
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap
+               va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zhpj )
+      !
+   END SUBROUTINE hpg_sco
+
+   SUBROUTINE hpg_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   !    "         "
+      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
+      !!----------------------------------------------------------------------
+      !
+      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( 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) = fsde3w(ji  ,jj  ,jk) - fsde3w(ji,jj,jk-1)
+               drhox(ji,jj,jk) = rhd   (ji+1,jj  ,jk) - rhd   (ji,jj,jk  )
+               dzx  (ji,jj,jk) = fsde3w(ji+1,jj  ,jk) - fsde3w(ji,jj,jk  )
+               drhoy(ji,jj,jk) = rhd   (ji  ,jj+1,jk) - rhd   (ji,jj,jk  )
+               dzy  (ji,jj,jk) = fsde3w(ji  ,jj+1,jk) - fsde3w(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-de3w = 0.5*e3w  ....  and de3w(2)-de3w(1)=e3w(2) ....   to be verified
+!          true if de3w 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 * ( fse3w(ji,jj,1) - fsde3w(ji,jj,1) )               &
+               &                   * (  rhd(ji,jj,1)                                    &
+               &                     + 0.5_wp * ( rhd(ji,jj,2) - rhd(ji,jj,1) )         &
+               &                              * ( fse3w (ji,jj,1) - fsde3w(ji,jj,1) )   &
+               &                              / ( fsde3w(ji,jj,2) - fsde3w(ji,jj,1) )  ) 
+         END DO
+      END DO
+
+!!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) )                                   &
+                  &                     * ( fsde3w(ji,jj,jk) - fsde3w(ji,jj,jk-1) )                                   &
+                  &            - grav * z1_10 * (                                                                     &
+                  &     ( drhow (ji,jj,jk) - drhow (ji,jj,jk-1) )                                                     &
+                  &   * ( fsde3w(ji,jj,jk) - fsde3w(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) )                                   &
+                  &                     * ( fsde3w(ji+1,jj,jk) - fsde3w(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                      &
+                  &     ( drhou (ji+1,jj,jk) - drhou (ji,jj,jk) )                                                     &
+                  &   * ( fsde3w(ji+1,jj,jk) - fsde3w(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) )                                   &
+                  &                     * ( fsde3w(ji,jj+1,jk) - fsde3w(ji,jj,jk) )                                   &
+                  &            - grav* z1_10 * (                                                                      &
+                  &     ( drhov (ji,jj+1,jk) - drhov (ji,jj,jk) )                                                     &
+                  &   * ( fsde3w(ji,jj+1,jk) - fsde3w(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) ) / e1u(ji,jj)
+            zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) / 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.
+               ! 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) )  ) / 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) )  ) / 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, 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        ) 
+      !
+   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
+      !!             - Save the trend (l_trddyn=T)
+      !!
+      !!----------------------------------------------------------------------
+      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                    ! temporary scalars
+      !!
+      !! The local variables for the correction term
+      INTEGER  :: jk1, jis, jid, jjs, jjd
+      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
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 
+      CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 
+      !
+      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 = 0.0_wp
+      IF( lk_vvl ) znad = 1._wp
+
+      ! 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 = mbathy(ji,jj)
+          IF( jk <= 0 ) THEN; zrhh(ji,jj,:) = 0._wp
+          ELSE IF(jk == 1) THEN; zrhh(ji,jj, jk+1:jpk) = rhd(ji,jj,jk)
+          ELSE IF(jk < jpkm1) THEN
+             DO jkk = jk+1, jpk
+                zrhh(ji,jj,jkk) = interp1(fsde3w(ji,jj,jkk),   fsde3w(ji,jj,jkk-1), &
+                                         fsde3w(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 * fse3w(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) + fse3w(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 * fse3w(ji,jj,1)
+
+          ! assuming linear profile across the top half surface layer
+          zhpi(ji,jj,1) =  0.5_wp * fse3w(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)
+      DO jj = 2, jpjm1     
+        DO ji = 2, jpim1  
+          zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshu_n(ji,jj) * znad)
+          zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshv_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)- fse3u(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk-1)- fse3v(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 * fse3u(ji,jj,jk)
+            zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * fse3v(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 / e1u(ji,jj) * (zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk))
+               IF( lk_vvl ) THEN
+                 zdpdx2 = zcoef0 / e1u(ji,jj) * & 
+                         ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 
+                ELSE
+                 zdpdx2 = zcoef0 / e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
+               ENDIF
+
+               ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * &
+               &           umask(ji,jj,jk) * tmask(ji,jj,jk) * tmask(ji+1,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 / e2v(ji,jj) * (zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk))
+               IF( lk_vvl ) THEN
+                   zdpdy2 = zcoef0 / e2v(ji,jj) * &
+                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
+               ELSE
+                   zdpdy2 = zcoef0 / e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
+               ENDIF
+
+               va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2)*&
+               &              vmask(ji,jj,jk)*tmask(ji,jj,jk)*tmask(ji,jj+1,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 ) 
+      !
+   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
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      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
+
+      ! Local Variables      
+      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))
+      !!----------------------------------------------------------------------
+
+      jpi   = size(fsp,1)
+      jpj   = size(fsp,2)
+      jpkm1 = 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
+ 
+      ELSE IF (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) 
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      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
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      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
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      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 
+      !!
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90	(revision 3437)
@@ -0,0 +1,147 @@
+MODULE dynkeg
+   !!======================================================================
+   !!                       ***  MODULE  dynkeg  ***
+   !! Ocean dynamics:  kinetic energy gradient trend
+   !!======================================================================
+   !! History :  1.0  !  87-09  (P. Andrich, m.-a. Foujols)  Original code
+   !!            7.0  !  97-05  (G. Madec)  Split dynber into dynkeg and dynhpg
+   !!            9.0  !  02-07  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   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 trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   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_keg    ! routine called by step 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 dyn_keg( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  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  :   Compute the now horizontal kinetic energy 
+      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^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
+      !!             - save this trends (l_trddyn=T) for post-processing
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zu, zv       ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zhke
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 
+      !!----------------------------------------------------------------------
+      !
+      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'
+         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
+      
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpj         ! Horizontal kinetic energy at T-point
+            DO ji = fs_2, jpi   ! vector opt.
+               zu = 0.25 * (  un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+                  &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)  )
+               zv = 0.25 * (  vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+                  &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)  )
+               zhke(ji,jj,jk) = zv + zu
+!!gm simplier coding  ==>>   ~ faster
+!    don't forget to suppress local zu zv scalars
+!               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+!                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
+!                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+!                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   )
+!!gm end <<==
+            END DO  
+         END DO  
+         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
+            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
+!!gm idea to be tested  ==>>   is it faster on scalar computers ?
+!         DO jj = 2, jpjm1       ! add the gradient of kinetic energy to the general momentum trends
+!            DO ji = fs_2, fs_jpim1   ! vector opt.
+!               ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj  ,jk) * un(ji+1,jj  ,jk)   &
+!                  &                                   + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk)   &
+!                  &                                   + vn(ji+1,jj  ,jk) * vn(ji+1,jj  ,jk)   &
+!                  !
+!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+!                  &                                   - vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   &
+!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e1u(ji,jj)
+!                  !
+!               va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * (   un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk)   &
+!                  &                                   + un(ji  ,jj+1,jk) * un(ji  ,jj+1,jk)   &
+!                  &                                   + vn(ji  ,jj+1,jk) * vn(ji  ,jj+1,jk)   &
+!                  !
+!                  &                                   - un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   &
+!                  &                                   - un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   &
+!                  &                                   - vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) / e2v(ji,jj)
+!            END DO 
+!         END DO
+!!gm en idea            <<==
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      IF( l_trddyn ) THEN      ! save the Kinetic Energy trends for diagnostic
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_keg, 'DYN', 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90	(revision 3437)
@@ -0,0 +1,233 @@
+MODULE dynldf
+   !!======================================================================
+   !!                       ***  MODULE  dynldf  ***
+   !! Ocean physics:  lateral diffusivity trends 
+   !!=====================================================================
+   !! History :  9.0  !  05-11  (G. Madec)  Original code (new step architecture)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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_oce     ! ocean dynamics lateral physics
+   USE ldfslp         ! lateral mixing: slopes of mixing orientation
+   USE dynldf_bilapg  ! lateral mixing            (dyn_ldf_bilapg routine)
+   USE dynldf_bilap   ! lateral mixing            (dyn_ldf_bilap  routine)
+   USE dynldf_iso     ! lateral mixing            (dyn_ldf_iso    routine)
+   USE dynldf_lap     ! lateral mixing            (dyn_ldf_lap    routine)
+   USE trdmod         ! ocean dynamics and tracer trends
+   USE trdmod_oce     ! ocean variables 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   dyn_ldf       ! called by step module 
+   PUBLIC   dyn_ldf_init  ! called by opa  module 
+
+   INTEGER ::   nldf = -2   ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $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 ta and sa 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 ( 0 )    ;   CALL dyn_ldf_lap    ( kt )      ! iso-level laplacian
+      CASE ( 1 )    ;   CALL dyn_ldf_iso    ( kt )      ! rotated laplacian (except dk[ dk[.] ] part)
+      CASE ( 2 )    ;   CALL dyn_ldf_bilap  ( kt )      ! iso-level bilaplacian
+      CASE ( 3 )    ;   CALL dyn_ldf_bilapg ( kt )      ! s-coord. horizontal bilaplacian
+      CASE ( 4 )                                        ! iso-level laplacian + bilaplacian
+         CALL dyn_ldf_lap    ( kt )
+         CALL dyn_ldf_bilap  ( kt )
+      CASE ( 5 )                                        ! rotated laplacian + bilaplacian (s-coord)
+         CALL dyn_ldf_iso    ( kt )
+         CALL dyn_ldf_bilapg ( kt )
+      !
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+                        CALL dyn_ldf_lap    ( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf0 - Ua: ', mask1=umask,   &
+            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                        CALL dyn_ldf_iso    ( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf1 - Ua: ', mask1=umask,   &
+            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                        CALL dyn_ldf_bilap  ( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask,   &
+            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                        CALL dyn_ldf_bilapg ( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask,   &
+            &                         tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      !
+      CASE ( -2 )                                       ! neither laplacian nor bilaplacian schemes used
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'dyn_ldf : no lateral diffusion on momentum setup'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+      END SELECT
+
+      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_ldf, 'DYN', 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_bilap = ', ln_dynldf_bilap
+         WRITE(numout,*) '          iso-level                   ln_dynldf_level = ', ln_dynldf_level
+         WRITE(numout,*) '          horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor
+         WRITE(numout,*) '          iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso
+      ENDIF
+
+      !                                   ! control the consistency
+      ioptio = 0
+      IF( ln_dynldf_lap   )   ioptio = ioptio + 1
+      IF( ln_dynldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio <  1 ) CALL ctl_warn( '          neither laplacian nor bilaplacian operator set for dynamics' )
+      ioptio = 0
+      IF( ln_dynldf_level )   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)' )
+
+      !                                   ! 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_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_dynldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_dynldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_dynldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_dynldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_dynldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_dynldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+      
+      IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN  ! mixed laplacian and bilaplacian operators
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_dynldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_dynldf_hor   )   nldf = 4      ! horizontal (no rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! s-coordinate
+            IF ( ln_dynldf_level )   nldf = 4      ! iso-level  (no rotation)
+            IF ( ln_dynldf_hor   )   nldf = 5      ! horizontal (   rotation)
+            IF ( ln_dynldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( lk_esopa )                 nldf = -1     ! esopa test
+
+      IF( ierr == 1 )   CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' )
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '              neither laplacian nor bilaplacian schemes used'
+         IF( nldf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '              laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '              rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '              bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '              rotated bilaplacian'
+         IF( nldf ==  4 )   WRITE(numout,*) '              laplacian and bilaplacian operators'
+         IF( nldf ==  5 )   WRITE(numout,*) '              rotated laplacian and bilaplacian operators'
+      ENDIF
+      !
+   END SUBROUTINE dyn_ldf_init
+
+   !!======================================================================
+END MODULE dynldf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90	(revision 3437)
@@ -0,0 +1,218 @@
+MODULE dynldf_bilap
+   !!======================================================================
+   !!                     ***  MODULE  dynldf_bilap  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+   !! History :  OPA  ! 1990-09  (G. Madec)  Original code
+   !!            4.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon)
+   !!            6.0  ! 1996-01  (G. Madec)  statement function for e3
+   !!            8.0  ! 1997-07  (G. Madec)  lbc calls
+   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  ! 2004-08  (C. Talandier) New trends organization
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_bilap : update the momentum trend with the lateral diffusion
+   !!                   using an iso-level bilaplacian operator
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_ldf_bilap   ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_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 dyn_ldf_bilap( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_bilap  ***
+      !!
+      !! ** Purpose :   Compute the before trend of the lateral momentum
+      !!      diffusion and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The before horizontal momentum diffusion trend is a 
+      !!      bi-harmonic operator (bilaplacian type) which separates the
+      !!      divergent and rotational parts of the flow.
+      !!      Its horizontal components are computed as follow:
+      !!      laplacian:
+      !!          zlu = 1/e1u di[ hdivb ] - 1/(e2u*e3u) dj-1[ e3f rotb ]
+      !!          zlv = 1/e2v dj[ hdivb ] + 1/(e1v*e3v) di-1[ e3f rotb ]
+      !!      third derivative:
+      !!       * multiply by the eddy viscosity coef. at u-, v-point, resp.
+      !!          zlu = ahmu * zlu
+      !!          zlv = ahmv * zlv
+      !!       * curl and divergence of the laplacian
+      !!          zuf = 1/(e1f*e2f) ( di[e2v zlv] - dj[e1u zlu] )
+      !!          zut = 1/(e1t*e2t*e3t) ( di[e2u*e3u zlu] + dj[e1v*e3v zlv] )
+      !!      bilaplacian:
+      !!              diffu = 1/e1u di[ zut ] - 1/(e2u*e3u) dj-1[ e3f zuf ]
+      !!              diffv = 1/e2v dj[ zut ] + 1/(e1v*e3v) di-1[ e3f zuf ]
+      !!      If ln_sco=F and ln_zps=F, the vertical scale factors in the
+      !!      rotational part of the diffusion are simplified
+      !!      Add this before trend to the general trend (ua,va):
+      !!            (ua,va) = (ua,va) + (diffu,diffv)
+      !!      'key_trddyn' defined: the two components of the horizontal
+      !!                               diffusion trend are saved.
+      !!
+      !! ** Action : - Update (ua,va) with the before iso-level biharmonic
+      !!               mixing trend.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
+      REAL(wp) ::   zua, zva, zbt, ze2u, ze2v   ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zcu, zcv
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zuf, zut, zlu, zlv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilap')
+      !
+      CALL wrk_alloc( jpi, jpj,      zcu, zcv           )
+      CALL wrk_alloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
+      !
+      IF( kt == nit000 .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_ldf_bilap : iso-level bilaplacian operator'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+!!bug gm this should be enough
+!!$      zuf(:,:,jpk) = 0.e0
+!!$      zut(:,:,jpk) = 0.e0
+!!$      zlu(:,:,jpk) = 0.e0
+!!$      zlv(:,:,jpk) = 0.e0
+      zuf(:,:,:) = 0._wp
+      zut(:,:,:) = 0._wp
+      zlu(:,:,:) = 0._wp
+      zlv(:,:,:) = 0._wp
+
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Laplacian
+         ! ---------
+
+         IF( ln_sco .OR. ln_zps ) THEN   ! s-coordinate or z-coordinate with partial steps
+            zuf(:,:,jk) = rotb(:,:,jk) * fse3f(:,:,jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) / e1u(ji,jj)
+   
+                  zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) / e2v(ji,jj)
+               END DO
+            END DO
+         ELSE                            ! z-coordinate - full step
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zlu(ji,jj,jk) = - ( rotb (ji  ,jj,jk) - rotb (ji,jj-1,jk) ) / e2u(ji,jj)   &
+                     &         + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj  ,jk) ) / e1u(ji,jj)
+   
+                  zlv(ji,jj,jk) = + ( rotb (ji,jj  ,jk) - rotb (ji-1,jj,jk) ) / e1v(ji,jj)   &
+                     &         + ( hdivb(ji,jj+1,jk) - hdivb(ji  ,jj,jk) ) / e2v(ji,jj)
+               END DO  
+            END DO  
+         ENDIF
+      END DO
+      CALL lbc_lnk( zlu, 'U', -1. )   ;   CALL lbc_lnk( zlv, 'V', -1. )   ! Boundary conditions
+
+         
+      DO jk = 1, jpkm1
+   
+         ! Third derivative
+         ! ----------------
+         
+         ! Multiply by the eddy viscosity coef. (at u- and v-points)
+         zlu(:,:,jk) = zlu(:,:,jk) * fsahmu(:,:,jk)
+         zlv(:,:,jk) = zlv(:,:,jk) * fsahmv(:,:,jk)
+         
+         ! Contravariant "laplacian"
+         zcu(:,:) = e1u(:,:) * zlu(:,:,jk)
+         zcv(:,:) = e2v(:,:) * zlv(:,:,jk)
+         
+         ! Laplacian curl ( * e3f if s-coordinates or z-coordinate with partial steps)
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zuf(ji,jj,jk) = fmask(ji,jj,jk) * (  zcv(ji+1,jj  ) - zcv(ji,jj)      &
+                  &                            - zcu(ji  ,jj+1) + zcu(ji,jj)  )   &
+                  &       * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj) )
+            END DO  
+         END DO  
+
+         ! Laplacian Horizontal fluxes
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zlu(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * zlu(ji,jj,jk)
+               zlv(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * zlv(ji,jj,jk)
+            END DO
+         END DO
+
+         ! Laplacian divergence
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vector opt.
+               zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)
+               zut(ji,jj,jk) = (  zlu(ji,jj,jk) - zlu(ji-1,jj  ,jk)   &
+                  &             + zlv(ji,jj,jk) - zlv(ji  ,jj-1,jk) ) / zbt
+            END DO
+         END DO
+      END DO
+
+
+      ! boundary conditions on the laplacian curl and div (zuf,zut)
+!!bug gm no need to do this 2 following lbc...
+      CALL lbc_lnk( zuf, 'F', 1. )
+      CALL lbc_lnk( zut, 'T', 1. )
+
+      DO jk = 1, jpkm1      
+   
+         ! Bilaplacian
+         ! -----------
+
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ze2u = e2u(ji,jj) * fse3u(ji,jj,jk)
+               ze2v = e1v(ji,jj) * fse3v(ji,jj,jk)
+               ! horizontal biharmonic diffusive trends
+               zua = - ( zuf(ji  ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u   &
+                  &  + ( zut(ji+1,jj,jk) - zut(ji,jj  ,jk) ) / e1u(ji,jj)
+
+               zva = + ( zuf(ji,jj  ,jk) - zuf(ji-1,jj,jk) ) / ze2v   &
+                  &  + ( zut(ji,jj+1,jk) - zut(ji  ,jj,jk) ) / e2v(ji,jj)
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj,      zcu, zcv           )
+      CALL wrk_dealloc( jpi, jpj, jpk, zuf, zut, zlu, zlv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilap')
+      !
+   END SUBROUTINE dyn_ldf_bilap
+
+   !!======================================================================
+END MODULE dynldf_bilap
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90	(revision 3437)
@@ -0,0 +1,474 @@
+MODULE dynldf_bilapg
+   !!======================================================================
+   !!                       ***  MODULE  dynldf_bilapg  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+   !! History :  OPA  !  1997-07  (G. Madec)  Original code
+   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
+   !!            2.0  !  2004-08  (C. Talandier) New trends organization
+   !!----------------------------------------------------------------------
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                              Rotation of mixing tensor
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_bilapg : update the momentum trend with the horizontal part
+   !!                    of the horizontal s-coord. bilaplacian diffusion
+   !!   ldfguv         : 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE ldfslp          ! iso-neutral slopes available
+   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_bilapg       ! called by step.F90
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dyn_ldf_bilapg_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE dyn_ldf_bilapg_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     &
+         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc )
+         !
+      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays')
+   END FUNCTION dyn_ldf_bilapg_alloc
+
+
+   SUBROUTINE dyn_ldf_bilapg( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE dyn_ldf_bilapg  ***
+      !!                      
+      !! ** Purpose :   Compute the before trend of the horizontal momentum
+      !!      diffusion and add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   The lateral momentum diffusive trends is provided by a 
+      !!      a 4th order operator rotated along geopotential surfaces. It is 
+      !!      computed using before fields (forward in time) and geopotential
+      !!      slopes computed in routine inildf.
+      !!         -1- compute the geopotential harmonic operator applied to
+      !!      (ub,vb) and multiply it by the eddy diffusivity coefficient
+      !!      (done by a call to ldfgpu and ldfgpv routines) The result is in
+      !!      (zwk1,zwk2) arrays. Applied the domain lateral boundary conditions
+      !!      by call to lbc_lnk.
+      !!         -2- applied to (zwk1,zwk2) the geopotential harmonic operator
+      !!      by a second call to ldfgpu and ldfgpv routines respectively. The
+      !!      result is in (zwk3,zwk4) arrays.
+      !!         -3- Add this trend to the general trend (ta,sa):
+      !!            (ua,va) = (ua,va) + (zwk3,zwk4)
+      !!      'key_trddyn' defined: the trend is saved for diagnostics.
+      !!
+      !! ** Action  : - Update (ua,va) arrays with the before geopotential
+      !!                biharmonic mixing trend.
+      !!              - save the trend in (zwk3,zwk4) ('key_trddyn')
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index
+      !
+      INTEGER ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk1, zwk2, zwk3, zwk4
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_bilapg')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+         !                                      ! allocate dyn_ldf_bilapg arrays
+         IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays')
+      ENDIF
+      !
+      zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0
+      zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0
+
+      ! Laplacian of (ub,vb) multiplied by ahm
+      ! --------------------------------------  
+      CALL ldfguv( ub, vb, zwk1, zwk2, 1 )      ! rotated harmonic operator applied to (ub,vb)
+      !                                         ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) )
+      CALL lbc_lnk( zwk1, 'U', -1. )   ;   CALL lbc_lnk( zwk2, 'V', -1. )     ! Lateral boundary conditions
+
+      ! Bilaplacian of (ub,vb)
+      ! ---------------------- 
+      CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 )  ! rotated harmonic operator applied to (zwk1,zwk2) 
+      !                                         ! (output in (zwk3,zwk4) )
+
+      ! Update the momentum trends
+      ! --------------------------
+      DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk)
+               va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_bilapg')
+      !
+   END SUBROUTINE dyn_ldf_bilapg
+
+
+   SUBROUTINE ldfguv( pu, pv, plu, plv, kahm )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldfguv  ***
+      !!      
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pu,pv)
+      !!      (defined at u- and v-points) and multiply it by the eddy
+      !!      viscosity coefficient (if kahm=1).
+      !!
+      !! ** Method  :   The harmonic operator rotated along geopotential 
+      !!      surfaces is applied to (pu,pv) using the slopes of geopotential
+      !!      surfaces computed in inildf routine. The result is provided in
+      !!      (plu,plv) arrays. It is computed in 2 stepv:
+      !!
+      !!      First step: horizontal part of the operator. It is computed on
+      !!      ==========  pu as follows (idem on pv)
+      !!      horizontal fluxes :
+      !!         zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]
+      !!         zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]
+      !!      take the horizontal divergence of the fluxes (no divided by
+      !!      the volume element :
+      !!         plu  = di-1[ zftu ] +  dj-1[ zftv ]
+      !!
+      !!      Second step: vertical part of the operator. It is computed on
+      !!      ===========  pu as follows (idem on pv)
+      !!      vertical fluxes :
+      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pu ]
+      !!              -     e2t     *       wslpi        di[ mi(mk(pu)) ]
+      !!              -     e1t     *       wslpj        dj[ mj(mk(pu)) ]
+      !!      take the vertical divergence of the fluxes add it to the hori-
+      !!      zontal component, divide the result by the volume element and
+      !!      if kahm=1, multiply by the eddy diffusivity coefficient:
+      !!         plu  = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] }
+      !!      else:
+      !!         plu  =  1  / (e1t*e2t*e3t) { plu + dk[ zftw ] }
+      !!
+      !! ** Action :
+      !!        plu, plv        : partial harmonic operator applied to
+      !!                          pu and pv (all the components except
+      !!                          second order vertical derivative term)
+      !!      'key_trddyn' defined: the trend is saved for diagnostics.
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity 
+      !                                                               ! 2nd call: ahm x these fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to
+      !                                                               ! pu and pv (all the components except
+      !                                                               ! second order vertical derivative term)
+      INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar
+      REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      -
+      REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      -
+      REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldfguv')
+      !
+      CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 
+      !
+      !                               ! ********** !   ! ===============
+      DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+         !                            ! ********** !   ! ===============
+
+         ! I.1 Vertical gradient of pu and pv at level jk and jk+1
+         ! -------------------------------------------------------
+         ! surface boundary condition: zdku(jk=1)=zdku(jk=2)
+         !                             zdkv(jk=1)=zdkv(jk=2)
+
+         zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1)
+         zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1)
+
+         IF( jk == 1 ) THEN
+            zdku(:,:) = zdk1u(:,:)
+            zdkv(:,:) = zdk1v(:,:)
+         ELSE
+            zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk)
+            zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk)
+         ENDIF
+
+         !                                -----f-----
+         ! I.2 Horizontal fluxes on U          |
+         ! ------------------------===     t   u   t
+         !                                     |
+         ! i-flux at t-point              -----f-----
+         DO jj = 1, jpjm1
+            DO ji = 2, jpi
+               zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
+
+               zmkt  = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof1 = -e2t(ji,jj) * zmkt   &
+                     * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )
+
+               ziut(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) )   &
+                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     &
+                                       +zdk1u(ji,jj) + zdku (ji-1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at f-point
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
+
+               zmkf  = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
+                              + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof2 = -e1f(ji,jj) * zmkf   &
+                     * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )
+
+               zjuf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) )   &
+                            + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     &
+                                       +zdk1u(ji,jj+1) + zdku (ji,jj) )  )
+            END DO
+         END DO
+
+         !                                 |   t   |
+         ! I.3 Horizontal fluxes on V      |       |
+         ! ------------------------===     f---v---f
+         !                                 |       |
+         ! i-flux at f-point               |   t   |
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
+
+               zmkf  = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof1 = -e2f(ji,jj) * zmkf   &
+                     * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )
+
+               zivf(ji,jj) = fmask(ji,jj,jk) *   &
+                           (  zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) )   &
+                            + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj)     &
+                                       +zdk1u(ji,jj) + zdku (ji+1,jj) )  )
+            END DO
+         END DO
+
+         ! j-flux at t-point
+         DO jj = 2, jpj
+            DO ji = 1, jpim1
+               zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)
+
+               zmkt  = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   &
+                              + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof2 = -e1t(ji,jj) * zmkt   &
+                     * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )
+
+               zjvt(ji,jj) = tmask(ji,jj,jk) *   &
+                           (  zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) )   &
+                            + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj)     &
+                                       +zdk1u(ji,jj-1) + zdku (ji,jj) )  )
+            END DO
+         END DO
+
+
+         ! I.4 Second derivative (divergence) (not divided by the volume)
+         ! ---------------------
+
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj  )   &
+                             + zjuf (ji  ,jj) - zjuf (ji,jj-1)
+               plv(ji,jj,jk) = zivf (ji,jj  ) - zivf (ji-1,jj)   &
+                             + zjvt (ji,jj+1) - zjvt (ji,jj  ) 
+            END DO
+         END DO
+
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+
+      !                             ! ************ !   ! ===============
+      DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+         !                          ! ************ !   ! ===============
+
+         ! II.1 horizontal (pu,pv) gradients
+         ! ---------------------------------
+
+         DO jk = 1, jpk
+            DO ji = 2, jpi
+               ! i-gradient of u at jj
+               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( pu(ji,jj  ,jk) - pu(ji-1,jj  ,jk) )
+               ! j-gradient of u and v at jj
+               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( pu(ji,jj+1,jk) - pu(ji  ,jj  ,jk) )
+               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pv(ji,jj  ,jk) - pv(ji  ,jj-1,jk) )
+               ! j-gradient of u and v at jj+1
+               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj  ,jk) - pu(ji  ,jj-1,jk) )
+               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(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) * ( pv(ji+1,jj,jk) - pv(ji  ,jj  ,jk) )
+            END DO
+         END DO
+
+
+         ! II.2 Vertical fluxes
+         ! --------------------
+
+         ! Surface and bottom vertical fluxes set to zero
+
+         zfuw(:, 1 ) = 0.e0
+         zfvw(:, 1 ) = 0.e0
+         zfuw(:,jpk) = 0.e0
+         zfvw(:,jpk) = 0.e0
+
+         ! interior (2=<jk=<jpk-1) on pu field
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               ! i- and j-slopes at uw-point
+               zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )
+               zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )
+               ! coef. for the vertical dirative
+               zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk)   &
+                      * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj )
+               ! weights for the i-k, j-k averaging at t- and f-points, resp.
+               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. )
+               ! coef. for the horitontal derivative
+               zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi
+               zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj
+               ! vertical flux on u field
+               zfuw(ji,jk) = umask(ji,jj,jk) *   &
+                           (  zcoef0 * ( pu  (ji,jj,jk-1) - pu  (ji,jj,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  ) ) )
+            END DO
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on pv field
+
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               ! i- and j-slopes at vw-point
+               zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )
+               zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )
+               ! coef. for the vertical derivative
+               zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk)   &
+                      * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj )
+               ! weights for the i-k, j-k averaging at f- and t-points, resp.
+               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. )
+               ! coef. for the horizontal derivatives
+               zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi
+               zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj
+               ! vertical flux on pv field
+               zfvw(ji,jk) = vmask(ji,jj,jk) *   &
+                           (  zcoef0 * ( pv  (ji,jj,jk-1) - pv  (ji,jj,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  ) )  )
+            END DO
+         END DO
+
+
+         ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+         ! ---------------------------------------------------------------------
+
+         IF( kahm == 1 ) THEN
+            ! multiply the laplacian by the eddy viscosity coefficient
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! eddy coef. divided by the volume element
+                  zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
+                  zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
+                  ! vertical divergence
+                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
+                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
+                  ! harmonic operator applied to (pu,pv) and multiply by ahm
+                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
+                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
+               END DO
+            END DO
+         ELSEIF( kahm == 2 ) THEN
+            ! second call, no multiplication
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! inverse of the volume element
+                  zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )
+                  zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )
+                  ! vertical divergence
+                  zuav = zfuw(ji,jk) - zfuw(ji,jk+1)
+                  zvav = zfvw(ji,jk) - zfvw(ji,jk+1)
+                  ! harmonic operator applied to (pu,pv) 
+                  plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur
+                  plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr
+               END DO
+            END DO
+         ELSE
+            IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm
+            IF(lwp)WRITE(numout,*) '         We stop'
+            STOP 'ldfguv'
+         ENDIF
+         !                                             ! ===============
+      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('ldfguv')
+      !
+   END SUBROUTINE ldfguv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                         NO rotation of mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_ldf_bilapg( kt )               ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_ldf_bilapg
+#endif
+
+   !!======================================================================
+END MODULE dynldf_bilapg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90	(revision 3437)
@@ -0,0 +1,447 @@
+MODULE dynldf_iso
+   !!======================================================================
+   !!                     ***  MODULE  dynldf_iso  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      slopes of the direction of mixing
+   !!----------------------------------------------------------------------
+   !!   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_oce      ! ocean dynamics lateral physics
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE ldfslp          ! iso-neutral slopes 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   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_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 "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+#  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 + ahmb0 ) e2t * e3t / e1t  di[ ub ]
+      !!               -      ahmt       e2t * mi-1(uslp) dk[ mi(mk(ub)) ]
+      !!         zjuf = ( ahmf + ahmb0 ) e1f * e3f / e2f  dj[ ub ]
+      !!               -      ahmf       e1f * mi(vslp)   dk[ mj(mk(ub)) ]
+      !!      v-component:
+      !!         zivf = ( ahmf + ahmb0 ) e2t * e3t / e1t  di[ vb ]
+      !!               -      ahmf       e2t * mj(uslp)   dk[ mi(mk(vb)) ]
+      !!         zjvt = ( ahmt + ahmb0 ) 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, zbu, zbv, zuah, zvah               !   -      -
+      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
+
+      ! 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 = fs_2, fs_jpim1   ! vector opt.
+                  uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
+                  vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
+                  wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
+                  wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+               END DO
+            END DO
+         END DO
+         ! 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 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * MIN( fse3u(ji,jj,jk), fse3u(ji-1,jj,jk) ) / e1t(ji,jj)
+
+                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
+                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
+
+                  zcof1 = - aht0 * 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 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)
+
+                  zmskt = 1./MAX(  umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)   &
+                     &           + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ), 1. )
+
+                  zcof1 = - aht0 * 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 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)
+
+               zmskf = 1./MAX(  umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)   &
+                  &           + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ), 1. )
+
+               zcof2 = - aht0 * 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 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)
+
+               zmskf = 1./MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)   &
+                  &           + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ), 1. )
+
+               zcof1 = - aht0 * 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 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * MIN( fse3v(ji,jj,jk), fse3v(ji,jj-1,jk) ) / 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 = - aht0 * 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 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / 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 = - aht0 * 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          !! Question vectop possible??? !!bug
+               ! volume elements
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               ! horizontal component of isopycnal momentum diffusive trends
+               zuah =( ziut (ji+1,jj) - ziut (ji,jj  ) +   &
+                  &    zjuf (ji  ,jj) - zjuf (ji,jj-1)  ) / zbu
+               zvah =( zivf (ji,jj  ) - zivf (ji-1,jj) +   &
+                  &    zjvt (ji,jj+1) - zjvt (ji,jj  )  ) / zbv
+               ! add the trends to the general trends
+               ua (ji,jj,jk) = ua (ji,jj,jk) + zuah
+               va (ji,jj,jk) = va (ji,jj,jk) + zvah
+            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 * aht0 * 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 aht0, so divided by aht0 to obtain slp^2 * aht0
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0
+            END DO
+         END DO
+
+         ! interior (2=<jk=<jpk-1) on V field
+         DO jk = 2, jpkm1
+            DO ji = 2, jpim1
+               zcoef0= 0.5 * aht0 * 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 aht0, so divided by aht0 to obtain slp^2 * aht0
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0
+            END DO
+         END DO
+
+
+         ! I.3 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO ji = 2, jpim1
+               ! volume elements
+               zbu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+               zbv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+               ! part of the k-component of isopycnal momentum diffusive trends
+               zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu
+               zvav = ( zfvw(ji,jk) - zfvw(ji,jk+1) ) / zbv
+               ! add the trends to the general trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zuav
+               va(ji,jj,jk) = va(ji,jj,jk) + zvav
+            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
+
+# else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                           NO rotation of mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_ldf_iso( kt )               ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_ldf_iso
+#endif
+
+   !!======================================================================
+END MODULE dynldf_iso
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90	(revision 3437)
@@ -0,0 +1,105 @@
+MODULE dynldf_lap
+   !!======================================================================
+   !!                       ***  MODULE  dynldf_lap  ***
+   !! Ocean dynamics:  lateral viscosity trend
+   !!======================================================================
+   !! History :  OPA  ! 1990-09 (G. Madec) Original code
+   !!            4.0  ! 1991-11 (G. Madec)
+   !!            6.0  ! 1996-01 (G. Madec) statement function for e3 and ahm
+   !!   NEMO     1.0  ! 2002-06 (G. Madec)  F90: Free form and module
+   !!             -   ! 2004-08 (C. Talandier) New trends organization
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_ldf_lap  : update the momentum trend with the lateral diffusion
+   !!                  using an iso-level harmonic operator
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE trdmod          ! ocean dynamics trends 
+   USE trdmod_oce      ! ocean variables trends
+   USE ldfslp          ! iso-neutral slopes 
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_ldf_lap  ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_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 dyn_ldf_lap( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE dyn_ldf_lap  ***
+      !!                       
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The before horizontal momentum diffusion trend is an
+      !!      harmonic operator (laplacian type) which separates the divergent
+      !!      and rotational parts of the flow.
+      !!      Its horizontal components are computed as follow:
+      !!         difu = 1/e1u di[ahmt hdivb] - 1/(e2u*e3u) dj-1[e3f ahmf rotb]
+      !!         difv = 1/e2v dj[ahmt hdivb] + 1/(e1v*e3v) di-1[e3f ahmf rotb]
+      !!      in the rotational part of the diffusion.
+      !!      Add this before trend to the general trend (ua,va):
+      !!            (ua,va) = (ua,va) + (diffu,diffv)
+      !!      'key_trddyn' activated: the two components of the horizontal
+      !!                                 diffusion trend are saved.
+      !!
+      !! ** Action : - Update (ua,va) with the before iso-level harmonic 
+      !!               mixing trend.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk             ! dummy loop indices
+      REAL(wp) ::   zua, zva, ze2u, ze1v   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_ldf_lap')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ze2u = rotb (ji,jj,jk) * fsahmf(ji,jj,jk) * fse3f(ji,jj,jk)
+               ze1v = hdivb(ji,jj,jk) * fsahmt(ji,jj,jk)
+               ! horizontal diffusive trends
+               zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) )   &
+                     + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v                   ) / e1u(ji,jj)
+
+               zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) )   &
+                     + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v                   ) / e2v(ji,jj)
+
+               ! add it to the general momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zva
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_ldf_lap')
+      !
+   END SUBROUTINE dyn_ldf_lap
+
+   !!======================================================================
+END MODULE dynldf_lap
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90	(revision 3437)
@@ -0,0 +1,609 @@
+MODULE dynnept
+   !!======================================================================
+   !!                       ***  MODULE  dynnept  ***
+   !! Ocean dynamics: Neptune effect as proposed by Greg Holloway,
+   !!                 recoded version of simplest case (u*, v* only)
+   !!======================================================================
+   !! History :  1.0  !  2007-06  (Michael Dunphy)  Modular form: - new namelist parameters
+   !!                                                             - horizontal diffusion for Neptune
+   !!                                                             - vertical diffusion for gm in momentum eqns
+   !!                                                             - option to use Neptune in Coriolis eqn
+   !!                    2011-08  (Jeff Blundell, NOCS) Simplified form for temporally invariant u*, v*
+   !!                                               Horizontal and vertical diffusivity formulations removed
+   !!                                               Dynamic allocation of storage added
+   !!                                               Option of ramping Neptune vel. down
+   !!                                               to zero added in shallow depths added
+   !!----------------------------------------------------------------------
+   !! dynnept_alloc        :
+   !! dyn_nept_init        :
+   !! dyn_nept_div_cur_init:
+   !! dyn_nept_cor         :
+   !! dyn_nept_vel         :
+   !! dyn_nept_smooth_vel  :
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
+   USE obc_oce          ! ocean lateral open boundary condition
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! distributed memory computing
+   USE prtctl           ! Print control
+   USE phycst
+   USE lbclnk
+   USE wrk_nemo        ! Memory Allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC dyn_nept_init      ! routine called by nemogcm.F90
+   PUBLIC dyn_nept_cor       ! routine called by step.F90
+   !! dynnept_alloc()         is called only by dyn_nept_init, within this module
+   !! dyn_nept_div_cur_init   is called only by dyn_nept_init, within this module
+   !! dyn_nept_vel            is called only by dyn_nept_cor,  within this module
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)    :: zunep, zvnep  ! Neptune u and v
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zhdivnep      ! hor. div for Neptune vel.
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zmrotnep      ! curl for Neptune vel.
+
+
+   !! * Namelist namdyn_nept variables
+   LOGICAL, PUBLIC  ::  ln_neptsimp        = .FALSE.  ! yes/no simplified neptune
+
+   LOGICAL          ::  ln_smooth_neptvel  = .FALSE.  ! yes/no smooth zunep, zvnep
+   REAL(wp)         ::  rn_tslse           =  1.2e4   ! value of lengthscale L at the equator
+   REAL(wp)         ::  rn_tslsp           =  3.0e3   ! value of lengthscale L at the pole
+!! Specify whether to ramp down the Neptune velocity in shallow
+!! water, and the depth range controlling such ramping down
+   LOGICAL          ::  ln_neptramp        = .FALSE.  ! ramp down Neptune velocity in shallow water
+   REAL(wp)         ::  rn_htrmin          =  100.0   ! min. depth of transition range
+   REAL(wp)         ::  rn_htrmax          =  200.0   ! max. depth of transition range
+
+   !! * Module variables
+
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !!   OPA 9.0 , implemented by Bedford Institute of Oceanography
+   !!----------------------------------------------------------------------
+
+ CONTAINS
+
+   INTEGER FUNCTION dynnept_alloc()
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dynnept_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( zunep(jpi,jpj) , zvnep(jpi,jpj) ,     &
+         &      zhdivnep(jpi,jpj,jpk) , zmrotnep(jpi,jpj,jpk) , STAT=dynnept_alloc )
+         !
+      IF( dynnept_alloc /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
+   END FUNCTION dynnept_alloc
+
+
+   SUBROUTINE dyn_nept_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nept_init  ***
+      !!
+      !! ** Purpose :   Read namelist parameters, initialise arrays
+      !!                and compute the arrays zunep and zvnep
+      !!
+      !! ** Method  :   zunep =
+      !!                zvnep =
+      !!
+      !! ** History :  1.0  !   07-05  (Zeliang Wang)   Original code for zunep, zvnep
+      !!               1.1  !   07-06  (Michael Dunphy) namelist and  initialisation
+      !!               2.0  ! 2011-07  (Jeff Blundell, NOCS)
+      !!                    ! Simplified form for temporally invariant u*, v*
+      !!                    ! Horizontal and vertical diffusivity formulations removed
+      !!                    ! Includes optional tapering-off in shallow depths
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER  ::   ji, jj, jk    ! dummy loop indices
+      REAL(wp) :: unemin,unemax,vnemin,vnemax   ! extrema of (u*, v*) fields
+      REAL(wp) :: zhdivmin,zhdivmax             ! extrema of horizontal divergence of (u*, v*) fields
+      REAL(wp) :: zmrotmin,zmrotmax             ! extrema of the curl of the (u*, v*) fields
+      REAL(wp) :: ustar,vstar                   ! (u*, v*) before tapering in shallow water
+      REAL(wp) :: hramp                         ! depth over which Neptune vel. is ramped down
+      !
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n      
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: znmask
+      !!
+      NAMELIST/namdyn_nept/ ln_neptsimp, ln_smooth_neptvel, rn_tslse, rn_tslsp,      &
+                            ln_neptramp, rn_htrmin, rn_htrmax
+      !!----------------------------------------------------------------------
+      !                                                           ! Dynamically allocate local work arrays
+      CALL wrk_alloc( jpi, jpj     , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
+      CALL wrk_alloc( jpi, jpj, jpk, znmask                                          ) 
+      !
+      ! Define the (simplified) Neptune parameters
+      ! ==========================================
+
+!!    WRITE(numout,*) ' start dynnept namelist'
+!!    CALL FLUSH(numout)
+      REWIND( numnam )                  ! Read Namelist namdyn_nept:  Simplified Neptune
+      READ  ( numnam, namdyn_nept )
+!!    WRITE(numout,*) ' dynnept namelist done'
+!!    CALL FLUSH(numout)
+
+      IF(lwp) THEN                      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_nept_init : Simplified Neptune module enabled'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+         WRITE(numout,*) ' -->   Reading namelist namdyn_nept parameters:'
+         WRITE(numout,*) '       ln_neptsimp          = ', ln_neptsimp
+         WRITE(numout,*)
+         WRITE(numout,*) '       ln_smooth_neptvel    = ', ln_smooth_neptvel
+         WRITE(numout,*) '       rn_tslse             = ', rn_tslse
+         WRITE(numout,*) '       rn_tslsp             = ', rn_tslsp
+         WRITE(numout,*)
+         WRITE(numout,*) '       ln_neptramp          = ', ln_neptramp
+         WRITE(numout,*) '       rn_htrmin            = ', rn_htrmin
+         WRITE(numout,*) '       rn_htrmax            = ', rn_htrmax
+         WRITE(numout,*)
+         CALL FLUSH(numout)
+      ENDIF
+
+      IF( ln_smooth_neptvel ) THEN
+         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will be smoothed'
+      ELSE
+         IF(lwp) WRITE(numout,*) ' -->   neptune velocities will not be smoothed'
+      ENDIF
+
+      IF( ln_neptsimp ) THEN
+          IF(lwp) WRITE(numout,*) ' -->   ln_neptsimp enabled, solving for U-UN'
+      ELSE
+          IF(lwp) WRITE(numout,*) ' -->   ln_neptsimp disabled'
+          RETURN
+      ENDIF
+
+      IF( ln_neptramp ) THEN
+          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp enabled, ramp down Neptune'
+          IF(lwp) WRITE(numout,*) ' -->   velocity components in shallow water'
+      ELSE
+          IF(lwp) WRITE(numout,*) ' -->   ln_neptramp disabled'
+      ENDIF
+
+
+!!    Perform dynamic allocation of shared module variables
+      IF( dynnept_alloc() /= 0 )   CALL ctl_warn('dynnept_alloc: array allocate failed.')
+
+      IF( .not. ln_rstart ) THEN      ! If restarting, these arrays are read from the restart file
+         zhdivnep(:,:,:) = 0.0_wp
+         zmrotnep(:,:,:) = 0.0_wp
+      END IF
+
+      ! Computation of nmask: same as fmask, but fmask cannot be used
+      ! because it is modified after it is computed in dom_msk
+      ! (this can be optimised to save memory, such as merge into next loop)
+      DO jk = 1, jpk
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector loop
+               znmask(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( znmask, 'F', 1.0_wp )
+
+
+      ! now compute zunep, zvnep (renamed from earlier versions)
+
+      zunep(:,:) = 0.0_wp
+      zvnep(:,:) = 0.0_wp
+
+      htn(:,:) = 0.0_wp            ! ocean depth at F-point
+      DO jk = 1, jpk
+         htn(:,:) = htn(:,:) + fse3f(:,:,jk) * znmask(:,:,jk)
+      END DO
+
+      IF( ln_smooth_neptvel ) THEN
+         CALL dyn_nept_smooth_vel( htn, ht, .TRUE. )
+      !! overwrites ht with a smoothed version of htn
+      ELSE
+         ht(:,:) = htn(:,:)
+      !! use unsmoothed version of htn
+      ENDIF
+      CALL lbc_lnk( ht, 'F', 1.0_wp )
+
+      !! Compute tsp, a stream function for the Neptune velocity,
+      !! with the usual geophysical sign convention
+      !! Then zunep = -latitudinal derivative "-(1/H)*d(tsp)/dy"
+      !!      zvnep = longitudinal derivative " (1/H)*d(tsp)/dx"
+
+      tsp(:,:)    = 0.0_wp
+      tscale(:,:) = 0.0_wp
+
+      tscale(:,:) = rn_tslsp + (rn_tslse - rn_tslsp) *   &
+                   ( 0.5_wp + 0.5_wp * COS( 2.0_wp * rad * gphif(:,:) )  )
+      tsp   (:,:) = -2.0_wp * omega * SIN( rad * gphif(:,:) ) * tscale(:,:) * tscale(:,:) * ht(:,:)
+
+
+      IF( ln_smooth_neptvel ) THEN
+         CALL dyn_nept_smooth_vel( hu, hu_n, .TRUE. )
+      !! overwrites hu_n with a smoothed version of hu
+      ELSE
+         hu_n(:,:) = hu(:,:)
+      !! use unsmoothed version of hu
+      ENDIF
+      CALL lbc_lnk( hu_n, 'U', 1.0_wp )
+      hu_n(:,:) = hu_n(:,:) * umask(:,:,1)
+
+      WHERE( hu_n(:,:) == 0.0_wp )
+         hur_n(:,:) = 0.0_wp
+      ELSEWHERE
+         hur_n(:,:) = 1.0_wp / hu_n(:,:)
+      END WHERE
+
+
+      IF( ln_smooth_neptvel ) THEN
+         CALL dyn_nept_smooth_vel( hv, hv_n, .TRUE. )
+      !! overwrites hv_n with a smoothed version of hv
+      ELSE
+         hv_n(:,:) = hv(:,:)
+      !! use unsmoothed version of hv
+      ENDIF
+      CALL lbc_lnk( hv_n, 'V', 1.0_wp )
+      hv_n(:,:) = hv_n(:,:) * vmask(:,:,1)
+
+      WHERE( hv_n == 0.0_wp )
+         hvr_n(:,:) = 0.0_wp
+      ELSEWHERE
+         hvr_n(:,:) = 1.0_wp / hv_n(:,:)
+      END WHERE
+
+
+      unemin =  1.0e35
+      unemax = -1.0e35
+      vnemin =  1.0e35
+      vnemax = -1.0e35
+      hramp = rn_htrmax - rn_htrmin
+      DO jj = 2, jpj-1
+         DO ji = 2, jpi-1
+            if ( umask(ji,jj,1) /= 0.0_wp ) then
+               ustar =-1.0_wp/e2u(ji,jj) * hur_n(ji,jj) * ( tsp(ji,jj)-tsp(ji,jj-1) ) * umask(ji,jj,1)
+               if ( ln_neptramp ) then
+!!                Apply ramp down to velocity component
+                  if ( hu_n(ji,jj) <= rn_htrmin ) then
+                    zunep(ji,jj) = 0.0_wp
+                   else if ( hu_n(ji,jj) >= rn_htrmax ) then
+                    zunep(ji,jj) = ustar
+                   else if ( hramp > 0.0_wp ) then
+                    zunep(ji,jj) = ( hu_n(ji,jj) - rn_htrmin) * ustar/hramp
+                  endif
+                else
+                 zunep(ji,jj) = ustar
+               endif 
+             else
+              zunep(ji,jj) = 0.0_wp
+            endif
+            if ( vmask(ji,jj,1) /= 0.0_wp ) then
+               vstar = 1.0_wp/e1v(ji,jj) * hvr_n(ji,jj) * ( tsp(ji,jj)-tsp(ji-1,jj) ) * vmask(ji,jj,1)
+               if ( ln_neptramp ) then
+!!                Apply ramp down to velocity component
+                  if ( hv_n(ji,jj) <= rn_htrmin ) then
+                    zvnep(ji,jj) = 0.0_wp
+                   else if ( hv_n(ji,jj) >= rn_htrmax ) then
+                    zvnep(ji,jj) = vstar
+                   else if ( hramp > 0.0_wp ) then
+                    zvnep(ji,jj) = ( hv_n(ji,jj) - rn_htrmin) * vstar/hramp
+                  endif
+                else
+                  zvnep(ji,jj) = vstar
+               endif
+             else
+              zvnep(ji,jj) = 0.0_wp
+            endif
+            unemin = min( unemin, zunep(ji,jj) )
+            unemax = max( unemax, zunep(ji,jj) )
+            vnemin = min( vnemin, zvnep(ji,jj) )
+            vnemax = max( vnemax, zvnep(ji,jj) )
+         END DO
+      END DO
+      CALL lbc_lnk( zunep, 'U', -1.0_wp )
+      CALL lbc_lnk( zvnep, 'V', -1.0_wp )
+      WRITE(numout,*) '      zunep: min, max       = ', unemin,unemax
+      WRITE(numout,*) '      zvnep: min, max       = ', vnemin,vnemax
+      WRITE(numout,*)
+
+      !!  Compute, once and for all, the horizontal divergence (zhdivnep)
+      !!  and the curl (zmrotnep) of the Neptune velocity field (zunep, zvnep)
+      CALL dyn_nept_div_cur_init
+
+      !! Check the ranges of the computed divergence & vorticity
+      zhdivmin =  1.0e35
+      zhdivmax = -1.0e35
+      zmrotmin =  1.0e35
+      zmrotmax = -1.0e35
+      hramp = rn_htrmax - rn_htrmin
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         DO jj = 2, jpj-1
+            DO ji = 2, jpi-1
+               zhdivmin = min( zhdivmin, zhdivnep(ji,jj,jk) )
+               zhdivmax = max( zhdivmax, zhdivnep(ji,jj,jk) )
+               zmrotmin = min( zmrotmin, zmrotnep(ji,jj,jk) )
+               zmrotmax = max( zmrotmax, zmrotnep(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+      WRITE(numout,*) '   zhdivnep: min, max       = ', zhdivmin,zhdivmax
+      WRITE(numout,*) '   zmrotnep: min, max       = ', zmrotmin,zmrotmax
+      WRITE(numout,*)
+
+!!    Deallocate temporary workspace arrays, which are all local to
+!!    this routine, except where passed as arguments to other routines
+      CALL wrk_dealloc( jpi, jpj     , ht, htn, tscale, tsp, hur_n, hvr_n, hu_n, hv_n  ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, znmask                                          ) 
+      !
+   END SUBROUTINE dyn_nept_init
+
+
+   SUBROUTINE dyn_nept_div_cur_init
+      !!----------------------------------------------------------------------
+      !!             ***  ROUTINE dyn_nept_div_cur_init  ***
+      !!
+      !! ** Purpose :   compute the horizontal divergence and the relative
+      !!                vorticity of the time-invariant u* and v* Neptune
+      !!                effect velocities (called zunep, zvnep)
+      !!
+      !! ** Method  : - Divergence:
+      !!      - compute the divergence given by :
+      !!         zhdivnep = 1/(e1t*e2t*e3t) ( di[e2u*e3u zunep] + dj[e1v*e3v zvnep] )
+      !!      - compute the curl in tensorial formalism:
+      !!         zmrotnep = 1/(e1f*e2f) ( di[e2v zvnep] - dj[e1u zunep] )
+      !!      Note: Coastal boundary condition: lateral friction set through
+      !!      the value of fmask along the coast (see dommsk.F90) and shlat
+      !!      (namelist parameter)
+      !!
+      !! ** Action  : - compute zhdivnep, the hor. divergence of (u*, v*)
+      !!              - compute zmrotnep, the rel. vorticity  of (u*, v*)
+      !!
+      !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
+      !!            4.0  ! 1991-11  (G. Madec)
+      !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions
+      !!            7.0  ! 1996-01  (G. Madec)  s-coordinates
+      !!            8.0  ! 1997-06  (G. Madec)  lateral boundary cond., lbc
+      !!            8.1  ! 1997-08  (J.M. Molines)  Open boundaries
+      !!            8.2  ! 2000-03  (G. Madec)  no slip accurate
+      !!  NEMO      1.0  ! 2002-09  (G. Madec, E. Durand)  Free form, F90
+      !!             -   ! 2005-01  (J. Chanut) Unstructured open boundaries
+      !!             -   ! 2003-08  (G. Madec)  merged of cur and div, free form, F90
+      !!             -   ! 2005-01  (J. Chanut, A. Sellar) unstructured open boundaries
+      !!            3.3  ! 2010-09  (D.Storkey and E.O'Dea) bug fixes for BDY module
+      !!                 ! 2011-06  (Jeff Blundell, NOCS) Adapt code from divcur.F90
+      !!                 !           to compute Neptune effect fields only
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !    
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'dyn_nept_div_cur_init :'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) 'horizontal velocity divergence and'
+      IF(lwp) WRITE(numout,*) 'relative vorticity of Neptune flow'
+#if defined key_noslip_accurate
+   !!----------------------------------------------------------------------
+   !!   'key_noslip_accurate'                     2nd order centered scheme
+   !!                                                4th order at the coast
+   !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'WARNING: key_noslip_accurate option'
+      IF(lwp) WRITE(numout,*) 'not implemented in simplified Neptune'
+      CALL ctl_warn( ' noslip_accurate option not implemented' )
+#endif
+
+   !!----------------------------------------------------------------------
+   !!   Default option                           2nd order centered schemes
+   !!----------------------------------------------------------------------
+
+      ! Apply the div and curl operators to the depth-dependent velocity
+      ! field produced by multiplying (zunep, zvnep) by (umask, vmask), exactly
+      ! equivalent to the equivalent calculation in the unsimplified code
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !                                             ! --------
+         ! Horizontal divergence                       !   div
+         !                                             ! --------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zhdivnep(ji,jj,jk) =   &
+               &   (  e2u(ji  ,jj  )*fse3u(ji  ,jj  ,jk) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)    &
+               &    - e2u(ji-1,jj  )*fse3u(ji-1,jj  ,jk) * zunep(ji-1,jj  ) * umask(ji-1,jj  ,jk)    &
+               &    + e1v(ji  ,jj  )*fse3v(ji  ,jj  ,jk) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)    &
+               &    - e1v(ji  ,jj-1)*fse3v(ji  ,jj-1,jk) * zvnep(ji  ,jj-1) * vmask(ji  ,jj-1,jk) )  &
+               &  / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+
+#if defined key_obc
+         IF( Agrif_Root() ) THEN
+            ! open boundaries (div must be zero behind the open boundary)
+            !  mpp remark: The zeroing of zhdivnep can probably be extended to 1->jpi/jpj for the correct row/column
+            IF( lp_obc_east  )  zhdivnep(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.0_wp      ! east
+            IF( lp_obc_west  )  zhdivnep(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.0_wp      ! west
+            IF( lp_obc_north )  zhdivnep(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.0_wp      ! north
+            IF( lp_obc_south )  zhdivnep(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.0_wp      ! south
+         ENDIF
+#endif
+         IF( .NOT. AGRIF_Root() ) THEN
+            IF ((nbondi ==  1).OR.(nbondi == 2))  zhdivnep(nlci-1 , :     ,jk) = 0.0_wp   ! east
+            IF ((nbondi == -1).OR.(nbondi == 2))  zhdivnep(2      , :     ,jk) = 0.0_wp   ! west
+            IF ((nbondj ==  1).OR.(nbondj == 2))  zhdivnep(:      ,nlcj-1 ,jk) = 0.0_wp   ! north
+            IF ((nbondj == -1).OR.(nbondj == 2))  zhdivnep(:      ,2      ,jk) = 0.0_wp   ! south
+         ENDIF
+
+         !                                             ! --------
+         ! relative vorticity                          !   rot
+         !                                             ! --------
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zmrotnep(ji,jj,jk) =   &
+                  &       (  e2v(ji+1,jj  ) * zvnep(ji+1,jj  ) * vmask(ji+1,jj  ,jk)     &
+                  &        - e2v(ji  ,jj  ) * zvnep(ji  ,jj  ) * vmask(ji  ,jj  ,jk)     &
+                  &        - e1u(ji  ,jj+1) * zunep(ji  ,jj+1) * umask(ji  ,jj+1,jk)     &
+                  &        + e1u(ji  ,jj  ) * zunep(ji  ,jj  ) * umask(ji  ,jj  ,jk)  )  &
+                  &       * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj) )
+            END DO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! 4. Lateral boundary conditions on zhdivnep and zmrotnep
+      ! ----------------------------------=======-----=======
+      CALL lbc_lnk( zhdivnep, 'T', 1. )   ;   CALL lbc_lnk( zmrotnep , 'F', 1. )     ! lateral boundary cond. (no sign change)
+      !
+   END SUBROUTINE dyn_nept_div_cur_init
+
+
+   SUBROUTINE dyn_nept_cor( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nept_cor  ***
+      !!
+      !! ** Purpose :  Add or subtract the Neptune velocity from the now velocities
+      !!
+      !! ** Method  :  First call : kt not equal to lastkt -> subtract zunep, zvnep
+      !!               Second call: kt     equal to lastkt -> add zunep, zvnep
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt       ! ocean time-step index
+      !!
+      INTEGER, SAVE :: lastkt             ! store previous kt
+      DATA lastkt/-1/                     ! initialise previous kt
+      !!----------------------------------------------------------------------
+      !
+      IF( ln_neptsimp ) THEN
+         !
+         IF( lastkt /= kt ) THEN          ! 1st call for this kt: subtract the Neptune velocities zunep, zvnep from un, vn
+            CALL dyn_nept_vel( -1 )      ! -1 = subtract
+            !
+         ELSE                              ! 2nd call for this kt: add the Neptune velocities zunep, zvnep to un, vn
+            CALL dyn_nept_vel(  1 )      !  1 = add
+            !
+         ENDIF
+         !
+         lastkt = kt     ! Store kt
+         !
+      ENDIF
+      !
+   END SUBROUTINE dyn_nept_cor
+
+
+   SUBROUTINE dyn_nept_vel( ksign )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nept_vel  ***
+      !!
+      !! ** Purpose :  Add or subtract the Neptune velocity from the now
+      !!               velocities based on ksign
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   ksign    ! 1 or -1 to add or subtract neptune velocities
+      !!
+      INTEGER :: jk                       ! dummy loop index
+      !!----------------------------------------------------------------------
+      !
+      ! Adjust the current velocity un, vn by adding or subtracting the
+      ! Neptune velocities zunep, zvnep, as determined by argument ksign
+      DO jk=1, jpk
+         un(:,:,jk) = un(:,:,jk) + ksign * zunep(:,:) * umask(:,:,jk)
+         vn(:,:,jk) = vn(:,:,jk) + ksign * zvnep(:,:) * vmask(:,:,jk)
+      END DO
+      !
+   END SUBROUTINE dyn_nept_vel
+
+
+   SUBROUTINE dyn_nept_smooth_vel( htold, htnew, ld_option )
+
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nept_smooth_vel  ***
+      !!
+      !! ** Purpose :  Compute smoothed topography field.
+      !!
+      !! ** Action : - Updates the array htnew (output) with a smoothed
+      !!               version of the (input) array htold. Form of smoothing
+      !!               algorithm is controlled by the (logical) argument ld_option.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   )  ::  htold      ! temporary 2D workspace
+      LOGICAL                     , INTENT(in   )  ::  ld_option  ! temporary 2D workspace
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)  ::  htnew      ! temporary 2D workspace
+      !
+      INTEGER                           ::  ji, jj  ! dummy loop indices
+      INTEGER , POINTER, DIMENSION(:,:) ::  nb, iwork
+      REAL(wp), POINTER, DIMENSION(:,:) ::  work    ! temporary 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, nb, iwork ) 
+      CALL wrk_alloc( jpi, jpj, work      ) 
+      !
+      iwork(:,:) = 0
+
+      !! iwork is a mask of gridpoints: iwork = 1 => ocean, iwork = 0 => land
+      WHERE( htold(:,:) > 0 )
+         iwork(:,:) = 1
+         htnew(:,:) = htold(:,:)
+      ELSEWHERE
+         iwork(:,:) = 0
+         htnew(:,:) = 0.0_wp
+      END WHERE
+      !! htnew contains valid ocean depths from htold, or zero
+
+      !! set work to a smoothed/averaged version of htnew; choice controlled by ld_option
+      !! nb is set to the sum of the weights of the valid values used in work
+      IF( ld_option ) THEN
+
+         !! Apply scale-selective smoothing in determining work from htnew
+         DO jj=2,jpj-1
+            DO ji=2,jpi-1
+               work(ji,jj) = 4.0*htnew( ji , jj ) +                        &
+                           & 2.0*htnew(ji+1, jj ) + 2.0*htnew(ji-1, jj ) + &
+                           & 2.0*htnew( ji ,jj+1) + 2.0*htnew( ji ,jj-1) + &
+                           &     htnew(ji+1,jj+1) +     htnew(ji+1,jj-1) + &
+                           &     htnew(ji-1,jj+1) +     htnew(ji-1,jj-1)
+
+               nb(ji,jj)   = 4 * iwork( ji , jj ) +                        &
+                           & 2 * iwork(ji+1, jj ) + 2 * iwork(ji-1, jj ) + &
+                           & 2 * iwork( ji ,jj+1) + 2 * iwork( ji ,jj-1) + &
+                           &     iwork(ji+1,jj+1) +     iwork(ji+1,jj-1) + &
+                           &     iwork(ji-1,jj+1) +     iwork(ji-1,jj-1)
+            END DO
+         END DO
+
+      ELSE
+
+         !! Apply simple 9-point averaging in determining work from htnew
+         DO jj=2,jpj-1
+            DO ji=2,jpi-1
+               work(ji,jj) =  htnew( ji , jj ) +                    &
+                           &  htnew(ji+1, jj ) + htnew(ji-1, jj ) + &
+                           &  htnew( ji ,jj+1) + htnew( ji ,jj-1) + &
+                           &  htnew(ji+1,jj+1) + htnew(ji+1,jj-1) + &
+                           &  htnew(ji-1,jj+1) + htnew(ji-1,jj-1)
+
+               nb(ji,jj) =    iwork( ji , jj ) +                    &
+                           &  iwork(ji+1, jj ) + iwork(ji-1, jj ) + &
+                           &  iwork( ji ,jj+1) + iwork( ji ,jj-1) + &
+                           &  iwork(ji+1,jj+1) + iwork(ji+1,jj-1) + &
+                           &  iwork(ji-1,jj+1) + iwork(ji-1,jj-1)
+            END DO
+         END DO
+
+      ENDIF
+
+      !! write averaged value of work into htnew,
+      !! if average is valid and point is unmasked
+      WHERE( (htold(:,:) /= 0.0_wp ) .AND. ( nb(:,:) /= 0 ) )
+         htnew(:,:) = work(:,:)/real(nb(:,:))
+      ELSEWHERE
+         htnew(:,:) = 0.0_wp
+      END WHERE
+
+      !!    Deallocate temporary workspace arrays, all local to this routine
+      CALL wrk_dealloc( jpi, jpj, nb, iwork ) 
+      CALL wrk_dealloc( jpi, jpj, work      ) 
+      !
+   END SUBROUTINE dyn_nept_smooth_vel
+
+END MODULE dynnept
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90	(revision 3437)
@@ -0,0 +1,288 @@
+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
+   !!-------------------------------------------------------------------------
+  
+   !!-------------------------------------------------------------------------
+   !!   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 dynspg_oce      ! type of surface pressure gradient
+   USE dynadv          ! dynamics: vector invariant versus flux form
+   USE domvvl          ! variable volume
+   USE obc_oce         ! ocean open boundary conditions
+   USE obcdyn          ! open boundary condition for momentum (obc_dyn routine)
+   USE obcdyn_bt       ! 2D open boundary condition for momentum (obc_dyn_bt routine)
+   USE obcvol          ! ocean open boundary condition (obc_vol routines)
+   USE bdy_oce         ! ocean open boundary conditions
+   USE bdydta          ! ocean open boundary conditions
+   USE bdydyn          ! ocean open boundary conditions
+   USE bdyvol          ! ocean open boundary condition (bdy_vol routines)
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! lateral boundary condition (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE prtctl          ! Print control
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC    dyn_nxt   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_nxt ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_nxt  ***
+      !!                   
+      !! ** Purpose :   Compute the after horizontal velocity. Apply the boundary 
+      !!             condition on the after velocity, achieved the time stepping 
+      !!             by applying the Asselin filter on now fields and swapping 
+      !!             the fields.
+      !!
+      !! ** Method  : * After velocity is compute using a leap-frog scheme:
+      !!                       (ua,va) = (ub,vb) + 2 rdt (ua,va)
+      !!             Note that with flux form advection and variable volume layer
+      !!             (lk_vvl=T), the leap-frog is applied on thickness weighted
+      !!             velocity.
+      !!             Note also that in filtered free surface (lk_dynspg_flt=T),
+      !!             the time stepping has already been done in dynspg module
+      !!
+      !!              * Apply lateral boundary conditions on after velocity 
+      !!             at the local domain boundaries through lbc_lnk call,
+      !!             at the one-way open boundaries (lk_obc=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 variable volume layer
+      !!             (lk_vvl=T), the time filter is applied on thickness weighted
+      !!             velocity.
+      !!
+      !! ** 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  ::   iku, ikv     ! local integers
+#if ! defined key_dynspg_flt
+      REAL(wp) ::   z2dt         ! temporary scalar
+#endif
+      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zec   ! local scalars
+      REAL(wp) ::   zve3a, zve3n, zve3b, zvf        !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_nxt')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, ze3u_f, ze3v_f )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_nxt : time stepping'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+
+#if defined key_dynspg_flt
+      !
+      ! Next velocity :   Leap-frog time stepping already done in dynspg_flt.F routine
+      ! -------------
+
+      ! Update after velocity on domain lateral boundaries      (only local domain required)
+      ! --------------------------------------------------
+      CALL lbc_lnk( ua, 'U', -1. )         ! local domain boundaries
+      CALL lbc_lnk( va, 'V', -1. ) 
+      !
+#else
+      ! Next velocity :   Leap-frog time stepping
+      ! -------------
+      z2dt = 2. * rdt                                 ! Euler or leap-frog time step 
+      IF( neuler == 0 .AND. kt == nit000 )  z2dt = rdt
+      !
+      IF( ln_dynadv_vec .OR. .NOT. lk_vvl ) THEN      ! applied on velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk)
+            va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk)
+         END DO
+      ELSE                                            ! applied on thickness weighted velocity
+         DO jk = 1, jpkm1
+            ua(:,:,jk) = (          ub(:,:,jk) * fse3u_b(:,:,jk)      &
+               &           + z2dt * ua(:,:,jk) * fse3u_n(:,:,jk)  )   &
+               &         / fse3u_a(:,:,jk) * umask(:,:,jk)
+            va(:,:,jk) = (          vb(:,:,jk) * fse3v_b(:,:,jk)      &
+               &           + z2dt * va(:,:,jk) * fse3v_n(:,:,jk)  )   &
+               &         / fse3v_a(:,:,jk) * vmask(:,:,jk)
+         END DO
+      ENDIF
+
+
+      ! Update after velocity on domain lateral boundaries
+      ! --------------------------------------------------      
+      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries
+      CALL lbc_lnk( va, 'V', -1. ) 
+      !
+# if defined key_obc
+      !                                !* OBC open boundaries
+      CALL obc_dyn( kt )
+      !
+      IF( .NOT. lk_dynspg_flt ) THEN
+         ! Flather boundary condition : - Update sea surface height on each open boundary
+         !                                       sshn   (= after ssh   ) for explicit case (lk_dynspg_exp=T)
+         !                                       sshn_b (= after ssha_b) for time-splitting case (lk_dynspg_ts=T)
+         !                              - Correct the barotropic velocities
+         CALL obc_dyn_bt( kt )
+         !
+!!gm ERROR - potential BUG: sshn should not be modified at this stage !!   ssh_nxt not alrady called
+         CALL lbc_lnk( sshn, 'T', 1. )         ! Boundary conditions on sshn
+         !
+         IF( ln_vol_cst )   CALL obc_vol( kt )
+         !
+         IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshn, clinfo1=' ssh      : ', mask1=tmask )
+      ENDIF
+      !
+# elif defined key_bdy
+      !                                !* BDY open boundaries
+      IF( lk_dynspg_exp ) CALL bdy_dyn( kt )
+      IF( lk_dynspg_ts )  CALL bdy_dyn( kt, dyn3d_only=.true. )
+
+!!$   Do we need a call to bdy_vol here??
+      !
+# endif
+      !
+# if defined key_agrif
+      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
+# endif
+#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
+      ELSE                                             !* Leap-Frog : Asselin filter and swap
+         !                                ! =============!
+         IF( .NOT. lk_vvl ) 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.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
+                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
+                     !
+                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
+                     vb(ji,jj,jk) = zvf
+                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
+                     vn(ji,jj,jk) = va(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !                             ! ================!
+         ELSE                             ! Variable volume !
+            !                             ! ================!
+            !
+            DO jk = 1, jpkm1                 ! Before scale factor at t-points
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)                                   &
+                  &              + atfp * (  fse3t_b(:,:,jk) + fse3t_a(:,:,jk)     &
+                  &                         - 2._wp * fse3t_n(:,:,jk)            )
+            END DO
+            zec = atfp * rdt / rau0          ! Add filter correction only at the 1st level of t-point scale factors
+            fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
+            !
+            IF( ln_dynadv_vec ) THEN         ! vector invariant form (no thickness weighted calulation)
+               !
+               !                                      ! before scale factors at u- & v-pts (computed from fse3t_b)
+               CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) )
+               !
+               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap: applied on velocity
+                  DO jj = 1, jpj                      !                                                 --------
+                     DO ji = 1, jpi
+                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2.e0 * un(ji,jj,jk) + ua(ji,jj,jk) )
+                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2.e0 * vn(ji,jj,jk) + va(ji,jj,jk) )
+                        !
+                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
+                        vb(ji,jj,jk) = zvf
+                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
+                        vn(ji,jj,jk) = va(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               !
+            ELSE                             ! flux form (thickness weighted calulation)
+               !
+               CALL dom_vvl_2( kt, ze3u_f, ze3v_f )   ! before scale factors at u- & v-pts (computed from fse3t_b)
+               !
+               DO jk = 1, jpkm1                       ! Leap-Frog - Asselin filter and swap: 
+                  DO jj = 1, jpj                      !                   applied on thickness weighted velocity
+                     DO ji = 1, jpim1                 !                              ---------------------------
+                        zue3a = ua(ji,jj,jk) * fse3u_a(ji,jj,jk)
+                        zve3a = va(ji,jj,jk) * fse3v_a(ji,jj,jk)
+                        zue3n = un(ji,jj,jk) * fse3u_n(ji,jj,jk)
+                        zve3n = vn(ji,jj,jk) * fse3v_n(ji,jj,jk)
+                        zue3b = ub(ji,jj,jk) * fse3u_b(ji,jj,jk)
+                        zve3b = vb(ji,jj,jk) * fse3v_b(ji,jj,jk)
+                        !
+                        zuf = ( zue3n + atfp * ( zue3b - 2._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
+               fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)      ! e3u_b <-- filtered scale factor
+               fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
+               CALL lbc_lnk( ub, 'U', -1. )                    ! lateral boundary conditions
+               CALL lbc_lnk( vb, 'V', -1. )
+            ENDIF
+            !
+         ENDIF
+         !
+      ENDIF
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   &
+         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
+      ! 
+      CALL wrk_dealloc( jpi,jpj,jpk, ze3u_f, ze3v_f )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_nxt')
+      !
+   END SUBROUTINE dyn_nxt
+
+   !!=========================================================================
+END MODULE dynnxt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90	(revision 3437)
@@ -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 the lateral diffusion
+   !!   dyn_spg_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers variables
+   USE dom_oce        ! ocean space and time domain variables
+   USE phycst         ! physical constants
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE sbcapr         ! surface boundary condition: atmospheric pressure
+   USE dynspg_oce     ! surface pressure gradient variables
+   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine)
+   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine)
+   USE dynspg_flt     ! surface pressure gradient     (dyn_spg_flt routine)
+   USE dynadv         ! dynamics: vector invariant versus flux form
+   USE trdmod         ! ocean dynamics trends
+   USE trdmod_oce     ! ocean variables trends
+   USE prtctl         ! Print control                     (prt_ctl routine)
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! MPP library
+   USE solver          ! solver initialization
+   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_... 
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_spg  ***
+      !!
+      !! ** Purpose :   achieve the momentum time stepping by computing the
+      !!              last trend, the surface pressure gradient including the 
+      !!              atmospheric pressure forcing (ln_apr_dyn=T), and performing
+      !!              the Leap-Frog integration.
+      !!gm              In the current version only the filtered solution provide
+      !!gm            the after velocity, in the 2 other (ua,va) are still the trends
+      !!
+      !! ** Method  :   Three schemes:
+      !!              - explicit computation      : the spg is evaluated at now
+      !!              - filtered computation      : the Roulet & madec (2000) technique is used
+      !!              - split-explicit computation: a time splitting technique is used
+      !!
+      !!              ln_apr_dyn=T : the atmospheric pressure forcing is applied 
+      !!             as the gradient of the inverse barometer ssh:
+      !!                apgu = - 1/rau0 di[apr] = 0.5*grav di[ssh_ib+ssh_ibb]
+      !!                apgv = - 1/rau0 dj[apr] = 0.5*grav dj[ssh_ib+ssh_ibb]
+      !!             Note that as all external forcing a time averaging over a two rdt
+      !!             period is used to prevent the divergence of odd and even time step.
+      !!
+      !! N.B. : When key_esopa is used all the scheme are tested, regardless 
+      !!        of the physical meaning of the results. 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(  out) ::   kindic   ! solver flag
+      !
+      INTEGER  ::   ji, jj, jk                             ! dummy loop indices
+      REAL(wp) ::   z2dt, zg_2                             ! temporary scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg')
+      !
+
+!!gm NOTA BENE : the dynspg_exp and dynspg_ts should be modified so that 
+!!gm             they return the after velocity, not the trends (as in trazdf_imp...)
+!!gm             In this case, change/simplify dynnxt
+
+
+      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 ) THEN                   !==  Atmospheric pressure gradient  ==!
+         zg_2 = grav * 0.5
+         DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               spgu(ji,jj) =  zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    &
+                  &                   + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
+               spgv(ji,jj) =  zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    &
+                  &                   + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
+            END DO
+         END DO
+         DO jk = 1, jpkm1                          ! Add the apg to the general trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj)
+                  va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+
+      SELECT CASE ( nspg )                       ! compute surf. pressure gradient trend and add it to the general trend
+      !                                                     
+      CASE (  0 )   ;   CALL dyn_spg_exp( kt )              ! explicit
+      CASE (  1 )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting
+      CASE (  2 )   ;   CALL dyn_spg_flt( kt, kindic )      ! filtered
+      !                                                    
+      CASE ( -1 )                                ! esopa: test all possibility with control print
+                        CALL dyn_spg_exp( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &
+         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                        CALL dyn_spg_ts ( kt )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &
+         &                           tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                        CALL dyn_spg_flt( kt, kindic )
+                        CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &
+         &                            tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      END SELECT
+      !                    
+      IF( l_trddyn )   THEN                      ! save the surface pressure gradient trends for further diagnostics
+         SELECT CASE ( nspg )
+         CASE ( 0, 1 )
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CASE( 2 )
+            z2dt = 2. * rdt
+            IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
+            ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / z2dt - ztrdu(:,:,:)
+            ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / z2dt - ztrdv(:,:,:)
+         END SELECT
+         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_spg, 'DYN', 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 cpp options for 
+      !!              surface pressure gradient schemes
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_init')
+      !
+      IF(lwp) THEN             ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_spg_init : choice of the surface pressure gradient scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '     Explicit free surface                  lk_dynspg_exp = ', lk_dynspg_exp
+         WRITE(numout,*) '     Free surface with time splitting       lk_dynspg_ts  = ', lk_dynspg_ts
+         WRITE(numout,*) '     Filtered free surface cst volume       lk_dynspg_flt = ', lk_dynspg_flt
+      ENDIF
+
+      !                        ! allocate dyn_spg arrays
+      IF( lk_dynspg_ts ) THEN
+         IF( dynspg_oce_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_oce arrays')
+         IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate dynspg_ts  arrays')
+      ENDIF
+
+      !                        ! Control of surface pressure gradient scheme options
+      ioptio = 0
+      IF(lk_dynspg_exp)   ioptio = ioptio + 1
+      IF(lk_dynspg_ts )   ioptio = ioptio + 1
+      IF(lk_dynspg_flt)   ioptio = ioptio + 1
+      !
+      IF( ( ioptio > 1 .AND. .NOT. lk_esopa ) .OR. ioptio == 0 )   &
+           &   CALL ctl_stop( ' Choose only one surface pressure gradient scheme with a key cpp' )
+      !
+      IF( lk_esopa     )   nspg = -1
+      IF( lk_dynspg_exp)   nspg =  0
+      IF( lk_dynspg_ts )   nspg =  1
+      IF( lk_dynspg_flt)   nspg =  2
+      !
+      IF( lk_esopa     )   nspg = -1
+      !
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nspg == -1 )   WRITE(numout,*) '     ESOPA test All scheme used'
+         IF( nspg ==  0 )   WRITE(numout,*) '     explicit free surface'
+         IF( nspg ==  1 )   WRITE(numout,*) '     free surface with time splitting scheme'
+         IF( nspg ==  2 )   WRITE(numout,*) '     filtered free surface'
+      ENDIF
+
+#if defined key_dynspg_flt || defined key_esopa
+      CALL solver_init( nit000 )   ! Elliptic solver initialisation
+#endif
+
+      !                        ! Control of timestep choice
+      IF( lk_dynspg_ts .OR. lk_dynspg_exp ) THEN
+         IF( nn_cla == 1 )   CALL ctl_stop( 'Crossland advection not implemented for this free surface formulation' )
+      ENDIF
+
+      !                        ! Control of momentum formulation
+      IF( lk_dynspg_ts .AND. lk_vvl ) THEN
+         IF( .NOT.ln_dynadv_vec )   CALL ctl_stop( 'Flux form not implemented for this free surface formulation' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_init')
+      !
+   END SUBROUTINE dyn_spg_init
+
+  !!======================================================================
+END MODULE dynspg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90	(revision 3437)
@@ -0,0 +1,121 @@
+MODULE dynspg_exp
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_exp  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_dynspg_exp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_exp'                              explicit free surface
+   !!----------------------------------------------------------------------
+   !!   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 obc_oce         ! Lateral open boundary condition
+   USE phycst          ! physical constants
+   USE obc_par         ! open boundary condition parameters
+   USE obcdta          ! open boundary condition data     (bdy_dta_bt routine)
+   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 restart         ! only for lrst_oce
+   USE timing          ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_spg_exp   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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( lk_vvl .AND. lwp ) WRITE(numout,*) '              lk_vvl=T : spg is included in dynhpg'
+      ENDIF
+
+
+!!gm bug ??  Rachid we have to discuss of the call below. I don't understand why it is here and not in ssh_wzv
+      IF( lk_obc )   CALL obc_dta_bt( kt, 0 )      ! OBC: read or estimate ssh and vertically integrated velocities
+!!gm
+
+      IF( .NOT. lk_vvl ) THEN          !* fixed volume : 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) ) / e1u(ji,jj)
+               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / 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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module   No standart explicit free surface 
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_spg_exp( kt )       ! Empty routine
+      WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_spg_exp
+#endif
+
+   !!======================================================================
+END MODULE dynspg_exp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90	(revision 3437)
@@ -0,0 +1,406 @@
+MODULE dynspg_flt
+   !!======================================================================
+   !!                   ***  MODULE  dynspg_flt  ***
+   !! Ocean dynamics:  surface pressure gradient trend
+   !!======================================================================
+   !! History    OPA  !  1998-05  (G. Roullet)  free surface
+   !!                 !  1998-10  (G. Madec, M. Imbard)  release 8.2
+   !!   NEMO     O.1  !  2002-08  (G. Madec)  F90: Free form and module
+   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
+   !!            1.0  !  2004-08  (C. Talandier) New trends organization
+   !!             -   !  2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom
+   !!             -   !  2006-08  (J.Chanut, A.Sellar) Calls to BDY routines. 
+   !!            3.2  !  2009-03  (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
+   !!----------------------------------------------------------------------
+#if defined key_dynspg_flt   ||   defined key_esopa  
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_flt'                              filtered free surface
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_flt  : update the momentum trend with the surface pressure gradient in the filtered free surface case 
+   !!   flt_rst      : read/write the time-splitting restart fields in the ocean restart file
+   !!----------------------------------------------------------------------
+   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
+   USE obc_oce         ! Lateral open boundary condition
+   USE bdy_oce         ! Lateral open boundary condition
+   USE sol_oce         ! ocean elliptic solver
+   USE phycst          ! physical constants
+   USE domvvl          ! variable volume
+   USE dynadv          ! advection 
+   USE solmat          ! matrix construction for elliptic solvers
+   USE solpcg          ! preconditionned conjugate gradient solver
+   USE solsor          ! Successive Over-relaxation solver
+   USE obcdyn          ! ocean open boundary condition on dynamics
+   USE obcvol          ! ocean open boundary condition (obc_vol routine)
+   USE bdydyn          ! ocean open boundary condition on dynamics
+   USE bdyvol          ! ocean open boundary condition (bdy_vol routine)
+   USE cla             ! cross land advection
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing library
+   USE wrk_nemo        ! Memory Allocation
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE iom
+   USE restart         ! only for lrst_oce
+   USE lib_fortran
+#if defined key_agrif
+   USE agrif_opa_interp
+#endif
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_spg_flt  ! routine called by step.F90
+   PUBLIC   flt_rst      ! routine called by istate.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_spg_flt( kt, kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_flt  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure 
+      !!      gradient in case of filtered free surface formulation  and add
+      !!      it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Filtered free surface formulation. The surface
+      !!      pressure gradient is given by:
+      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( sshn + btda )
+      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( sshn + btda )
+      !!      where sshn is the free surface elevation and btda is the after
+      !!      time derivative of the free surface elevation
+      !!       -1- evaluate the surface presure trend (including the addi-
+      !!      tional force) in three steps:
+      !!        a- compute the right hand side of the elliptic equation:
+      !!            gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
+      !!         where (spgu,spgv) are given by:
+      !!            spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
+      !!                 - grav 2 rdt hu /e1u di[sshn + (emp-rnf)]
+      !!            spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
+      !!                 - grav 2 rdt hv /e2v dj[sshn + (emp-rnf)]
+      !!         and define the first guess from previous computation :
+      !!            zbtd = btda
+      !!            btda = 2 zbtd - btdb
+      !!            btdb = zbtd
+      !!        b- compute the relative accuracy to be reached by the
+      !!         iterative solver
+      !!        c- apply the solver by a call to sol... routine
+      !!       -2- compute and add the free surface pressure gradient inclu-
+      !!      ding the additional force used to stabilize the equation.
+      !!
+      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
+      !!
+      !! References : Roullet and Madec 1999, JGR.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index
+      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge)
+      !!                                   
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zub, zvb
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_flt')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zub, zvb )
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_spg_flt : surface pressure gradient trend'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   (free surface constant volume case)'
+       
+         ! set to zero free surface specific arrays
+         spgu(:,:) = 0._wp                     ! surface pressure gradient (i-direction)
+         spgv(:,:) = 0._wp                     ! surface pressure gradient (j-direction)
+
+         ! read filtered free surface arrays in restart file
+         ! when using agrif, sshn, gcx have to be read in istate
+         IF(.NOT. lk_agrif)   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields:
+         !                                                        ! gcx, gcxb
+      ENDIF
+
+      ! Local constant initialization
+      z2dt = 2. * rdt                                             ! time step: leap-frog
+      IF( neuler == 0 .AND. kt == nit000   )   z2dt = rdt         ! time step: Euler if restart from rest
+      IF( neuler == 0 .AND. kt == nit000+1 )   CALL sol_mat( kt )
+      z2dtg  = grav * z2dt
+
+      ! Evaluate the masked next velocity (effect of the additional force not included)
+      ! ---------------------------------  
+      IF( lk_vvl ) THEN          ! variable volume  (surface pressure gradient already included in dyn_hpg)
+         !
+         IF( ln_dynadv_vec ) THEN      ! vector form : applied on velocity
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ua(ji,jj,jk)  ) * umask(ji,jj,jk)
+                     va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * va(ji,jj,jk)  ) * vmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            !
+         ELSE                          ! flux form : applied on thickness weighted velocity
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ua(ji,jj,jk) = (        ub(ji,jj,jk) * fse3u_b(ji,jj,jk)      &
+                        &           + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk)  )   &
+                        &         / fse3u_a(ji,jj,jk) * umask(ji,jj,jk)
+                     va(ji,jj,jk) = (        vb(ji,jj,jk) * fse3v_b(ji,jj,jk)      &
+                        &           + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk)  )   &
+                        &         / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            !
+         ENDIF
+         !
+      ELSE                       ! fixed volume  (add the surface pressure gradient + unweighted time stepping)
+         !
+         DO jj = 2, jpjm1              ! Surface pressure gradient (now)
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
+               spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
+            END DO 
+         END DO 
+         DO jk = 1, jpkm1              ! unweighted time stepping 
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ua(ji,jj,jk) = (  ub(ji,jj,jk) + z2dt * ( ua(ji,jj,jk) + spgu(ji,jj) )  ) * umask(ji,jj,jk)
+                  va(ji,jj,jk) = (  vb(ji,jj,jk) + z2dt * ( va(ji,jj,jk) + spgv(ji,jj) )  ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
+#if defined key_obc
+      CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm
+      CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system
+#endif
+#if defined key_bdy
+      CALL bdy_dyn( kt )      ! Update velocities on each open boundary
+      CALL bdy_vol( kt )      ! Correction of the barotropic component velocity to control the volume of the system
+#endif
+#if defined key_agrif
+      CALL Agrif_dyn( kt )    ! Update velocities on each coarse/fine interfaces 
+#endif
+      IF( nn_cla == 1 )   CALL cla_dynspg( kt )      ! Cross Land Advection (update (ua,va))
+
+      ! compute the next vertically averaged velocity (effect of the additional force not included)
+      ! ---------------------------------------------
+      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
+
+      ! vertical sum
+!CDIR NOLOOPCHG
+      IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll
+         DO jk = 1, jpkm1
+            DO ji = 1, jpij
+               spgu(ji,1) = spgu(ji,1) + fse3u(ji,1,jk) * ua(ji,1,jk)
+               spgv(ji,1) = spgv(ji,1) + fse3v(ji,1,jk) * va(ji,1,jk)
+            END DO
+         END DO
+      ELSE                        ! No  vector opt.
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1
+                  spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk)
+                  spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! transport: multiplied by the horizontal scale factor
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
+            spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
+         END DO
+      END DO
+      CALL lbc_lnk( spgu, 'U', -1. )       ! lateral boundary conditions 
+      CALL lbc_lnk( spgv, 'V', -1. )
+
+      IF( lk_vvl ) CALL sol_mat( kt )      ! build the matrix at kt (vvl case only)
+
+      ! Right hand side of the elliptic equation and first guess
+      ! --------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! Divergence of the after vertically averaged velocity
+            zgcb =  spgu(ji,jj) - spgu(ji-1,jj)   &
+                  + spgv(ji,jj) - spgv(ji,jj-1)
+            gcb(ji,jj) = gcdprc(ji,jj) * zgcb
+            ! First guess of the after barotropic transport divergence
+            zbtd = gcx(ji,jj)
+            gcx (ji,jj) = 2. * zbtd   - gcxb(ji,jj)
+            gcxb(ji,jj) =      zbtd
+         END DO
+      END DO
+      ! applied the lateral boundary conditions
+      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )   CALL lbc_lnk_e( gcb, c_solver_pt, 1. )   
+
+#if defined key_agrif
+      IF( .NOT. AGRIF_ROOT() ) THEN
+         ! add contribution of gradient of after barotropic transport divergence 
+         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =   &
+            &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:)
+         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =   &
+            &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:)
+         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =   &
+            &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     )
+         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =   &
+            &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2)
+      ENDIF
+#endif
+
+
+      ! Relative precision (computation on one processor)
+      ! ------------------
+      rnorme =0.e0
+      rnorme = GLOB_SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
+
+      epsr = eps * eps * rnorme
+      ncut = 0
+      ! if rnorme is 0, the solution is 0, the solver is not called
+      IF( rnorme == 0._wp ) THEN
+         gcx(:,:) = 0._wp
+         res   = 0._wp
+         niter = 0
+         ncut  = 999
+      ENDIF
+
+      ! Evaluate the next transport divergence
+      ! --------------------------------------
+      !    Iterarive solver for the elliptic equation (except IF sol.=0)
+      !    (output in gcx with boundary conditions applied)
+      kindic = 0
+      IF( ncut == 0 ) THEN
+         IF    ( nn_solv == 1 ) THEN   ;   CALL sol_pcg( kindic )      ! diagonal preconditioned conjuguate gradient
+         ELSEIF( nn_solv == 2 ) THEN   ;   CALL sol_sor( kindic )      ! successive-over-relaxation
+         ENDIF
+      ENDIF
+
+      ! Transport divergence gradient multiplied by z2dt
+      ! --------------------------------------------====
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! trend of Transport divergence gradient
+            ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj)
+            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
+            ! multiplied by z2dt
+#if defined key_obc
+            ! caution : grad D = 0 along open boundaries
+            ! Remark: The filtering force could be reduced here in the FRS zone
+            !         by multiplying spgu/spgv by (1-alpha) ??  
+            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
+#elif defined key_bdy
+            ! caution : grad D = 0 along open boundaries
+            spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
+            spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
+#else
+            spgu(ji,jj) = z2dt * ztdgu
+            spgv(ji,jj) = z2dt * ztdgv
+#endif
+         END DO
+      END DO
+
+#if defined key_agrif      
+      IF( .NOT. Agrif_Root() ) THEN
+         ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface
+         IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = z2dtg * z2dt * laplacu(2     ,:) * umask(2     ,:,1)
+         IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = z2dtg * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1)
+         IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = z2dtg * z2dt * laplacv(:,2     ) * vmask(:     ,2,1)
+         IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1)
+      ENDIF
+#endif      
+      ! Add the trends multiplied by z2dt to the after velocity
+      ! -------------------------------------------------------
+      !     ( c a u t i o n : (ua,va) here are the after velocity not the
+      !                       trend, the leap-frog time stepping will not
+      !                       be done in dynnxt.F90 routine)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk)
+               va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! write filtered free surface arrays in restart file
+      ! --------------------------------------------------
+      IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zub, zvb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_flt')
+      !
+   END SUBROUTINE dyn_spg_flt
+
+
+   SUBROUTINE flt_rst( kt, cdrw )
+      !!---------------------------------------------------------------------
+      !!                   ***  ROUTINE ts_rst  ***
+      !!
+      !! ** Purpose : Read or write filtered free surface arrays in restart file
+      !!----------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN
+         IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
+! Caution : extra-hallow
+! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
+            CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
+            CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
+            IF( neuler == 0 )   gcxb(:,:) = gcx (:,:)
+         ELSE
+            gcx (:,:) = 0.e0
+            gcxb(:,:) = 0.e0
+         ENDIF
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+! Caution : extra-hallow
+! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
+         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
+         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
+      ENDIF
+      !
+   END SUBROUTINE flt_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module   No standart free surface cst volume
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE dyn_spg_flt( kt, kindic )       ! Empty routine
+      WRITE(*,*) 'dyn_spg_flt: You should not have seen this print! error?', kt, kindic
+   END SUBROUTINE dyn_spg_flt
+   SUBROUTINE flt_rst    ( kt, cdrw )         ! Empty routine
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      WRITE(*,*) 'flt_rst: You should not have seen this print! error?', kt, cdrw
+   END SUBROUTINE flt_rst
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_flt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90	(revision 3437)
@@ -0,0 +1,63 @@
+MODULE dynspg_oce
+   !!======================================================================
+   !!                       ***  MODULE dynspg_oce  ***
+   !!       
+   !! Ocean dynamics: Define in memory some surface pressure gradient variables
+   !!======================================================================
+   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec)  Original code
+   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PUBLIC           
+
+   PUBLIC   dynspg_oce_alloc   ! called in dynspg.F90
+   
+   !                                                       !!! Surface pressure gradient logicals
+#if   defined key_dynspg_exp  ||  defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .TRUE.   !: Explicit free surface flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_exp = .FALSE.  !: Explicit free surface flag
+#endif
+#if   defined key_dynspg_ts   ||  defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .TRUE.   !: Free surface with time splitting flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_ts  = .FALSE.  !: Free surface with time splitting flag
+#endif
+#if   defined key_dynspg_flt  ||  defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .TRUE.   !: Filtered free surface cst volume flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_dynspg_flt = .FALSE.  !: Filtered free surface cst volume flag
+#endif
+
+  !                                                                         !!! Time splitting scheme (key_dynspg_ts) 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   ua_e  , va_e     ! barotropic velocities (after)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e )
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur_e , hvr_e    ! inverse of hu_e and hv_e
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_b           ! before field without time-filter
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION dynspg_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dynspg_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) ,      &
+         &      ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) ,      &
+         &      sshn_b(jpi,jpj)                                                  , STAT = dynspg_oce_alloc )
+         !
+      IF( lk_mpp                )   CALL mpp_sum ( dynspg_oce_alloc )
+      IF( dynspg_oce_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION dynspg_oce_alloc
+
+   !!======================================================================
+END MODULE dynspg_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90	(revision 3437)
@@ -0,0 +1,794 @@
+MODULE dynspg_ts
+   !!======================================================================
+   !! 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
+   !!---------------------------------------------------------------------
+#if defined key_dynspg_ts   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_ts'         free surface cst volume with time splitting
+   !!----------------------------------------------------------------------
+   !!   dyn_spg_ts  : compute surface pressure gradient trend using a time-
+   !!                 splitting scheme and add to the general trend 
+   !!   ts_rst      : read/write the time-splitting restart fields in the ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE dynspg_oce      ! surface pressure gradient variables
+   USE phycst          ! physical constants
+   USE domvvl          ! variable volume
+   USE zdfbfr          ! bottom friction
+   USE dynvor          ! vorticity term
+   USE obc_oce         ! Lateral open boundary condition
+   USE obc_par         ! open boundary condition parameters
+   USE obcdta          ! open boundary condition data     
+   USE obcfla          ! Flather open boundary condition  
+   USE bdy_par         ! for lk_bdy
+   USE bdy_oce         ! Lateral open boundary condition
+   USE bdydta          ! open boundary condition data     
+   USE bdydyn2d        ! open boundary conditions on barotropic variables
+   USE sbctide
+   USE updtide
+   USE lib_mpp         ! distributed memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE restart         ! only for lrst_oce
+   USE zdf_oce         ! Vertical diffusion
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC dyn_spg_ts        ! routine called by step.F90
+   PUBLIC ts_rst            ! routine called by istate.F90
+   PUBLIC dyn_spg_ts_alloc  ! routine called by dynspg.F90
+
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne   ! triad of coriolis parameter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   ! (only used with een vorticity scheme)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b   ! now    averaged velocity
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b   ! before averaged velocity
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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 dyn_spg_ts_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_ts_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ftnw  (jpi,jpj) , ftne(jpi,jpj) , un_b(jpi,jpj) , vn_b(jpi,jpj) ,     &
+         &      ftsw  (jpi,jpj) , ftse(jpi,jpj) , ub_b(jpi,jpj) , vb_b(jpi,jpj) , STAT= dyn_spg_ts_alloc )
+         !
+      IF( lk_mpp                )   CALL mpp_sum( dyn_spg_ts_alloc )
+      IF( dyn_spg_ts_alloc /= 0 )   CALL ctl_warn('dynspg_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION dyn_spg_ts_alloc
+
+
+   SUBROUTINE dyn_spg_ts( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine dyn_spg_ts  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to the surface pressure
+      !!      gradient in case of free surface formulation with time-splitting.
+      !!      Add it to the general trend of momentum equation.
+      !!
+      !! ** Method  :   Free surface formulation with time-splitting
+      !!      -1- Save the vertically integrated trend. This general trend is
+      !!          held constant over the barotropic integration.
+      !!          The Coriolis force is removed from the general trend as the
+      !!          surface gradient and the Coriolis force are updated within
+      !!          the barotropic integration.
+      !!      -2- Barotropic loop : updates of sea surface height (ssha_e) and 
+      !!          barotropic velocity (ua_e and va_e) through barotropic 
+      !!          momentum and continuity integration. Barotropic former 
+      !!          variables are time averaging over the full barotropic cycle
+      !!          (= 2 * baroclinic time step) and saved in uX_b 
+      !!          and vX_b (X specifying after, now or before).
+      !!      -3- The new general trend becomes :
+      !!          ua = ua - sum_k(ua)/H + ( un_b - ub_b )
+      !!
+      !! ** Action : - Update (ua,va) with the surf. pressure gradient trend
+      !!
+      !! References : Griffies et al., (2003): A technical guide to MOM4. NOAA/GFDL
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      INTEGER  ::   icycle           ! local scalar
+      INTEGER  ::   ikbu, ikbv       ! local scalar
+      REAL(wp) ::   zraur, zcoef, z2dt_e, z1_2dt_b, z2dt_bf   ! local scalars
+      REAL(wp) ::   z1_8, zx1, zy1                            !   -      -
+      REAL(wp) ::   z1_4, zx2, zy2                            !   -      -
+      REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp            !   -      -
+      REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp            !   -      -
+      REAL(wp) ::   ua_btm, va_btm                            !   -      -
+      !
+      REAL(wp), POINTER, DIMENSION(:,:) :: zsshun_e, zsshvn_e, zsshb_e, zssh_sum, zhdiv 
+      REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e 
+      REAL(wp), POINTER, DIMENSION(:,:) :: zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_spg_ts')
+      !
+      CALL wrk_alloc( jpi, jpj, zsshun_e, zsshvn_e, zsshb_e, zssh_sum, zhdiv     )
+      CALL wrk_alloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e   )
+      CALL wrk_alloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum )
+      !
+      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,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ',  2*nn_baro
+         !
+         CALL ts_rst( nit000, 'READ' )   ! read or initialize the following fields: un_b, vn_b  
+         !
+         ua_e  (:,:) = un_b (:,:)
+         va_e  (:,:) = vn_b (:,:)
+         hu_e  (:,:) = hu   (:,:)
+         hv_e  (:,:) = hv   (:,:)
+         hur_e (:,:) = hur  (:,:)
+         hvr_e (:,:) = hvr  (:,:)
+         IF( ln_dynvor_een ) THEN
+            ftne(1,:) = 0._wp   ;   ftnw(1,:) = 0._wp   ;   ftse(1,:) = 0._wp   ;   ftsw(1,:) = 0._wp
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  ftne(ji,jj) = ( ff(ji-1,jj  ) + ff(ji  ,jj  ) + ff(ji  ,jj-1) ) / 3._wp
+                  ftnw(ji,jj) = ( ff(ji-1,jj-1) + ff(ji-1,jj  ) + ff(ji  ,jj  ) ) / 3._wp
+                  ftse(ji,jj) = ( ff(ji  ,jj  ) + ff(ji  ,jj-1) + ff(ji-1,jj-1) ) / 3._wp
+                  ftsw(ji,jj) = ( ff(ji  ,jj-1) + ff(ji-1,jj-1) + ff(ji-1,jj  ) ) / 3._wp
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+
+      !                                                     !* Local constant initialization
+      z1_2dt_b = 1._wp / ( 2.0_wp * rdt )                   ! reciprocal of baroclinic time step
+      IF( neuler == 0 .AND. kt == nit000 )   z1_2dt_b = 1.0_wp / rdt    ! reciprocal of baroclinic 
+                                                                        ! time step (euler timestep)
+      z1_8     = 0.125_wp                                   ! coefficient for vorticity estimates
+      z1_4     = 0.25_wp        
+      zraur    = 1._wp / rau0                               ! 1 / volumic mass
+      !
+      zhdiv(:,:) = 0._wp                                    ! barotropic divergence
+      zu_sld = 0._wp   ;   zu_asp = 0._wp                   ! tides trends (lk_tide=F)
+      zv_sld = 0._wp   ;   zv_asp = 0._wp
+
+      IF( kt == nit000 .AND. neuler == 0) THEN              ! for implicit bottom friction
+        z2dt_bf = rdt
+      ELSE
+        z2dt_bf = 2.0_wp * rdt
+      ENDIF
+
+      ! -----------------------------------------------------------------------------
+      !  Phase 1 : Coupling between general trend and barotropic estimates (1st step)
+      ! -----------------------------------------------------------------------------
+      !      
+      !                                   !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated)
+      !                                   ! --------------------------
+      zua(:,:) = 0._wp   ;   zun(:,:) = 0._wp   ;   ub_b(:,:) = 0._wp
+      zva(:,:) = 0._wp   ;   zvn(:,:) = 0._wp   ;   vb_b(:,:) = 0._wp
+      !
+      DO jk = 1, jpkm1
+#if defined key_vectopt_loop
+         DO jj = 1, 1         !Vector opt. => forced unrolling
+            DO ji = 1, jpij
+#else 
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#endif
+               !                                                                              ! now trend
+               zua(ji,jj) = zua(ji,jj) + fse3u  (ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk)
+               zva(ji,jj) = zva(ji,jj) + fse3v  (ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk)
+               !                                                                              ! now velocity 
+               zun(ji,jj) = zun(ji,jj) + fse3u  (ji,jj,jk) * un(ji,jj,jk)
+               zvn(ji,jj) = zvn(ji,jj) + fse3v  (ji,jj,jk) * vn(ji,jj,jk)               
+               !
+#if defined key_vvl
+               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk)* ub(ji,jj,jk)   *umask(ji,jj,jk) 
+               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk)* vb(ji,jj,jk)   *vmask(ji,jj,jk)
+#else
+               ub_b(ji,jj) = ub_b(ji,jj) + fse3u_0(ji,jj,jk) * ub(ji,jj,jk)  * umask(ji,jj,jk)
+               vb_b(ji,jj) = vb_b(ji,jj) + fse3v_0(ji,jj,jk) * vb(ji,jj,jk)  * vmask(ji,jj,jk)
+#endif
+            END DO
+         END DO
+      END DO
+
+      !                                   !* 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) - zua(ji,jj) * hur(ji,jj)
+               va(ji,jj,jk) = va(ji,jj,jk) - zva(ji,jj) * hvr(ji,jj)
+            END DO
+         END DO
+      END DO
+
+      !                                   !* barotropic Coriolis trends * H (vorticity scheme dependent)
+      !                                   ! ---------------------------====
+      zwx(:,:) = zun(:,:) * e2u(:,:)                   ! now transport 
+      zwy(:,:) = zvn(:,:) * 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) ) / e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               ! energy conserving formulation for planetary vorticity term
+               zcu(ji,jj) = z1_4 * ( ff(ji  ,jj-1) * zy1 + ff(ji,jj) * zy2 )
+               zcv(ji,jj) =-z1_4 * ( ff(ji-1,jj  ) * zx1 + ff(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  ) ) / e1u(ji,jj)
+               zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) + zwx(ji,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               zcu(ji,jj)  = zy1 * ( ff(ji  ,jj-1) + ff(ji,jj) )
+               zcv(ji,jj)  = zx1 * ( ff(ji-1,jj  ) + ff(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.
+               zcu(ji,jj) = + z1_4 / 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) )
+               zcv(ji,jj) = - z1_4 / 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( lk_vvl ) THEN                         ! Variable volume : remove both Coriolis and Surface pressure gradient
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcu(ji,jj) = zcu(ji,jj) - grav * (  ( rhd(ji+1,jj  ,1) + 1 ) * sshn(ji+1,jj  )    &
+                  &                              - ( rhd(ji  ,jj  ,1) + 1 ) * sshn(ji  ,jj  )  ) * hu(ji,jj) / e1u(ji,jj)
+               zcv(ji,jj) = zcv(ji,jj) - grav * (  ( rhd(ji  ,jj+1,1) + 1 ) * sshn(ji  ,jj+1)    &
+                  &                              - ( rhd(ji  ,jj  ,1) + 1 ) * sshn(ji  ,jj  )  ) * hv(ji,jj) / e2v(ji,jj)
+            END DO
+         END DO
+      ENDIF
+
+      DO jj = 2, jpjm1                             ! Remove coriolis term (and possibly spg) from barotropic trend
+         DO ji = fs_2, fs_jpim1
+             zua(ji,jj) = zua(ji,jj) - zcu(ji,jj)
+             zva(ji,jj) = zva(ji,jj) - zcv(ji,jj)
+          END DO
+      END DO
+
+                    
+      !                                             ! Remove barotropic contribution of bottom friction 
+      !                                             ! from the barotropic transport trend
+      zcoef = -1._wp * z1_2dt_b
+
+      IF(ln_bfrimp) THEN
+      !                                   ! Remove the bottom stress trend from 3-D sea surface level gradient
+      !                                   ! and Coriolis forcing in case of 3D semi-implicit bottom friction 
+        DO jj = 2, jpjm1         
+           DO ji = fs_2, fs_jpim1
+              ikbu = mbku(ji,jj)
+              ikbv = mbkv(ji,jj)
+              ua_btm = zcu(ji,jj) * z2dt_bf * hur(ji,jj) * umask (ji,jj,ikbu)
+              va_btm = zcv(ji,jj) * z2dt_bf * hvr(ji,jj) * vmask (ji,jj,ikbv)
+
+              zua(ji,jj) = zua(ji,jj) - bfrua(ji,jj) * ua_btm
+              zva(ji,jj) = zva(ji,jj) - bfrva(ji,jj) * va_btm
+           END DO
+        END DO
+
+      ELSE
+
+# if defined key_vectopt_loop
+        DO jj = 1, 1
+           DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+        DO jj = 2, jpjm1
+           DO ji = 2, jpim1
+# endif
+            ! Apply stability criteria for bottom friction
+            !RBbug for vvl and external mode we may need to use varying fse3
+            !!gm  Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx.
+              zbfru(ji,jj) = MAX(  bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef  )
+              zbfrv(ji,jj) = MAX(  bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef  )
+           END DO
+        END DO
+
+        IF( lk_vvl ) THEN
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj)   &
+                    &       / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1._wp - umask(ji,jj,1) )
+                 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj)   &
+                    &       / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1._wp - vmask(ji,jj,1) )
+              END DO
+           END DO
+        ELSE
+           DO jj = 2, jpjm1
+              DO ji = fs_2, fs_jpim1   ! vector opt.
+                 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj)
+                 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj)
+              END DO
+           END DO
+        ENDIF
+      END IF    ! end (ln_bfrimp)
+
+                    
+      !                                   !* d/dt(Ua), Ub, Vn (Vertical mean velocity)
+      !                                   ! -------------------------- 
+      zua(:,:) = zua(:,:) * hur(:,:)
+      zva(:,:) = zva(:,:) * hvr(:,:)
+      !
+      IF( lk_vvl ) THEN
+         ub_b(:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )
+         vb_b(:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) )
+      ELSE
+         ub_b(:,:) = ub_b(:,:) * hur(:,:)
+         vb_b(:,:) = vb_b(:,:) * hvr(:,:)
+      ENDIF
+
+      ! -----------------------------------------------------------------------
+      !  Phase 2 : Integration of the barotropic equations with time splitting
+      ! -----------------------------------------------------------------------
+      !
+      !                                             ! ==================== !
+      !                                             !    Initialisations   !
+      !                                             ! ==================== !
+      icycle = 2  * nn_baro            ! Number of barotropic sub time-step
+      
+      !                                ! Start from NOW field
+      hu_e   (:,:) = hu   (:,:)            ! ocean depth at u- and v-points
+      hv_e   (:,:) = hv   (:,:) 
+      hur_e  (:,:) = hur  (:,:)            ! ocean depth inverted at u- and v-points
+      hvr_e  (:,:) = hvr  (:,:)
+!RBbug     zsshb_e(:,:) = sshn (:,:)  
+      zsshb_e(:,:) = sshn_b(:,:)           ! sea surface height (before and now)
+      sshn_e (:,:) = sshn (:,:)
+      
+      zun_e  (:,:) = un_b (:,:)            ! barotropic velocity (external)
+      zvn_e  (:,:) = vn_b (:,:)
+      zub_e  (:,:) = un_b (:,:)
+      zvb_e  (:,:) = vn_b (:,:)
+
+      zu_sum  (:,:) = un_b (:,:)           ! summation
+      zv_sum  (:,:) = vn_b (:,:)
+      zssh_sum(:,:) = sshn (:,:)
+
+#if defined key_obc
+      ! set ssh corrections to 0
+      ! ssh corrections are applied to normal velocities (Flather's algorithm) and averaged over the barotropic loop
+      IF( lp_obc_east  )   sshfoe_b(:,:) = 0._wp
+      IF( lp_obc_west  )   sshfow_b(:,:) = 0._wp
+      IF( lp_obc_south )   sshfos_b(:,:) = 0._wp
+      IF( lp_obc_north )   sshfon_b(:,:) = 0._wp
+#endif
+
+      !                                             ! ==================== !
+      DO jn = 1, icycle                             !  sub-time-step loop  ! (from NOW to AFTER+1)
+         !                                          ! ==================== !
+         z2dt_e = 2. * ( rdt / nn_baro )
+         IF( jn == 1 )   z2dt_e = rdt / nn_baro
+
+         !                                                !* Update the forcing (BDY and tides)
+         !                                                !  ------------------
+         IF( lk_obc )   CALL obc_dta_bt ( kt, jn   )
+         IF( lk_bdy )   CALL bdy_dta ( kt, jit=jn, time_offset=+1 )
+         IF ( ln_tide_pot ) CALL upd_tide( kt, jn )
+
+         !                                                !* after ssh_e
+         !                                                !  -----------
+         DO jj = 2, jpjm1                                 ! Horizontal divergence of barotropic transports
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zhdiv(ji,jj) = (   e2u(ji  ,jj) * zun_e(ji  ,jj) * hu_e(ji  ,jj)     &
+                  &             - e2u(ji-1,jj) * zun_e(ji-1,jj) * hu_e(ji-1,jj)     &
+                  &             + e1v(ji,jj  ) * zvn_e(ji,jj  ) * hv_e(ji,jj  )     &
+                  &             - e1v(ji,jj-1) * zvn_e(ji,jj-1) * hv_e(ji,jj-1)   ) / ( e1t(ji,jj) * e2t(ji,jj) )
+            END DO
+         END DO
+         !
+#if defined key_obc
+         !                                                     ! OBC : zhdiv must be zero behind the open boundary
+!!  mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column
+         IF( lp_obc_east  )   zhdiv(nie0p1:nie1p1,nje0  :nje1  ) = 0._wp      ! east
+         IF( lp_obc_west  )   zhdiv(niw0  :niw1  ,njw0  :njw1  ) = 0._wp      ! west
+         IF( lp_obc_north )   zhdiv(nin0  :nin1  ,njn0p1:njn1p1) = 0._wp      ! north
+         IF( lp_obc_south )   zhdiv(nis0  :nis1  ,njs0  :njs1  ) = 0._wp      ! south
+#endif
+#if defined key_bdy
+         zhdiv(:,:) = zhdiv(:,:) * bdytmask(:,:)               ! BDY mask
+#endif
+         !
+         DO jj = 2, jpjm1                                      ! leap-frog on ssh_e
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 
+            END DO
+         END DO
+
+         !                                                !* after barotropic velocities (vorticity scheme dependent)
+         !                                                !  ---------------------------  
+         zwx(:,:) = e2u(:,:) * zun_e(:,:) * hu_e(:,:)     ! now_e transport
+         zwy(:,:) = e1v(:,:) * zvn_e(:,:) * hv_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.
+                  ! surface pressure gradient
+                  IF( lk_vvl) THEN
+                     zu_spg = -grav * (  ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj  )    &
+                        &              - ( rhd(ji  ,jj ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e1u(ji,jj)
+                     zv_spg = -grav * (  ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji  ,jj+1)    &
+                        &              - ( rhd(ji ,jj  ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e2v(ji,jj)
+                  ELSE
+                     zu_spg = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) / e1u(ji,jj)
+                     zv_spg = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! add tidal astronomical forcing
+                  IF ( ln_tide_pot ) THEN 
+                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
+                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! energy conserving formulation for planetary vorticity term
+                  zy1 = ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj)
+                  zy2 = ( zwy(ji  ,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                  zx1 = ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
+                  zx2 = ( zwx(ji  ,jj  ) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                  zu_cor = z1_4 * ( ff(ji  ,jj-1) * zy1 + ff(ji,jj) * zy2 ) * hur_e(ji,jj)
+                  zv_cor =-z1_4 * ( ff(ji-1,jj  ) * zx1 + ff(ji,jj) * zx2 ) * hvr_e(ji,jj)
+                  ! after velocities with implicit bottom friction
+
+                  IF( ln_bfrimp ) THEN      ! implicit bottom friction
+                     !   A new method to implement the implicit bottom friction. 
+                     !   H. Liu
+                     !   Sept 2011
+                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) )
+                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)   
+                     !
+                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) )
+                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)   
+                     !
+                  ELSE
+                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1)   &
+                      &           / ( 1._wp         - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) )
+                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1)   &
+                      &           / ( 1._wp         - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) )
+                  ENDIF
+               END DO
+            END DO
+            !
+         ELSEIF ( ln_dynvor_ens ) THEN                    !==  enstrophy conserving scheme  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                   ! surface pressure gradient
+                  IF( lk_vvl) THEN
+                     zu_spg = -grav * (  ( rhd(ji+1,jj ,1) + 1 ) * sshn_e(ji+1,jj  )    &
+                        &              - ( rhd(ji  ,jj ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e1u(ji,jj)
+                     zv_spg = -grav * (  ( rhd(ji ,jj+1,1) + 1 ) * sshn_e(ji  ,jj+1)    &
+                        &              - ( rhd(ji ,jj  ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e2v(ji,jj)
+                  ELSE
+                     zu_spg = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) / e1u(ji,jj)
+                     zv_spg = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! add tidal astronomical forcing
+                  IF ( ln_tide_pot ) THEN
+                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
+                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! enstrophy conserving formulation for planetary vorticity term
+                  zy1 =   z1_8 * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1) + zwy(ji,jj) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+                  zx1 = - z1_8 * ( zwx(ji-1,jj  ) + zwx(ji-1,jj+1) + zwx(ji,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+                  zu_cor  = zy1 * ( ff(ji  ,jj-1) + ff(ji,jj) ) * hur_e(ji,jj)
+                  zv_cor  = zx1 * ( ff(ji-1,jj  ) + ff(ji,jj) ) * hvr_e(ji,jj)
+                  ! after velocities with implicit bottom friction
+                  IF( ln_bfrimp ) THEN
+                     !   A new method to implement the implicit bottom friction. 
+                     !   H. Liu
+                     !   Sept 2011
+                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) )
+                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)   
+                     !
+                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) )
+                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)   
+                     !
+                  ELSE
+                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1)   &
+                     &            / ( 1._wp        - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) )
+                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1)   &
+                     &            / ( 1._wp        - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) )
+                  ENDIF
+               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.
+                  ! surface pressure gradient
+                  IF( lk_vvl) THEN
+                     zu_spg = -grav * (  ( rhd(ji+1,jj  ,1) + 1 ) * sshn_e(ji+1,jj  )    &
+                        &              - ( rhd(ji  ,jj  ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e1u(ji,jj)
+                     zv_spg = -grav * (  ( rhd(ji  ,jj+1,1) + 1 ) * sshn_e(ji  ,jj+1)    &
+                        &              - ( rhd(ji  ,jj  ,1) + 1 ) * sshn_e(ji  ,jj  )  ) / e2v(ji,jj)
+                  ELSE
+                     zu_spg = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) / e1u(ji,jj)
+                     zv_spg = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! add tidal astronomical forcing
+                  IF ( ln_tide_pot ) THEN
+                  zu_spg = zu_spg + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) / e1u(ji,jj)
+                  zv_spg = zv_spg + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) / e2v(ji,jj)
+                  ENDIF
+                  ! energy/enstrophy conserving formulation for planetary vorticity term
+                  zu_cor = + z1_4 / 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) ) * hur_e(ji,jj)
+                  zv_cor = - z1_4 / 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  ) ) * hvr_e(ji,jj)
+                  ! after velocities with implicit bottom friction
+                  IF( ln_bfrimp ) THEN
+                     !   A new method to implement the implicit bottom friction. 
+                     !   H. Liu
+                     !   Sept 2011
+                     ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) )
+                     ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e *   zua(ji,jj)  ) * umask(ji,jj,1)   
+                     !
+                     va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) +                                            &
+                      &                               z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp )            &
+                      &                               / ( 1._wp      - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) )
+                     va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e *   zva(ji,jj)  ) * vmask(ji,jj,1)   
+                     !
+                  ELSE
+                     ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1)   &
+                     &            / ( 1._wp        - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) )
+                     va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1)   &
+                     &            / ( 1._wp        - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) )
+                  ENDIF
+               END DO
+            END DO
+            ! 
+         ENDIF
+         !                                                     !* domain lateral boundary
+         !                                                     !  -----------------------
+
+                                                               ! OBC open boundaries
+         IF( lk_obc               )   CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e )
+
+                                                               ! BDY open boundaries
+#if defined key_bdy
+         pssh => sshn_e
+         phur => hur_e
+         phvr => hvr_e
+         pu2d => ua_e
+         pv2d => va_e
+
+         IF( lk_bdy )   CALL bdy_dyn2d( kt ) 
+#endif
+
+         !
+         CALL lbc_lnk( ua_e  , 'U', -1. )                      ! local domain boundaries 
+         CALL lbc_lnk( va_e  , 'V', -1. )
+         CALL lbc_lnk( ssha_e, 'T',  1. )
+
+         zu_sum  (:,:) = zu_sum  (:,:) + ua_e  (:,:)           ! Sum over sub-time-steps
+         zv_sum  (:,:) = zv_sum  (:,:) + va_e  (:,:) 
+         zssh_sum(:,:) = zssh_sum(:,:) + ssha_e(:,:) 
+
+         !                                                !* Time filter and swap
+         !                                                !  --------------------
+         IF( jn == 1 ) THEN                                     ! Swap only (1st Euler time step)
+            zsshb_e(:,:) = sshn_e(:,:)
+            zub_e  (:,:) = zun_e (:,:)
+            zvb_e  (:,:) = zvn_e (:,:)
+            sshn_e (:,:) = ssha_e(:,:)
+            zun_e  (:,:) = ua_e  (:,:)
+            zvn_e  (:,:) = va_e  (:,:)
+         ELSE                                                   ! Swap + Filter
+            zsshb_e(:,:) = atfp * ( zsshb_e(:,:) + ssha_e(:,:) ) + atfp1 * sshn_e(:,:)
+            zub_e  (:,:) = atfp * ( zub_e  (:,:) + ua_e  (:,:) ) + atfp1 * zun_e (:,:)
+            zvb_e  (:,:) = atfp * ( zvb_e  (:,:) + va_e  (:,:) ) + atfp1 * zvn_e (:,:)
+            sshn_e (:,:) = ssha_e(:,:)
+            zun_e  (:,:) = ua_e  (:,:)
+            zvn_e  (:,:) = va_e  (:,:)
+         ENDIF
+
+         IF( lk_vvl ) THEN                                !* Update ocean depth (variable volume case only)
+            !                                             !  ------------------
+            DO jj = 1, jpjm1                                    ! Sea Surface Height at u- & v-points
+               DO ji = 1, fs_jpim1   ! Vector opt.
+                  zsshun_e(ji,jj) = 0.5_wp * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )       &
+                     &                     * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn_e(ji  ,jj)    &
+                     &                     +   e1t(ji+1,jj) * e2t(ji+1,jj) * sshn_e(ji+1,jj) )
+                  zsshvn_e(ji,jj) = 0.5_wp * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )       &
+                     &                     * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn_e(ji,jj  )    &
+                     &                     +   e1t(ji,jj+1) * e2t(ji,jj+1) * sshn_e(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( zsshun_e, 'U', 1. )                   ! lateral boundaries conditions
+            CALL lbc_lnk( zsshvn_e, 'V', 1. ) 
+            !
+            hu_e (:,:) = hu_0(:,:) + zsshun_e(:,:)              ! Ocean depth at U- and V-points
+            hv_e (:,:) = hv_0(:,:) + zsshvn_e(:,:)
+            hur_e(:,:) = umask(:,:,1) / ( hu_e(:,:) + 1._wp - umask(:,:,1) )
+            hvr_e(:,:) = vmask(:,:,1) / ( hv_e(:,:) + 1._wp - vmask(:,:,1) )
+            !
+         ENDIF
+         !                                                 ! ==================== !
+      END DO                                               !        end loop      !
+      !                                                    ! ==================== !
+
+#if defined key_obc
+      IF( lp_obc_east  )   sshfoe_b(:,:) = zcoef * sshfoe_b(:,:)     !!gm totally useless ?????
+      IF( lp_obc_west  )   sshfow_b(:,:) = zcoef * sshfow_b(:,:)
+      IF( lp_obc_north )   sshfon_b(:,:) = zcoef * sshfon_b(:,:)
+      IF( lp_obc_south )   sshfos_b(:,:) = zcoef * sshfos_b(:,:)
+#endif
+
+      ! -----------------------------------------------------------------------------
+      ! Phase 3. update the general trend with the barotropic trend
+      ! -----------------------------------------------------------------------------
+      !
+      !                                   !* Time average ==> after barotropic u, v, ssh
+      zcoef =  1._wp / ( 2 * nn_baro  + 1 ) 
+      zu_sum(:,:) = zcoef * zu_sum  (:,:) 
+      zv_sum(:,:) = zcoef * zv_sum  (:,:) 
+      ! 
+      !                                   !* update the general momentum trend
+      DO jk=1,jpkm1
+         ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) * z1_2dt_b
+         va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) * z1_2dt_b
+      END DO
+      un_b  (:,:) =  zu_sum(:,:) 
+      vn_b  (:,:) =  zv_sum(:,:) 
+      sshn_b(:,:) = zcoef * zssh_sum(:,:) 
+      !
+      !                                   !* write time-spliting arrays in the restart
+      IF( lrst_oce )   CALL ts_rst( kt, 'WRITE' )
+      !
+      CALL wrk_dealloc( jpi, jpj, zsshun_e, zsshvn_e, zsshb_e, zssh_sum, zhdiv     )
+      CALL wrk_dealloc( jpi, jpj, zua, zva, zun, zvn, zun_e, zvn_e, zub_e, zvb_e   )
+      CALL wrk_dealloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_spg_ts')
+      !
+   END SUBROUTINE dyn_spg_ts
+
+
+   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
+      !
+      INTEGER ::  ji, jk        ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      IF( TRIM(cdrw) == 'READ' ) THEN
+         IF( iom_varid( numror, 'un_b', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_autoglo, 'un_b'  , un_b  (:,:) )   ! external velocity issued
+            CALL iom_get( numror, jpdom_autoglo, 'vn_b'  , vn_b  (:,:) )   ! from barotropic loop
+         ELSE
+            un_b (:,:) = 0._wp
+            vn_b (:,:) = 0._wp
+            ! vertical sum
+            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpij
+                     un_b(ji,1) = un_b(ji,1) + fse3u(ji,1,jk) * un(ji,1,jk)
+                     vn_b(ji,1) = vn_b(ji,1) + fse3v(ji,1,jk) * vn(ji,1,jk)
+                  END DO
+               END DO
+            ELSE                             ! No  vector opt.
+               DO jk = 1, jpkm1
+                  un_b(:,:) = un_b(:,:) + fse3u(:,:,jk) * un(:,:,jk)
+                  vn_b(:,:) = vn_b(:,:) + fse3v(:,:,jk) * vn(:,:,jk)
+               END DO
+            ENDIF
+            un_b (:,:) = un_b(:,:) * hur(:,:)
+            vn_b (:,:) = vn_b(:,:) * hvr(:,:)
+         ENDIF
+
+         ! Vertically integrated velocity (before)
+         IF (neuler/=0) THEN
+            ub_b (:,:) = 0._wp
+            vb_b (:,:) = 0._wp
+
+            ! vertical sum
+            IF( lk_vopt_loop ) THEN          ! vector opt., forced unroll
+               DO jk = 1, jpkm1
+                  DO ji = 1, jpij
+                     ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk)
+                     vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk)
+                  END DO
+               END DO
+            ELSE                             ! No  vector opt.
+               DO jk = 1, jpkm1
+                  ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk)
+                  vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk)
+               END DO
+            ENDIF
+
+            IF( lk_vvl ) THEN
+               ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )
+               vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) )
+            ELSE
+               ub_b(:,:) = ub_b(:,:) * hur(:,:)
+               vb_b(:,:) = vb_b(:,:) * hvr(:,:)
+            ENDIF
+         ELSE                                 ! neuler==0
+            ub_b (:,:) = un_b (:,:)
+            vb_b (:,:) = vn_b (:,:)
+         ENDIF
+
+         IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN
+            CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) )   ! filtered ssh
+         ELSE
+            sshn_b(:,:) = sshb(:,:)   ! if not in restart set previous time mean to current baroclinic before value   
+         ENDIF 
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
+         CALL iom_rstput( kt, nitrst, numrow, 'un_b'   , un_b  (:,:) )   ! external velocity and ssh
+         CALL iom_rstput( kt, nitrst, numrow, 'vn_b'   , vn_b  (:,:) )   ! issued from barotropic loop
+         CALL iom_rstput( kt, nitrst, numrow, 'sshn_b' , sshn_b(:,:) )   ! 
+      ENDIF
+      !
+   END SUBROUTINE ts_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :   Empty module   No standart free surface cst volume
+   !!----------------------------------------------------------------------
+CONTAINS
+   INTEGER FUNCTION dyn_spg_ts_alloc()    ! Dummy function
+      dyn_spg_ts_alloc = 0
+   END FUNCTION dyn_spg_ts_alloc
+   SUBROUTINE dyn_spg_ts( kt )            ! Empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'dyn_spg_ts: You should not have seen this print! error?', kt
+   END SUBROUTINE dyn_spg_ts
+   SUBROUTINE ts_rst( kt, cdrw )          ! Empty routine
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      WRITE(*,*) 'ts_rst    : You should not have seen this print! error?', kt, cdrw
+   END SUBROUTINE ts_rst    
+#endif
+   
+   !!======================================================================
+END MODULE dynspg_ts
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90	(revision 3437)
@@ -0,0 +1,785 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_vor      : Update the momentum trend with the vorticity trend
+   !!       vor_ens  : enstrophy conserving scheme       (ln_dynvor_ens=T)
+   !!       vor_ene  : energy conserving scheme          (ln_dynvor_ene=T)
+   !!       vor_mix  : mixed enstrophy/energy conserving (ln_dynvor_mix=T)
+   !!       vor_een  : energy and enstrophy conserving   (ln_dynvor_een=T)
+   !!   dyn_vor_init : set and control of the different vorticity option
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE dommsk         ! ocean mask
+   USE dynadv         ! momentum advection (use ln_dynadv_vec value)
+   USE trdmod         ! ocean dynamics trends 
+   USE trdmod_oce     ! ocean variables trends
+   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 opa.F90
+
+   !                                             !!* Namelist namdyn_vor: vorticity term
+   LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   !: energy conserving scheme
+   LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    !: enstrophy conserving scheme
+   LOGICAL, PUBLIC ::   ln_dynvor_mix = .FALSE.   !: mixed scheme
+   LOGICAL, PUBLIC ::   ln_dynvor_een = .FALSE.   !: energy and enstrophy conserving scheme
+
+   INTEGER ::   nvor = 0   ! type of vorticity trend used
+   INTEGER ::   ncor = 1   ! coriolis
+   INTEGER ::   nrvm = 2   ! =2 relative vorticity ; =3 metric term
+   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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) ('key_trddyn')
+      !!----------------------------------------------------------------------
+      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 )
+      !
+      !                                          ! vorticity term 
+      SELECT CASE ( nvor )                       ! compute the vorticity trend and add it to the general trend
+      !
+      CASE ( -1 )                                      ! esopa: test all possibility with control print
+         CALL vor_ene( kt, ntot, ua, va )
+         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor0 - Ua: ', mask1=umask, &
+            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         CALL vor_ens( kt, ntot, ua, va )
+         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor1 - Ua: ', mask1=umask, &
+            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         CALL vor_mix( kt )
+         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor2 - Ua: ', mask1=umask, &
+            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         CALL vor_een( kt, ntot, ua, va )
+         CALL prt_ctl( tab3d_1=ua, clinfo1=' vor3 - Ua: ', mask1=umask, &
+            &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+         !
+      CASE ( 0 )                                       ! energy conserving scheme
+         IF( l_trddyn )   THEN
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt )
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt )
+         ELSE
+            CALL vor_ene( kt, ntot, ua, va )                ! total vorticity
+         ENDIF
+         !
+      CASE ( 1 )                                       ! enstrophy conserving scheme
+         IF( l_trddyn )   THEN    
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, ncor, ua, va )                ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt )
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt )
+         ELSE
+            CALL vor_ens( kt, ntot, ua, va )                ! total vorticity
+         ENDIF
+         !
+      CASE ( 2 )                                       ! mixed ene-ens scheme
+         IF( l_trddyn )   THEN
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ens( kt, nrvm, ua, va )                ! relative vorticity or metric trend (ens)
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_ene( kt, ncor, ua, va )                ! planetary vorticity trend (ene)
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt )
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt )
+         ELSE
+            CALL vor_mix( kt )                               ! total vorticity (mix=ens-ene)
+         ENDIF
+         !
+      CASE ( 3 )                                       ! energy and enstrophy conserving scheme
+         IF( l_trddyn )   THEN
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, nrvm, ua, va )                ! relative vorticity or metric trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_rvo, 'DYN', kt )
+            ztrdu(:,:,:) = ua(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:)
+            CALL vor_een( kt, ncor, ua, va )                ! planetary vorticity trend
+            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_pvo, 'DYN', kt )
+            CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_dat, 'DYN', kt )
+         ELSE
+            CALL vor_een( kt, ntot, ua, va )                ! total vorticity
+         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, 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 trend of the vorticity term is given by:
+      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f  mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f  mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)  mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)  mj(e2u un) ]
+      !!      Add this trend to the general momentum trend (ua,va):
+      !!          (ua,va) = (ua,va) + ( voru , vorv )
+      !!
+      !! ** Action : - Update (ua,va) with the now vorticity term trend
+      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! 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) ::   pua    ! total u-trend
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zx1, zy1, zfact2, zx2, zy2   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz
+      !!----------------------------------------------------------------------
+      !
+      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
+
+      zfact2 = 0.5 * 0.5      ! Local constant initialization
+
+!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         ! Potential vorticity and horizontal fluxes
+         ! -----------------------------------------
+         SELECT CASE( kvor )      ! vorticity considered
+         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
+         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
+         CASE ( 3 )                                                ! metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
+               END DO
+            END DO
+         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
+         CASE ( 5 )                                                ! total (coriolis + metric)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
+                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                               &
+                       &       )
+               END DO
+            END DO
+         END SELECT
+
+         IF( ln_sco ) THEN
+            zwz(:,:) = zwz(:,:) / fse3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         ELSE
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,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) + zfact2 / e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 / 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_mix( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE vor_mix  ***
+      !!
+      !! ** 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)
+      !!      Mixte formulation : conserves the potential enstrophy of a hori-
+      !!      zontally non-divergent flow for (rotzu x uh), the relative vor-
+      !!      ticity term and the horizontal kinetic energy for (f x uh), the
+      !!      coriolis term. the now trend of the vorticity term is given by:
+      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivatives:
+      !!          voru = 1/e1u  mj-1(rotn/e3f) mj-1[ mi(e1v*e3v vn) ]
+      !!              +1/e1u  mj-1[ f/e3f          mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1(rotn/e3f) mi-1[ mj(e2u*e3u un) ]
+      !!              +1/e2v  mi-1[ f/e3f          mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1(rotn) mj-1[ mi(e1v vn) ]
+      !!              +1/e1u  mj-1[ f          mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1(rotn) mi-1[ mj(e2u un) ]
+      !!              +1/e2v  mi-1[ f          mj(e2u un) ]
+      !!      Add this now 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
+      !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean timestep index
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zfact1, zua, zcua, zx1, zy1   ! local scalars
+      REAL(wp) ::   zfact2, zva, zcva, zx2, zy2   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('vor_mix')
+      !
+      CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn:vor_mix : vorticity term: mixed energy/enstrophy conserving scheme'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      zfact1 = 0.5 * 0.25      ! Local constant initialization
+      zfact2 = 0.5 * 0.5
+
+!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, zww )
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         ! Relative and planetary potential vorticity and horizontal fluxes
+         ! ----------------------------------------------------------------
+         IF( ln_sco ) THEN        
+            IF( ln_dynadv_vec ) THEN
+               zww(:,:) = rotn(:,:,jk) / fse3f(:,:,jk)
+            ELSE                       
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) * fse3f(ji,jj,jk) )
+                  END DO
+               END DO
+            ENDIF
+            zwz(:,:) = ff  (:,:)    / fse3f(:,:,jk)
+            zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         ELSE
+            IF( ln_dynadv_vec ) THEN
+               zww(:,:) = rotn(:,:,jk)
+            ELSE                       
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     zww(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                        &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                        &       * 0.5 / ( e1f(ji,jj) * e2f (ji,jj) )
+                  END DO
+               END DO
+            ENDIF
+            zwz(:,:) = ff (:,:)
+            zwx(:,:) = e2u(:,:) * un(:,:,jk)
+            zwy(:,:) = e1v(:,:) * vn(:,:,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) ) / e1u(ji,jj)
+               zy2 = ( zwy(ji,jj  ) + zwy(ji+1,jj  ) ) / e1u(ji,jj)
+               zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) / e2v(ji,jj)
+               zx2 = ( zwx(ji  ,jj) + zwx(ji  ,jj+1) ) / e2v(ji,jj)
+               ! enstrophy conserving formulation for relative vorticity term
+               zua = zfact1 * ( zww(ji  ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 )
+               zva =-zfact1 * ( zww(ji-1,jj  ) + zww(ji,jj) ) * ( zx1 + zx2 )
+               ! energy conserving formulation for planetary vorticity term
+               zcua = zfact2 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 )
+               zcva =-zfact2 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )
+               ! mixed vorticity trend added to the momentum trends
+               ua(ji,jj,jk) = ua(ji,jj,jk) + zcua + zua
+               va(ji,jj,jk) = va(ji,jj,jk) + zcva + zva
+            END DO  
+         END DO  
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+      CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('vor_mix')
+      !
+   END SUBROUTINE vor_mix
+
+
+   SUBROUTINE vor_ens( kt, kvor, 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:
+      !!       * s-coordinate (ln_sco=T), the e3. are inside the derivative:
+      !!          voru = 1/e1u  mj-1[ (rotn+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ]
+      !!          vorv = 1/e2v  mi-1[ (rotn+f)/e3f ]  mi-1[ mj(e2u*e3u un) ]
+      !!       * z-coordinate (default key), e3t=e3u=e3v, the trend becomes:
+      !!          voru = 1/e1u  mj-1[ rotn+f ]  mj-1[ mi(e1v vn) ]
+      !!          vorv = 1/e2v  mi-1[ rotn+f ]  mi-1[ mj(e2u 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
+      !!             - Save the trends in (ztrdu,ztrdv) in 2 parts (relative 
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! 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) ::   pua    ! total u-trend
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zfact1, zuav, zvau   ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww
+      !!----------------------------------------------------------------------
+      !
+      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
+
+      zfact1 = 0.5 * 0.25      ! Local constant initialization
+
+!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         !
+         ! Potential vorticity and horizontal fluxes
+         ! -----------------------------------------
+         SELECT CASE( kvor )      ! vorticity considered
+         CASE ( 1 )   ;   zwz(:,:) =                  ff(:,:)      ! planetary vorticity (Coriolis)
+         CASE ( 2 )   ;   zwz(:,:) =   rotn(:,:,jk)                ! relative  vorticity
+         CASE ( 3 )                                                ! metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )
+               END DO
+            END DO
+         CASE ( 4 )   ;   zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) )    ! total (relative + planetary vorticity)
+         CASE ( 5 )                                                ! total (coriolis + metric)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
+                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
+                       &       )
+               END DO
+            END DO
+         END SELECT
+         !
+         IF( ln_sco ) THEN
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk)
+                  zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk)
+                  zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk)
+               END DO
+            END DO
+         ELSE
+            DO jj = 1, jpj                      ! caution: don't use (:,:) for this loop 
+               DO ji = 1, jpi                   ! it causes optimization problems on NEC in auto-tasking
+                  zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk)
+                  zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk)
+               END DO
+            END DO
+         ENDIF
+         !
+         ! Compute and add the vorticity term trend
+         ! ----------------------------------------
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zuav = zfact1 / e1u(ji,jj) * ( zwy(ji  ,jj-1) + zwy(ji+1,jj-1)   &
+                  &                         + zwy(ji  ,jj  ) + zwy(ji+1,jj  ) )
+               zvau =-zfact1 / 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, 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
+      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative
+      !!               and planetary vorticity trends) ('key_trddyn')
+      !!
+      !! 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) ::   pua    ! total u-trend
+      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pva    ! total v-trend
+      !!
+      INTEGER  ::   ji, jj, jk                                    ! dummy loop indices
+      INTEGER  ::   ierr                                          ! local integer
+      REAL(wp) ::   zfac12, zua, zva                              ! local scalars
+      !                                                           !  3D workspace 
+      REAL(wp), POINTER    , DIMENSION(:,:  )         :: zwx, zwy, zwz
+      REAL(wp), POINTER    , DIMENSION(:,:  )         :: ztnw, ztne, ztsw, ztse
+#if defined key_vvl
+      REAL(wp), POINTER    , DIMENSION(:,:,:)         :: ze3f     !  3D workspace (lk_vvl=T)
+#endif
+#if ! defined key_vvl
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE   :: ze3f     ! lk_vvl=F, ze3f=1/e3f saved one for all
+#endif
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('vor_een')
+      !
+      CALL wrk_alloc( jpi, jpj,      zwx , zwy , zwz        ) 
+      CALL wrk_alloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
+#if defined key_vvl
+      CALL wrk_alloc( jpi, jpj, jpk, ze3f                   )
+#endif
+      !
+      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,*) '~~~~~~~~~~~'
+         IF( .NOT.lk_vvl ) THEN
+            ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr )
+            IF( lk_mpp    )   CALL mpp_sum ( ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' )
+         ENDIF
+      ENDIF
+
+      IF( kt == nit000 .OR. lk_vvl ) THEN      ! reciprocal of e3 at F-point (masked averaging of e3t)
+         DO jk = 1, jpk
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   &
+                     &             + fse3t(ji,jj  ,jk)*tmask(ji,jj  ,jk) + fse3t(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk) ) * 0.25
+                  IF( ze3f(ji,jj,jk) /= 0._wp )   ze3f(ji,jj,jk) = 1._wp / ze3f(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( ze3f, 'F', 1. )
+      ENDIF
+
+      zfac12 = 1._wp / 12._wp    ! Local constant initialization
+
+      
+!CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         
+         ! Potential vorticity and horizontal fluxes
+         ! -----------------------------------------
+         SELECT CASE( kvor )      ! vorticity considered
+         CASE ( 1 )                                                ! planetary vorticity (Coriolis)
+            zwz(:,:) = ff(:,:)      * ze3f(:,:,jk)
+         CASE ( 2 )                                                ! relative  vorticity
+            zwz(:,:) = rotn(:,:,jk) * ze3f(:,:,jk)
+         CASE ( 3 )                                                ! metric term
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &         - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &     * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk)
+               END DO
+            END DO
+            CALL lbc_lnk( zwz, 'F', 1. )
+        CASE ( 4 )                                                ! total (relative + planetary vorticity)
+            zwz(:,:) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk)
+         CASE ( 5 )                                                ! total (coriolis + metric)
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwz(ji,jj) = ( ff (ji,jj)                                                                       &
+                       &       + (   ( vn(ji+1,jj  ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj  ) - e2v(ji,jj) )       &
+                       &           - ( un(ji  ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji  ,jj+1) - e1u(ji,jj) )   )   &
+                       &       * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )                                                &
+                       &       ) * ze3f(ji,jj,jk)
+               END DO
+            END DO
+            CALL lbc_lnk( zwz, 'F', 1. )
+         END SELECT
+
+         zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,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   
+               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 = + zfac12 / 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 = - zfac12 / 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        ) 
+      CALL wrk_dealloc( jpi, jpj,      ztnw, ztne, ztsw, ztse ) 
+#if defined key_vvl
+      CALL wrk_dealloc( jpi, jpj, jpk, ze3f                   )
+#endif
+      !
+      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
+      !!
+      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )               ! Read Namelist namdyn_vor : Vorticity scheme options
+      READ   ( numnam, 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 : oice 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
+      ENDIF
+
+      ! 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( 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
+
+      ioptio = 0                     ! Control of vorticity scheme options
+      IF( ln_dynvor_ene )   ioptio = ioptio + 1
+      IF( ln_dynvor_ens )   ioptio = ioptio + 1
+      IF( ln_dynvor_mix )   ioptio = ioptio + 1
+      IF( ln_dynvor_een )   ioptio = ioptio + 1
+      IF( lk_esopa      )   ioptio =          1
+
+      IF( ioptio /= 1 ) CALL ctl_stop( ' use ONE and ONLY one vorticity scheme' )
+
+      !                              ! Set nvor (type of scheme for vorticity)
+      IF( ln_dynvor_ene )   nvor =  0
+      IF( ln_dynvor_ens )   nvor =  1
+      IF( ln_dynvor_mix )   nvor =  2
+      IF( ln_dynvor_een )   nvor =  3
+      IF( lk_esopa      )   nvor = -1
+      
+      !                              ! Set ncor, nrvm, ntot (type of vorticity)
+      IF(lwp) WRITE(numout,*)
+      ncor = 1
+      IF( ln_dynadv_vec ) THEN     
+         IF(lwp) WRITE(numout,*) '         Vector form advection : vorticity = Coriolis + relative vorticity'
+         nrvm = 2
+         ntot = 4
+      ELSE                        
+         IF(lwp) WRITE(numout,*) '         Flux form advection   : vorticity = Coriolis + metric term'
+         nrvm = 3
+         ntot = 5
+      ENDIF
+      
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nvor ==  0 )   WRITE(numout,*) '         vorticity scheme : energy conserving scheme'
+         IF( nvor ==  1 )   WRITE(numout,*) '         vorticity scheme : enstrophy conserving scheme'
+         IF( nvor ==  2 )   WRITE(numout,*) '         vorticity scheme : mixed enstrophy/energy conserving scheme'
+         IF( nvor ==  3 )   WRITE(numout,*) '         vorticity scheme : energy and enstrophy conserving scheme'
+         IF( nvor == -1 )   WRITE(numout,*) '         esopa test: use all lateral physics options'
+      ENDIF
+      !
+   END SUBROUTINE dyn_vor_init
+
+   !!==============================================================================
+END MODULE dynvor
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90	(revision 3437)
@@ -0,0 +1,135 @@
+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 trdmod_oce     ! ocean variables trends
+   USE trdmod         ! ocean dynamics trends 
+   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 step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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/(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      ! 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 * e1t(ji,jj) * e2t(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
+      DO jj = 2, jpjm1              ! Surface and bottom values set to zero
+         DO ji = fs_2, fs_jpim1           ! vector opt.
+            zwuw(ji,jj, 1 ) = 0.e0
+            zwvw(ji,jj, 1 ) = 0.e0
+            zwuw(ji,jj,jpk) = 0.e0
+            zwvw(ji,jj,jpk) = 0.e0
+         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) ) / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(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_mod(ztrdu, ztrdv, jpdyn_trd_zad, 'DYN', 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
+
+   !!======================================================================
+END MODULE dynzad
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90	(revision 3437)
@@ -0,0 +1,144 @@
+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_oce      ! ocean dynamics: lateral physics
+   USE trdmod          ! ocean active dynamics and tracers trends 
+   USE trdmod_oce      ! ocean variables trends
+   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
+   REAL(wp) ::   r2dt       ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/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   ! = rdtra (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1 ) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (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
+      !
+      CASE ( -1 )                                        ! esopa: test all possibility with control print
+                       CALL dyn_zdf_exp( kt, r2dt )
+                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask,               &
+                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+                       CALL dyn_zdf_imp( kt, r2dt )
+                       CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask,               &
+                          &          tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' )
+      END SELECT
+
+      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:)
+         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:)
+         CALL trd_mod( ztrdu, ztrdv, jpdyn_trd_zdf, 'DYN', 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
+      USE zdfkpp
+      !!----------------------------------------------------------------------
+      !
+      ! Choice from ln_zdfexp read in namelist in zdfini
+      IF( ln_zdfexp ) THEN   ;   nzdf = 0           ! use explicit scheme
+      ELSE                   ;   nzdf = 1           ! use implicit scheme
+      ENDIF
+      !
+      ! Force implicit schemes
+      IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp )   nzdf = 1   ! TKE, GLS or KPP physics
+      IF( ln_dynldf_iso                           )   nzdf = 1   ! iso-neutral lateral physics
+      IF( ln_dynldf_hor .AND. ln_sco              )   nzdf = 1   ! horizontal lateral physics in s-coordinate
+      !
+      IF( lk_esopa )    nzdf = -1                   ! Esopa key: All schemes used
+      !
+      IF(lwp) THEN                                  ! Print the choice
+         WRITE(numout,*)
+         WRITE(numout,*) 'dyn_zdf_init : vertical dynamics physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE dyn_zdf_init
+
+   !!==============================================================================
+END MODULE dynzdf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90	(revision 3437)
@@ -0,0 +1,129 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_exp  : update the momentum trend with the vertical diffu-
+   !!                  sion using an explicit time-stepping scheme.
+   !!----------------------------------------------------------------------
+   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 sbc_oce         ! surface boundary condition: ocean
+   USE lib_mpp         ! MPP library
+   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 "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_zdf_exp( kt, p2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_exp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!
+      !! ** Method  :   Explicit forward time stepping with a time splitting
+      !!      technique. The vertical diffusion of momentum is given by:
+      !!         diffu = dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ub) )
+      !!      Surface boundary conditions: wind stress input (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) )
+      !!
+      !! ** Action : - Update (ua,va) with the vertical diffusive trend
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in) ::   kt     ! ocean time-step index
+      REAL(wp), INTENT(in) ::   p2dt   ! time-step 
+      !
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! 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
+
+      zrau0r = 1. / rau0               ! Local constant initialization
+      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) ) * zrau0r
+            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r
+         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) ) / fse3uw(ji,jj,jk) 
+                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(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) ) / fse3u(ji,jj,jk)
+                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk)
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua
+                  va(ji,jj,jk) = va(ji,jj,jk) + zva
+                  !
+                  zwx(ji,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
+      !
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90	(revision 3437)
@@ -0,0 +1,308 @@
+MODULE dynzdf_imp
+   !!======================================================================
+   !!                    ***  MODULE  dynzdf_imp  ***
+   !! 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.4  !  2012-01  (H. Liu) Semi-implicit bottom friction
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   dyn_zdf_imp  : update the momentum trend with the vertical diffusion using a implicit time-stepping
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE zdf_oce         ! ocean vertical physics
+   USE phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE zdfbfr          ! Bottom friction setup
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   dyn_zdf_imp   ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE dyn_zdf_imp( kt, p2dt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dyn_zdf_imp  ***
+      !!                   
+      !! ** Purpose :   Compute the trend due to the vert. momentum diffusion
+      !!      and the surface forcing, and add it to the general trend of 
+      !!      the momentum equations.
+      !!
+      !! ** Method  :   The vertical momentum mixing trend is given by :
+      !!             dz( avmu dz(u) ) = 1/e3u dk+1( avmu/e3uw dk(ua) )
+      !!      backward time stepping
+      !!      Surface boundary conditions: wind stress input (averaged over kt-1/2 & kt+1/2)
+      !!      Bottom boundary conditions : bottom stress (cf zdfbfr.F)
+      !!      Add this trend to the general trend ua :
+      !!         ua = ua + dz( avmu dz(u) )
+      !!
+      !! ** Action : - Update (ua,va) arrays with the after vertical diffusive mixing trend.
+      !!---------------------------------------------------------------------
+      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) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars
+      !!----------------------------------------------------------------------
+
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwd, zws
+      REAL(wp), POINTER, DIMENSION(:,:)   ::  zavmu, zavmv
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dyn_zdf_imp')
+      !
+      CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 
+      CALL wrk_alloc( jpi,jpj, zavmu, zavmv ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'dyn_zdf_imp : vertical momentum diffusion implicit operator'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+      ENDIF
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+      z1_p2dt = 1._wp / p2dt      ! inverse of the timestep
+
+      ! 1. 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
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            ikbu = mbku(ji,jj)         ! ocean bottom level at u- and v-points 
+            ikbv = mbkv(ji,jj)         ! (deepest ocean u- and v-points)
+            zavmu(ji,jj) = avmu(ji,jj,ikbu+1)
+            zavmv(ji,jj) = avmv(ji,jj,ikbv+1)
+            avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 
+            avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1)
+         END DO
+      END DO
+      ENDIF
+
+      ! 2. 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.
+               zcoef = - p2dt / fse3u(ji,jj,jk)
+               zzwi          = zcoef * avmu (ji,jj,jk  ) / fse3uw(ji,jj,jk  )
+               zwi(ji,jj,jk) = zzwi  * umask(ji,jj,jk)
+               zzws          = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1)
+               zws(ji,jj,jk) = zzws  * umask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+
+      ! 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.
+            ua(ji,jj,1) = ub(ji,jj,1) + p2dt * (  ua(ji,jj,1) + 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   &
+               &                                                       / ( fse3u(ji,jj,1) * rau0       )  )
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrhs = ub(ji,jj,jk) + p2dt * ua(ji,jj,jk)   ! zrhs=right hand side
+               ua(ji,jj,jk) = zrhs - 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   ! vector opt.
+               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
+
+      ! Normalization to obtain the general momentum trend ua
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) - ub(ji,jj,jk) ) * z1_p2dt
+            END DO
+         END DO
+      END DO
+
+
+      ! 3. 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.
+               zcoef = -p2dt / fse3v(ji,jj,jk)
+               zzwi          = zcoef * avmv (ji,jj,jk  ) / fse3vw(ji,jj,jk  )
+               zwi(ji,jj,jk) =  zzwi * vmask(ji,jj,jk)
+               zzws          = zcoef * avmv (ji,jj,jk+1) / fse3vw(ji,jj,jk+1)
+               zws(ji,jj,jk) =  zzws * vmask(ji,jj,jk+1)
+               zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws
+            END DO
+         END DO
+      END DO
+      DO jj = 2, jpjm1        ! Surface boudary conditions
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zwi(ji,jj,1) = 0._wp
+            zwd(ji,jj,1) = 1._wp - zws(ji,jj,1)
+         END DO
+      END DO
+
+      ! 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.
+            va(ji,jj,1) = vb(ji,jj,1) + p2dt * (  va(ji,jj,1) + 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   &
+               &                                                       / ( fse3v(ji,jj,1) * rau0       )  )
+         END DO
+      END DO
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrhs = vb(ji,jj,jk) + p2dt * va(ji,jj,jk)   ! zrhs=right hand side
+               va(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1)
+         END DO
+      END DO
+      DO jk = jpk-2, 1, -1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Normalization to obtain the general momentum trend va
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1   
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               va(ji,jj,jk) = ( va(ji,jj,jk) - vb(ji,jj,jk) ) * z1_p2dt
+            END DO
+         END DO
+      END DO
+
+      !! restore bottom layer avmu(v) 
+      IF( ln_bfrimp ) THEN
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            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) = zavmu(ji,jj)
+            avmv(ji,jj,ikbv+1) = zavmv(ji,jj)
+         END DO
+      END DO
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 
+      CALL wrk_dealloc( jpi,jpj, zavmu, zavmv) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dyn_zdf_imp')
+      !
+   END SUBROUTINE dyn_zdf_imp
+
+   !!==============================================================================
+END MODULE dynzdf_imp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90	(revision 3437)
@@ -0,0 +1,367 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ssh_wzv        : after ssh & now vertical velocity
+   !!   ssh_nxt        : filter ans swap the ssh arrays
+   !!----------------------------------------------------------------------
+   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 divcur          ! hor. divergence and curl      (div & cur routines)
+   USE iom             ! I/O library
+   USE restart         ! only for lrst_oce
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE phycst
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE obc_par         ! open boundary cond. parameter
+   USE obc_oce
+   USE bdy_oce
+   USE diaar5, ONLY:   lk_diaar5
+   USE iom
+   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff 
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
+#if defined key_asminc   
+   USE asminc          ! Assimilation increment
+#endif
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ssh_wzv    ! called by step.F90
+   PUBLIC   ssh_nxt    ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ssh_wzv( kt ) 
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE ssh_wzv  ***
+      !!                   
+      !! ** Purpose :   compute the after ssh (ssha), the now vertical velocity
+      !!              and update the now vertical coordinate (lk_vvl=T).
+      !!
+      !! ** 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 (lk_vvl=T)
+      !!                hu, hv, hur, hvr        : ocean depth and its inverse at u-,v-points
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      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(:,:  ) ::  z2d, zhdiv
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ssh_wzv')
+      !
+      CALL wrk_alloc( jpi, jpj, z2d, zhdiv ) 
+      !
+      IF( kt == nit000 ) THEN
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ssh_wzv : 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)
+         !
+         IF( lk_vvl ) THEN                    ! before and now Sea SSH at u-, v-, f-points (vvl case only)
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible
+                  zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) )
+                  zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) )
+                  zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1)
+                  sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
+                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
+                  sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
+                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
+                  sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     &
+                     &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) )
+                  sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     &
+                     &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. )
+            CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. )
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   &
+                       &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                       &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                       &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshf_n, 'F', 1. )
+         ENDIF
+         !
+      ENDIF
+
+      !                                           !------------------------------------------!
+      IF( lk_vvl ) THEN                           !  Regridding: Update Now Vertical coord.  !   (only in vvl case)
+         !                                        !------------------------------------------!
+         DO jk = 1, jpkm1
+            fsdept(:,:,jk) = fsdept_n(:,:,jk)         ! now local depths stored in fsdep. arrays
+            fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
+            fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
+            !
+            fse3t (:,:,jk) = fse3t_n (:,:,jk)         ! vertical scale factors stored in fse3. arrays
+            fse3u (:,:,jk) = fse3u_n (:,:,jk)
+            fse3v (:,:,jk) = fse3v_n (:,:,jk)
+            fse3f (:,:,jk) = fse3f_n (:,:,jk)
+            fse3w (:,:,jk) = fse3w_n (:,:,jk)
+            fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
+            fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
+         END DO
+         !
+         hu(:,:) = hu_0(:,:) + sshu_n(:,:)            ! now ocean depth (at u- and v-points)
+         hv(:,:) = hv_0(:,:) + sshv_n(:,:)
+         !                                            ! now masked inverse of the ocean depth (at u- and v-points)
+         hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) )
+         hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) )
+         ! 
+      ENDIF
+      !
+      CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity
+      !
+      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 )   z2dt = rdt
+
+      !                                           !------------------------------!
+      !                                           !   After Sea Surface Height   !
+      !                                           !------------------------------!
+      zhdiv(:,:) = 0._wp
+      DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports
+        zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,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 defined key_agrif
+      CALL agrif_ssh( kt )
+#endif
+#if defined key_obc
+      IF( Agrif_Root() ) THEN 
+         ssha(:,:) = ssha(:,:) * obctmsk(:,:)
+         CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm)
+      ENDIF
+#endif
+#if defined key_bdy
+      ssha(:,:) = ssha(:,:) * bdytmask(:,:)
+      CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm)
+#endif
+
+      !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only)
+      IF( lk_vvl ) THEN                                ! (required only in key_vvl case)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1      ! NO Vector Opt.
+               sshu_a(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                  &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     &
+                  &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )
+               sshv_a(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                  &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     &
+                  &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
+            END DO
+         END DO
+         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions
+      ENDIF
+      
+#if defined key_asminc
+      !                                                ! Include the IAU weighted SSH increment
+      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN
+         CALL ssh_asm_inc( kt )
+         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)
+      ENDIF
+#endif
+
+      !                                           !------------------------------!
+      !                                           !     Now Vertical Velocity    !
+      !                                           !------------------------------!
+      z1_2dt = 1.e0 / z2dt
+      DO jk = jpkm1, 1, -1                             ! integrate from the bottom the hor. divergence
+         ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
+            &                         * tmask(:,:,jk) * z1_2dt
+#if defined key_bdy
+         wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+#endif
+      END DO
+
+      !                                           !------------------------------!
+      !                                           !           outputs            !
+      !                                           !------------------------------!
+      CALL iom_put( "woce", wn                    )   ! vertical velocity
+      CALL iom_put( "ssh" , sshn                  )   ! sea surface height
+      CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height
+      IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value
+         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport.
+         CALL wrk_alloc( jpi,jpj,jpk, z3d )
+         z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:)
+         DO jk = 1, jpk
+            z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:)
+         END DO
+         CALL iom_put( "w_masstr" , z3d                     )  
+         CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )
+         CALL wrk_dealloc( jpi,jpj,jpk, z3d )
+      ENDIF
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha  - : ', mask1=tmask, ovlap=1 )
+      !
+      CALL wrk_dealloc( jpi, jpj, z2d, zhdiv ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ssh_wzv')
+      !
+   END SUBROUTINE ssh_wzv
+
+
+   SUBROUTINE ssh_nxt( 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_wzv  
+      !!
+      !! ** 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
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp) ::   zec      ! temporary scalar
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ssh_nxt')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ssh_nxt : next sea surface height (Asselin time filter + swap)'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+      !                       !--------------------------!
+      IF( lk_vvl ) THEN       !  Variable volume levels  !     (ssh at t-, u-, v, f-points)
+         !                    !--------------------------!
+         !
+         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter
+            sshn  (:,:) = ssha  (:,:)                       ! now <-- after  (before already = now)
+            sshu_n(:,:) = sshu_a(:,:)
+            sshv_n(:,:) = sshv_a(:,:)
+            DO jj = 1, jpjm1                                ! ssh now at f-point
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions
+            !
+         ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap
+            zec = atfp * rdt / rau0
+            DO jj = 1, jpj
+               DO ji = 1, jpi                               ! before <-- now filtered
+                  sshb  (ji,jj) = sshn  (ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )   &
+                     &                          - zec  * ( emp_b(ji,jj) - emp(ji,jj) ) * tmask(ji,jj,1)
+                  sshn  (ji,jj) = ssha  (ji,jj)             ! now <-- after
+                  sshu_n(ji,jj) = sshu_a(ji,jj)
+                  sshv_n(ji,jj) = sshv_a(ji,jj)
+               END DO
+            END DO
+            DO jj = 1, jpjm1                                ! ssh now at f-point
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                 &
+                     &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     &
+                     &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     &
+                     &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshf_n, 'F', 1. )                 ! Boundaries conditions
+            !
+            DO jj = 1, jpjm1                                ! ssh before at u- & v-points
+               DO ji = 1, jpim1      ! NO Vector Opt.
+                  sshu_b(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                     &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     &
+                     &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) )
+                  sshv_b(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                     &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     &
+                     &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) )
+               END DO
+            END DO
+            CALL lbc_lnk( sshu_b, 'U', 1. )
+            CALL lbc_lnk( sshv_b, 'V', 1. )            !  Boundaries conditions
+            !
+         ENDIF
+         !                    !--------------------------!
+      ELSE                    !        fixed levels      !     (ssh at t-point only)
+         !                    !--------------------------!
+         !
+         IF( neuler == 0 .AND. kt == nit000 ) THEN    !** Euler time-stepping at first time-step : no filter
+            sshn(:,:) = ssha(:,:)                           ! now <-- after  (before already = now)
+            !
+         ELSE                                               ! Leap-Frog time-stepping: Asselin filter + swap
+            DO jj = 1, jpj
+               DO ji = 1, jpi                               ! before <-- now filtered
+                  sshb(ji,jj) = sshn(ji,jj) + atfp * ( sshb(ji,jj) - 2 * sshn(ji,jj) + ssha(ji,jj) )
+                  sshn(ji,jj) = ssha(ji,jj)                 ! now <-- after
+               END DO
+            END DO
+         ENDIF
+         !
+      ENDIF
+      !
+      ! Update velocity at AGRIF zoom boundaries
+#if defined key_agrif
+      IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )
+#endif
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ssh_nxt')
+      !
+   END SUBROUTINE ssh_nxt
+
+   !!======================================================================
+END MODULE sshwzv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90	(revision 3437)
@@ -0,0 +1,469 @@
+MODULE flo4rk
+   !!======================================================================
+   !!                    ***  MODULE  flo4rk  ***
+   !! Ocean floats :   trajectory computation using a 4th order Runge-Kutta
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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  /)           !
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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)) )  &
+                     &   / fse3w(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flo_oce.F90	(revision 3437)
@@ -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   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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      = .FALSE.    !: T/F float restart 
+   LOGICAL, PUBLIC  ::   ln_argo        = .FALSE.    !: T/F argo type floats
+   LOGICAL, PUBLIC  ::   ln_flork4      = .FALSE.    !: T/F 4th order Runge-Kutta
+   LOGICAL, PUBLIC  ::   ln_ariane      = .FALSE.    !: handle ariane input/output convention
+   LOGICAL, PUBLIC  ::   ln_flo_ascii   = .FALSE.    !: write in ascii (T) or in Netcdf (F)
+
+   INTEGER, PUBLIC  ::   nn_writefl     = 150        !: frequency of float output file 
+   INTEGER, PUBLIC  ::   nn_stockfl     = 450        !: 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90	(revision 3437)
@@ -0,0 +1,148 @@
+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   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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
+      !
+      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 )              ! Namelist namflo : floats
+      READ  ( numnam, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90	(revision 3437)
@@ -0,0 +1,430 @@
+MODULE floblk
+   !!======================================================================
+   !!                     ***  MODULE  floblk  ***
+   !! Ocean floats :   trajectory computation
+   !!======================================================================
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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 obc_par         ! open boundary condition parameters
+   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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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)-jpizoom+1)) .AND. (iil(jfl) <= (mig(nlei)-jpizoom+1)) .AND.   &
+             (ijl(jfl) >= (mjg(nldj)-jpjzoom+1)) .AND. (ijl(jfl) <= (mjg(nlej)-jpjzoom+1)) ) THEN
+            iiloc(jfl) = iil(jfl) - (mig(1)-jpizoom+1) + 1
+            ijloc(jfl) = ijl(jfl) - (mjg(1)-jpjzoom+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 fse3. but never checked 
+            zsurfx(1) = e2u(iiloc(jfl)-1,ijloc(jfl)  ) * fse3u(iiloc(jfl)-1,ijloc(jfl)  ,-ikl(jfl))
+            zsurfx(2) = e2u(iiloc(jfl)  ,ijloc(jfl)  ) * fse3u(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+            zsurfy(1) = e1v(iiloc(jfl)  ,ijloc(jfl)-1) * fse3v(iiloc(jfl)  ,ijloc(jfl)-1,-ikl(jfl))
+            zsurfy(2) = e1v(iiloc(jfl)  ,ijloc(jfl)  ) * fse3v(iiloc(jfl)  ,ijloc(jfl)  ,-ikl(jfl))
+
+            ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too.
+            zsurfz = e1t(iiloc(jfl),ijloc(jfl)) * e2t(iiloc(jfl),ijloc(jfl))
+            zvol   = zsurfz * fse3t(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 )
+      
+      ! in the case of open boundaries we need to test if the floats don't
+      ! go out of the domain. If it goes out, the float is put at the 
+      ! middle of the mesh in the domain but the trajectory isn't compute 
+      ! more time.      
+# if defined key_obc
+      DO jfl = 1, jpnfl
+         IF( lp_obc_east ) THEN
+            IF( jped <=  zgjfl(jfl) .AND. zgjfl(jfl) <= jpef .AND. nieob-1 <=  zgifl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lp_obc_west ) THEN
+            IF( jpwd <= zgjfl(jfl) .AND. zgjfl(jfl) <= jpwf .AND. niwob >=  zgifl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lp_obc_north ) THEN
+            IF( jpnd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpnf .AND. njnob-1 >=  zgjfl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+         IF( lp_obc_south ) THEN
+            IF( jpsd <=  zgifl(jfl) .AND. zgifl(jfl) <= jpsf .AND.  njsob >= zgjfl(jfl) ) THEN
+               zgifl (jfl) = INT(zgifl(jfl)) + 0.5
+               zgjfl (jfl) = INT(zgjfl(jfl)) + 0.5
+               zagefl(jfl) = rdt
+            END IF
+         END IF
+      END DO
+#endif
+
+      ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flodom.F90	(revision 3437)
@@ -0,0 +1,472 @@
+MODULE flodom
+   !!======================================================================
+   !!                       ***  MODULE  flodom  ***
+   !! Ocean floats :   domain
+   !!======================================================================
+   !! History :  OPA          ! 1998-07 (Y.Drillet, CLIPPER)  Original code
+   !!            NEMO_3.3.1   ! 2011-09 (C.Bricaud,S.Law-Chune Mercator-Ocean): 
+                              ! add Ariane convention, Comsecitc changes
+   !!----------------------------------------------------------------------
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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( (fsdepw(ji,jj,jk) <= flzz(jfl)) .AND. (fsdepw(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)-jpizoom)
+            zgjfl(jfl)= (ijmfl(jfl)-0.5) + zdyad/e2v(iimfl(jfl),ijmfl(jfl)-1) + (mjg(1)-jpjzoom)
+            zgkfl(jfl) = (( fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1) - flzz(jfl) )* ikmfl(jfl))   &
+               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl) ) )                             &
+               &                 + (( flzz(jfl)-fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)) ) *(ikmfl(jfl)+1))   &
+               &                 / (  fsdepw(iimfl(jfl),ijmfl(jfl),ikmfl(jfl)+1)                              &
+               &                    - fsdepw(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90	(revision 3437)
@@ -0,0 +1,150 @@
+MODULE florst
+   !!======================================================================
+   !!                       ***  MODULE  florst  ***
+   !!
+   !!
+   !! write floats restart files
+   !!
+   !!======================================================================
+   !!  History :
+   !!    8.0  !  99-09  (Y. Drillet)    : Original code
+   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
+   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Header:
+   !! This software is governed by the CeCILL licence see modipsl/doc/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
+      !!      
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER  :: kt                            ! time step
+
+      !! * Local declarations
+      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)-jpizoom+1)) .AND.   &
+                  &(INT(tpifl(jfl)) <= (mig(nlei)-jpizoom+1)) .AND.   &
+                  &(INT(tpjfl(jfl)) >= (mjg(nldj)-jpjzoom+1)) .AND.   &
+                  &(INT(tpjfl(jfl)) <= (mjg(nlej)-jpjzoom+1)) ) 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90	(revision 3437)
@@ -0,0 +1,302 @@
+MODULE flowri
+   !!======================================================================
+   !!                       ***  MODULE  flowri  ***
+   !!
+   !! write floats trajectory in ascii                    ln_flo_ascii = T
+   !!                      or in netcdf ( IOM or IOSPSL ) ln_flo_ascii = F           
+   !! 
+   !!
+   !!======================================================================
+   !!  History :
+   !!    8.0  !  99-09  (Y. Drillet)    : Original code
+   !!         !  00-06  (J.-M. Molines) : Profiling floats for CLS 
+   !!    8.5  !  02-10  (A. Bozec)  F90 : Free form and module
+   !!    3.2  !  10-08  (slaw, cbricaud): netcdf outputs and others 
+   !!----------------------------------------------------------------------
+#if   defined key_floats   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_floats'                                     float trajectories
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
+   !! $Header:
+   !! This software is governed by the CeCILL licence see modipsl/doc/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)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(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)*fsdepw(iafloc,ibfloc,icfl ) + zcfl * fsdepw(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90	(revision 3437)
@@ -0,0 +1,140 @@
+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 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_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
+                                                       !:                  (T): 1 file per proc
+   LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (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_timing    =    0    !: run control for timing
+   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 ::   numtime     =   -1      !: logical unit for timing
+   INTEGER ::   numout      =    6      !: logical unit for output print
+   INTEGER ::   numnam      =   -1      !: logical unit for namelist
+   INTEGER ::   numnam_ice  =   -1      !: logical unit for ice namelist
+   INTEGER ::   numevo_ice  =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol      =   -1      !: logical unit for solver statistics
+   INTEGER ::   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       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!=====================================================================
+END MODULE in_out_manager
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90	(revision 3437)
@@ -0,0 +1,1207 @@
+MODULE iom
+   !!=====================================================================
+   !!                    ***  MODULE  iom ***
+   !! Input/Output manager :  Library to read input files
+   !!====================================================================
+   !! 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_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 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 flo_oce         ! floats module declarations
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+   USE iom_ioipsl      ! NetCDF format with IOIPSL library
+   USE iom_nf90        ! NetCDF format with native NetCDF library
+   USE iom_rstdimg     ! restarts access direct format "dimg" style...
+   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 domngb          ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE dianam          ! build name of file
+   USE mod_event_client
+   USE mod_attribut
+# endif
+
+   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, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_getatt
+
+   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 set_grid
+# endif
+
+   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
+#if defined key_iomput
+   INTERFACE iom_setkt
+      MODULE PROCEDURE event__set_timestep
+   END INTERFACE
+# endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   
+      !!
+      !!----------------------------------------------------------------------
+#if defined key_iomput
+      REAL(wp) ::   ztmp
+      !!----------------------------------------------------------------------
+      ! read the xml file
+      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
+      CALL iom_swap
+
+      ! calendar parameters
+      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
+      CASE ( 1)   ;   CALL event__set_calendar('gregorian')
+      CASE ( 0)   ;   CALL event__set_calendar('noleap'   )
+      CASE (30)   ;   CALL event__set_calendar('360d'     )
+      END SELECT
+      ztmp = fjulday - adatrj
+      IF( ABS(ztmp  - REAL(NINT(ztmp),wp)) < 0.1 / rday )   ztmp = REAL(NINT(ztmp),wp)   ! avoid truncation error
+      CALL event__set_time_parameters( nit000 - 1, ztmp, rdt )
+
+      ! horizontal grid definition
+      CALL set_scalar
+      CALL set_grid( "grid_T", glamt, gphit )
+      CALL set_grid( "grid_U", glamu, gphiu )
+      CALL set_grid( "grid_V", glamv, gphiv )
+      CALL set_grid( "grid_W", glamt, gphit )
+
+      ! vertical grid definition
+      CALL event__set_vert_axis( "deptht", gdept_0 )
+      CALL event__set_vert_axis( "depthu", gdept_0 )
+      CALL event__set_vert_axis( "depthv", gdept_0 )
+      CALL event__set_vert_axis( "depthw", gdepw_0 )
+# if defined key_floats
+      CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp)  )
+# endif
+      
+      ! automatic definitions of some of the xml attributs
+      CALL set_xmlatt
+
+      ! end file definition
+      CALL event__close_io_definition
+#endif
+
+   END SUBROUTINE iom_init
+
+
+   SUBROUTINE iom_swap
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+#if defined key_iomput
+
+     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL event__swap_context("nemo")
+     ELSE
+        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo")
+     ENDIF
+
+#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=100)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu]
+      CHARACTER(LEN=100)    ::   cltmpn    ! tempory name to store clname (in writting mode)
+      CHARACTER(LEN=10)     ::   clsuffix  ! ".nc" or ".dimg"
+      CHARACTER(LEN=15)     ::   clcpu     ! the cpu number (max jpmax_digits digits)
+      CHARACTER(LEN=100)    ::   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 (jpioipsl ) ;   clsuffix = '.nc'
+      CASE (jpnf90   ) ;   clsuffix = '.nc'
+      CASE (jprstdimg) ;   clsuffix = '.dimg'
+      CASE DEFAULT     ;   clsuffix = ''
+         CALL ctl_stop( TRIM(clinfo), 'accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+      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
+         IF( iolib == jprstdimg ) THEN   ;   WRITE(clcpu,*) narea
+         ELSE                            ;   WRITE(clcpu,*) narea-1
+         ENDIF
+         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 or RSTDIMG 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
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN   ! no error within this routine
+         SELECT CASE (iolib)
+         CASE (jpioipsl )   ;   CALL iom_ioipsl_open(  clname, kiomid, llwrt, llok, idompar )
+         CASE (jpnf90   )   ;   CALL iom_nf90_open(    clname, kiomid, llwrt, llok, idompar )
+         CASE (jprstdimg)   ;   CALL iom_rstdimg_open( clname, kiomid, llwrt, llok, idompar )
+         CASE DEFAULT
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         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
+#if defined key_iomput
+         CALL event__stop_ioserver
+#endif
+      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 (jpioipsl )   ;   CALL iom_ioipsl_close(  jf )
+               CASE (jpnf90   )   ;   CALL iom_nf90_close(    jf )
+               CASE (jprstdimg)   ;   CALL iom_rstdimg_close( jf )
+               CASE DEFAULT
+                  CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+               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, 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
+      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 (jpioipsl )   ;   iom_varid = iom_ioipsl_varid( kiomid, cdvar, iiv, kdimsz )
+                  CASE (jpnf90   )   ;   iom_varid = iom_nf90_varid  ( kiomid, cdvar, iiv, kdimsz )
+                  CASE (jprstdimg)   ;   iom_varid = -1   ! all variables are listed in iom_file
+                  CASE DEFAULT   
+                     CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                  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
+            ENDIF
+         ENDIF
+      ENDIF
+      !
+   END FUNCTION iom_varid
+
+
+   !!----------------------------------------------------------------------
+   !!                   INTERFACE iom_get
+   !!----------------------------------------------------------------------
+   SUBROUTINE iom_g0d( kiomid, cdvar, pvar )
+      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               :: idvar   ! variable id
+      !
+      IF( kiomid > 0 ) THEN
+         idvar = iom_varid( kiomid, cdvar )
+         IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN
+            SELECT CASE (iom_file(kiomid)%iolib)
+            CASE (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, pvar )
+            CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idvar, pvar )
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            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 )
+      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
+      !
+      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 )
+      ENDIF
+   END SUBROUTINE iom_g2d
+
+   SUBROUTINE iom_g3d( 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(3)    , OPTIONAL ::   kstart    ! start axis position of the reading 
+      INTEGER         , INTENT(in   ), DIMENSION(3)    , 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_r3d=pvar,   &
+              &                                                     ktime=ktime, kstart=kstart, kcount=kcount )
+      ENDIF
+   END SUBROUTINE iom_g3d
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   &
+         &                  pv_r1d, pv_r2d, pv_r3d,   &
+         &                  ktime , kstart, kcount  )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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                        ::   llnoov      ! local definition to read overlap
+      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=100)             ::   clinfo      ! info character
+      CHARACTER(LEN=100)             ::   clname      ! file name
+      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      ! 
+      !---------------------------------------------------------------------
+      !
+      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   ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown')
+
+      ! 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 .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 more than '//cldmspc//' spatial dimension',   &
+                     &                         '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)       ) 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 ; istart(1:2) = (/ mig(1), mjg(1) /)  ! icnt(1:2) done bellow
+                  ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done bellow
+                  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                            ; 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 (jpioipsl )   ;   CALL iom_ioipsl_get(  kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE (jpnf90   )   ;   CALL iom_nf90_get(    kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE (jprstdimg)   ;   CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2,   &
+            &                                         pv_r1d, pv_r2d, pv_r3d )
+         CASE DEFAULT    
+            CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+         END SELECT
+
+         IF( istop == nstop ) THEN   ! no additional errors until this point...
+            IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i4,') 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
+!CDIR COLLAPSE
+               IF( zscf /= 1.)   pv_r2d(:,:) = pv_r2d(:,:) * zscf
+!CDIR COLLAPSE
+               IF( zofs /= 0.)   pv_r2d(:,:) = pv_r2d(:,:) + zofs
+            ELSEIF( PRESENT(pv_r3d) ) THEN
+!CDIR COLLAPSE
+               IF( zscf /= 1.)   pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf
+!CDIR COLLAPSE
+               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 (jpioipsl )   ;   CALL iom_ioipsl_gettime( kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE (jpnf90   )   ;   CALL iom_nf90_gettime(   kiomid, idvar, ptime, cdunits, cdcalendar )
+                     CASE (jprstdimg)   ;   CALL ctl_stop( TRIM(clinfo)//' case IO library == jprstdimg not coded...' )
+                     CASE DEFAULT    
+                        CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+                     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 (jpioipsl )   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE (jpnf90   )   ;   CALL iom_nf90_getatt( kiomid, cdatt, pvar )
+            CASE (jprstdimg)   ;   CALL ctl_stop('iom_getatt: only nf90 available')
+            CASE DEFAULT    
+               CALL ctl_stop( 'iom_g0d_att: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            END SELECT
+         ENDIF
+      ENDIF
+   END SUBROUTINE iom_g0d_intatt
+
+
+   !!----------------------------------------------------------------------
+   !!                   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 (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            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 (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            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 (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar ) 
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )
+            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 (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar )
+            CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar )
+            CASE DEFAULT     
+               CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' )
+            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
+#if defined key_iomput
+      CALL event__write_field2D( cdname, RESHAPE( (/pfield0d/), (/1,1/) ) )
+#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
+      INTEGER :: jpz
+#if defined key_iomput
+      jpz=SIZE(pfield1d)
+      CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) )
+#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 event__write_field2D( cdname, pfield2d(nldi:nlei, nldj:nlej) )
+#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 event__write_field3D( cdname, pfield3d(nldi:nlei, nldj:nlej, :) )
+#else
+      IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings
+#endif
+   END SUBROUTINE iom_p3d
+   !!----------------------------------------------------------------------
+
+
+#if defined key_iomput
+
+   SUBROUTINE set_grid( cdname, plon, plat )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define horizontal grids
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(LEN=*)            , INTENT(in) ::   cdname
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plon
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat
+
+      CALL event__set_grid_dimension( cdname, jpiglo, jpjglo)
+      CALL event__set_grid_domain( cdname, nlei-nldi+1, nlej-nldj+1, nimpp+nldi-1, njmpp+nldj-1, &
+         &                         plon(nldi:nlei, nldj:nlej), plat(nldi:nlei, nldj:nlej) )
+      CALL event__set_grid_type_nemo( cdname )
+
+   END SUBROUTINE set_grid
+
+
+   SUBROUTINE set_scalar
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   define fake grids for scalar point
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1,1) ::   zz = 1.
+      !!----------------------------------------------------------------------
+      CALL event__set_grid_dimension( 'scalarpoint', jpnij, 1)
+      CALL event__set_grid_domain   ( 'scalarpoint', 1, 1, narea, 1, zz, zz )
+      CALL event__set_grid_type_nemo( 'scalarpoint' )
+
+   END SUBROUTINE set_scalar
+
+
+   SUBROUTINE set_xmlatt
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE   ***
+      !!
+      !! ** Purpose :   automatic definitions of some of the xml attributs...
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=6),DIMENSION( 8) ::   clsuff                   ! suffix name
+      CHARACTER(len=1),DIMENSION( 3) ::   clgrd                    ! suffix name
+      CHARACTER(len=50)              ::   clname                   ! file name
+      CHARACTER(len=1)               ::   cl1                      ! 1 character
+      CHARACTER(len=2)               ::   cl2                      ! 1 character
+      INTEGER                        ::   idt                      ! time-step in seconds
+      INTEGER                        ::   iddss, ihhss             ! number of seconds in 1 day, 1 hour and 1 year
+      INTEGER                        ::   iyymo                    ! number of months in 1 year
+      INTEGER                        ::   jg, jh, jd, jm, jy       ! 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
+      !!----------------------------------------------------------------------
+      ! 
+      idt   = NINT( rdttra(1)     )
+      iddss = NINT( rday          )                                         ! number of seconds in 1 day
+      ihhss = NINT( rmmss * rhhmm )                                         ! number of seconds in 1 hour
+      iyymo = NINT( raamo         )                                         ! number of months in 1 year
+
+      ! frequency of the call of iom_put (attribut: freq_op)
+      CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt           ) )    ! model time-step
+      CALL event__set_attribut( 'SBC'             , attr( field__freq_op, idt * nn_fsbc ) )    ! SBC time-step
+      
+      ! output file names (attribut: name)
+      clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /)      
+      DO jg = 1, SIZE(clsuff)                                                                  ! grid type
+         DO jh = 1, 12                                                                         ! 1, 2, 3, 4, 6, 12 hours
+            IF( MOD(12,jh) == 0 ) THEN 
+               WRITE(cl2,'(i2)') jh 
+               CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+         DO jd = 1, 5, 2                                                                       ! 1, 3, 5 days
+            WRITE(cl1,'(i1)') jd 
+            CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. )
+            CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+         END DO
+         DO jm = 1, 6                                                                          ! 1, 2, 3, 4, 6 months
+            IF( MOD(6,jm) == 0 ) THEN 
+               WRITE(cl1,'(i1)') jm 
+               CALL dia_nam( clname, -jm, clsuff(jg) )
+               CALL event__set_attribut( cl1//'m_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+         DO jy = 1, 10                                                                         ! 1, 2, 5, 10 years  
+            IF( MOD(10,jy) == 0 ) THEN 
+               WRITE(cl2,'(i2)') jy 
+               CALL dia_nam( clname, -jy * iyymo, clsuff(jg) )
+               CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) )
+            ENDIF
+         END DO
+      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 event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin     , iy     ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni         , jpiglo ) )
+         CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq'  ) )
+      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   ***
+      !!
+      !! ** 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=50)             ::   clname                   ! file 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 event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin     , ix                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin     , iy                ) )
+               CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) )      
+            END DO
+         END DO
+      END DO
+      
+   END SUBROUTINE set_mooring
+
+#else
+
+   SUBROUTINE iom_setkt( kt )
+      INTEGER, INTENT(in   )::   kt 
+      IF( .FALSE. )   WRITE(numout,*) kt   ! useless test to avoid compilation warnings
+   END SUBROUTINE iom_setkt
+
+#endif
+
+
+   !!======================================================================
+END MODULE iom
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90	(revision 3437)
@@ -0,0 +1,73 @@
+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  :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_autodta       = 9   !: 
+
+   INTEGER, PARAMETER, PUBLIC ::   jpioipsl    = 100      !: Use ioipsl (fliocom only) library
+   INTEGER, PARAMETER, PUBLIC ::   jpnf90      = 101      !: Use nf90 library
+   INTEGER, PARAMETER, PUBLIC ::   jprstdimg   = 102      !: Use restart dimgs (fortran direct acces) library
+#if defined key_dimgout
+   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jprstdimg  !: restarts io library
+#else
+   INTEGER, PARAMETER, PUBLIC ::   jprstlib  = jpnf90     !: restarts io library
+#endif
+
+   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  = 50   !: maximum number of simultaneously opened file
+   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 360  !: 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 (jpioipsl, jpnf90 or jprstdimg)
+      INTEGER                                   ::   nvars    !: number of identified varibles in the file
+      INTEGER                                   ::   iduld    !: id of the unlimited dimension
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_ioipsl.F90	(revision 3437)
@@ -0,0 +1,437 @@
+MODULE iom_ioipsl
+   !!=====================================================================
+   !!                    ***  MODULE  iom_ioipsl ***
+   !! Input/Output manager :  Library to read input files with IOIPSL (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_ioipsl_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 iom_def         ! iom variables definitions
+   USE ioipsl          ! IOIPSL library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_ioipsl_open, iom_ioipsl_close, iom_ioipsl_varid, iom_ioipsl_get, iom_ioipsl_gettime, iom_ioipsl_rstput
+
+   INTERFACE iom_ioipsl_get
+      MODULE PROCEDURE iom_ioipsl_g0d, iom_ioipsl_g123d
+   END INTERFACE
+   INTERFACE iom_ioipsl_rstput
+      MODULE PROCEDURE iom_ioipsl_rp0123d
+   END INTERFACE
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_ioipsl_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file with IOIPSL (only fliocom module)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! ioipsl 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=100) ::   clinfo      ! info character
+      CHARACTER(LEN=10 ) ::   clstatus    ! status of opened file (REPLACE or NEW)
+      INTEGER            ::   iln         ! lengths of character
+      INTEGER            ::   istop       ! temporary storage of nstop
+      INTEGER            ::   ifliodom    ! model domain identifier (see flio_dom_set)
+      INTEGER            ::   ioipslid    ! ioipsl identifier of the opened file
+      INTEGER            ::   jl          ! loop variable
+      LOGICAL            ::   llclobber   ! local definition of ln_clobber
+      !---------------------------------------------------------------------
+
+      clinfo = '                    iom_ioipsl_open ~~~  '
+      istop = nstop
+      !
+      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'
+            CALL flioopfd( TRIM(cdname), ioipslid, "WRITE" )
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            CALL flioopfd( TRIM(cdname), ioipslid )
+         ENDIF
+      ELSE                 ! the file does not exist
+         !                 ! =============
+         iln = INDEX( cdname, '.nc' )
+         IF( ldwrt ) THEN  ! the file should be open in write mode so we create it...
+            IF( llclobber ) THEN   ;   clstatus = 'REPLACE 64' 
+            ELSE                   ;   clstatus = 'NEW 64'
+            ENDIF
+            IF( jpnij > 1 ) THEN
+               ! define the domain position regarding to the global domain (mainly useful in mpp)
+               CALL flio_dom_set( jpnij, narea-1, (/1, 2/), (/jpiglo, jpjglo/)   &
+                  &             , kdompar(:,1), kdompar(:,2), kdompar(:,3), kdompar(:,4), kdompar(:,5)   &
+                  &             , 'BOX', ifliodom )        
+               ! Note that fliocrfd may change the value of cdname (add the cpu number...)
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname(1:iln-1)//'... in WRITE mode'
+               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
+                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid, ifliodom, mode = clstatus )
+            ELSE              ! the file should be open for read mode so it must exist...
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//cdname//' in WRITE mode'
+               CALL fliocrfd( cdname, (/'x'         , 'y'         , 'z', 't'/)   &
+                  &         , (/kdompar(1,1), kdompar(2,1), jpk, -1 /), ioipslid,           mode = clstatus )
+            ENDIF
+         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   = ioipslid
+         iom_file(kiomid)%iolib  = jpioipsl
+         iom_file(kiomid)%nvars  = 0
+         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files
+         CALL flioinqf( ioipslid, id_uld = iom_file(kiomid)%iduld )
+         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK'
+      ELSE
+         kiomid = 0               ! return error flag
+      ENDIF
+      !
+   END SUBROUTINE iom_ioipsl_open
+
+
+   SUBROUTINE iom_ioipsl_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_ioipsl_close  ***
+      !!
+      !! ** Purpose : close an input file with IOIPSL (only fliocom module) 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      !---------------------------------------------------------------------
+      !
+      CALL flioclo( iom_file(kiomid)%nfid )
+      !    
+   END SUBROUTINE iom_ioipsl_close
+
+
+   FUNCTION iom_ioipsl_varid ( kiomid, cdvar, kiv, kdimsz )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  FUNCTION  iom_varid  ***
+      !!
+      !! ** Purpose : get the id of a variable in a file with IOIPSL (only fliocom module)
+      !!-----------------------------------------------------------------------
+      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                        ::   iom_ioipsl_varid  ! iom variable Id
+      INTEGER                        ::   ioipslid          ! ioipsl file identifier
+      INTEGER                        ::   ji                ! dummy loop index
+      INTEGER                        ::   i_nvd             ! number of dimension of the variable
+      INTEGER, DIMENSION(jpmax_dims) ::   idimid            ! dimension ids of the variable
+      LOGICAL                        ::   ll_fnd            ! found test
+      CHARACTER(LEN=100)             ::   clinfo            ! info character
+      !!-----------------------------------------------------------------------
+      clinfo = 'iom_ioipsl_varid, file: '//trim(iom_file(kiomid)%name)//', var: '//trim(cdvar)
+      iom_ioipsl_varid = 0                  ! default definition
+      IF( PRESENT(kdimsz) ) kdimsz(:) = 0   ! default definition
+      ioipslid = iom_file(kiomid)%nfid      ! get back ioipsl file identifier 
+      CALL flioinqv( ioipslid, cdvar, ll_fnd, nb_dims = i_nvd )   ! does the variable exist in the file
+      IF( ll_fnd ) THEN
+         IF( i_nvd <= jpmax_dims ) THEN
+            iom_ioipsl_varid = kiv
+            iom_file(kiomid)%nvars       = kiv
+            iom_file(kiomid)%nvid(kiv)   = -1   ! variable id is not available in ioipsl
+            iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar)
+            iom_file(kiomid)%ndims(kiv)  = i_nvd
+            CALL flioinqv( ioipslid, cdvar, ll_fnd,   &
+                  &           len_dims = iom_file(kiomid)%dimsz(1:i_nvd,kiv), &   ! dimensions size
+                  &           id_dims  = idimid(1:i_nvd) )                        ! dimensions ids
+            iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value
+            DO ji = 1, i_nvd                       ! find the unlimited dimension
+               IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.
+            END DO
+            !---------- Deal with scale_factor and add_offset
+            CALL flioinqa( ioipslid, cdvar, 'scale_factor', ll_fnd )
+            IF( ll_fnd) THEN
+               CALL fliogeta( ioipslid, cdvar, 'scale_factor', iom_file(kiomid)%scf(kiv) )
+            ELSE
+               iom_file(kiomid)%scf(kiv) = 1.
+            END IF
+            CALL flioinqa( ioipslid, cdvar, 'add_offset', ll_fnd )
+            IF( ll_fnd ) THEN
+               CALL fliogeta( ioipslid, cdvar, 'add_offset', iom_file(kiomid)%ofs(kiv) )
+            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
+         ELSE
+            CALL ctl_stop( TRIM(clinfo), 'Too many dimensions in the file '//iom_file(kiomid)%name,   &
+                  &                       'increase the parameter jpmax_vars')
+         ENDIF
+      ELSE  
+         iom_ioipsl_varid = -1   !   variable not found, return error code: -1
+      ENDIF
+      !
+   END FUNCTION iom_ioipsl_varid
+
+
+   SUBROUTINE iom_ioipsl_g0d( kiomid, kvid, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_ioipsl_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with IOIPSL (only fliocom module)
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   kiomid    ! Identifier of the file
+      INTEGER , INTENT(in   ) ::   kvid      ! variable id
+      REAL(wp), INTENT(  out) ::   pvar      ! read field
+      !
+      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), pvar )
+      ! 
+   END SUBROUTINE iom_ioipsl_g0d
+
+
+   SUBROUTINE iom_ioipsl_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   &
+         &                      pv_r1d, pv_r2d, pv_r3d)
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_ioipsl_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with IOIPSL (only fliocom module)
+      !!
+      !! ** 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)
+      !
+      INTEGER               ::   ioipslid   ! ioipsl file identifier
+      CHARACTER(LEN=100)    ::   clvn       ! variable name
+      !---------------------------------------------------------------------
+      clvn = TRIM(iom_file(kiomid)%cn_var(kvid))   ! get back variable name 
+      ioipslid = iom_file(kiomid)%nfid             ! get back IPIPSL file id
+      !
+      IF( PRESENT(pv_r1d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r1d(:                ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ELSEIF( PRESENT(pv_r2d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ELSEIF( PRESENT(pv_r3d) ) THEN
+         CALL fliogetv( ioipslid, clvn, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim), count = kcount(1:knbdim) )
+      ENDIF
+      !
+      !
+   END SUBROUTINE iom_ioipsl_g123d
+
+
+   SUBROUTINE iom_ioipsl_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE iom_gettime  ***
+      !!
+      !! ** Purpose : read the time axis kvid in the file with IOIPSL (only fliocom module)
+      !!--------------------------------------------------------------------
+      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
+      !---------------------------------------------------------------------
+      !
+      CALL fliogetv( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), ptime(:),   &
+            &         start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /) )
+      IF ( PRESENT(cdunits) ) THEN 
+         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "units", cdunits )
+      ENDIF
+      IF ( PRESENT(cdcalendar) ) THEN 
+         CALL fliogeta( iom_file(kiomid)%nfid, TRIM(iom_file(kiomid)%cn_var(kvid)), "calendar", cdcalendar )
+      ENDIF
+      !
+   END SUBROUTINE iom_ioipsl_gettime
+
+
+   SUBROUTINE iom_ioipsl_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   &
+         &                                 pv_r0d, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_ioipsl_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               :: itype                ! variable type
+      INTEGER               :: ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER, DIMENSION(4) :: idimsz               ! dimensions size  
+      INTEGER, DIMENSION(4) :: idimid               ! dimensions id
+      CHARACTER(LEN=100)    :: clinfo               ! info character
+      INTEGER               :: ioipslid             ! ioipsl file identifier
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_ioipsl_rp0123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      ioipslid = iom_file(kiomid)%nfid
+      !
+      ! define dimension variables if it is not already done
+      ! ==========================
+      IF( iom_file(kiomid)%nvars == 0 ) THEN
+         ! define the dimension variables if it is not already done
+         CALL fliodefv( ioipslid,'nav_lon', (/1,2/), v_t=flio_r4   , axis='X',   &
+               &                  long_name="Longitude", units="degrees_east" )
+         CALL fliodefv( ioipslid,'nav_lat', (/1,2/), v_t=flio_r4   , axis='Y',   &
+               &                  long_name="Latitude", units="degrees_north" )
+         CALL fliodefv( ioipslid,'nav_lev', (/3/)  , v_t=flio_i4   , axis='Z',   &
+               &                  long_name="Model levels",units="model_levels")
+         CALL fliodefv( ioipslid,'time_counter', (/4/), v_t=flio_r4, axis='T',   &
+               &                  long_name="Time axis", units='seconds since 0001-01-01 00:00:00' )
+         ! 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:3) = (/ 'nav_lon', 'nav_lat', 'nav_lev' /)
+         iom_file(kiomid)%cn_var(4)   = 'time_counter'
+         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
+         ! 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 = flio_r8
+            CASE (jp_r4)  ;   itype = flio_r4
+            CASE (jp_i4)  ;   itype = flio_i4
+            CASE (jp_i2)  ;   itype = flio_i2
+            CASE (jp_i1)  ;   itype = flio_i1   !   fliocom does not handle i1 type of variable
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo)//' unknown variable type' )
+            END SELECT
+         ELSE
+            itype = flio_r8
+         ENDIF
+         IF( PRESENT(pv_r0d) ) THEN   ;   CALL fliodefv (ioipslid, TRIM(cdvar)                 , v_t = itype)
+         ELSE                         ;   CALL fliodefv (ioipslid, TRIM(cdvar), idimid(1:idims), v_t = itype)
+         ENDIF
+         ! update informations structure related the new variable we want to add...
+         idvar                          = iom_file(kiomid)%nvars + 1
+         iom_file(kiomid)%nvars         = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(idvar)   = -1   ! netcdf variable id is not available in ioipsl
+         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.
+            CALL flioinqf( ioipslid, ln_dim = idimsz )
+            iom_file(kiomid)%dimsz(1:idims-1,idvar) = idimsz(idimid(1:idims-1))
+         ELSE                               
+            iom_file(kiomid)%luld(idvar) = .FALSE.
+         ENDIF
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' defined ok'
+      ELSE
+         idvar = kvid
+      ENDIF
+
+      ! time step kwrite : write the variable
+      IF( kt == kwrite ) THEN
+         ! 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_ioipsl_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 flioputv( ioipslid, 'nav_lon'     , glamt(ix1:ix2, iy1:iy2) )
+               CALL flioputv( ioipslid, 'nav_lat'     , gphit(ix1:ix2, iy1:iy2) )
+               CALL flioputv( ioipslid, 'nav_lev'     , gdept_0 )
+               ! +++ WRONG VALUE: to be improved but not really useful...
+               CALL flioputv( ioipslid, 'time_counter', kt )
+               ! update the values of the variables dimensions size
+               CALL flioinqf( ioipslid, ln_dim = idimsz )
+               iom_file(kiomid)%dimsz(1:2, 1) = idimsz(1:2)
+               iom_file(kiomid)%dimsz(1:2, 2) = idimsz(1:2)
+               iom_file(kiomid)%dimsz(1, 3:4) = (/idimsz(3), 1/)
+               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done'
+            ENDIF
+         ENDIF
+
+         ! write the data
+         ! =============
+         IF(     PRESENT(pv_r0d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r0d                      )
+         ELSEIF( PRESENT(pv_r1d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r1d(                  :) )
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r2d(ix1:ix2, iy1:iy2   ) )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ;   CALL flioputv( ioipslid, cdvar, pv_r3d(ix1:ix2, iy1:iy2, :) )
+         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_ioipsl_rp0123d
+
+
+   !!======================================================================
+END MODULE iom_ioipsl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90	(revision 3437)
@@ -0,0 +1,577 @@
+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$
+   !! 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=100) ::   clinfo           ! info character
+      CHARACTER(LEN=100) ::   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), 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 )  
+      !!-----------------------------------------------------------------------
+      !!                  ***  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                        ::   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
+         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
+      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 )
+      !!-----------------------------------------------------------------------
+      !!                  ***  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
+      !
+      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), 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=100)    :: 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_0                 ), 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/iom_rstdimg.F90	(revision 3437)
@@ -0,0 +1,504 @@
+MODULE iom_rstdimg
+   !!=====================================================================
+   !!                    ***  MODULE  iom_rstdimg ***
+   !! Input/Output manager :  Library to read input rstdimg files
+   !!====================================================================
+   !! History :  9.0  ! 06 09  (S. Masson) Original code
+   !!--------------------------------------------------------------------
+
+   !!--------------------------------------------------------------------
+   !!   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 in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! lateal boundary condition / mpp exchanges
+   USE iom_def         ! iom variables definitions
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC iom_rstdimg_open, iom_rstdimg_close, iom_rstdimg_get, iom_rstdimg_rstput
+
+   INTERFACE iom_rstdimg_get
+      MODULE PROCEDURE iom_rstdimg_g0d, iom_rstdimg_g123d
+   END INTERFACE
+   INTERFACE iom_rstdimg_rstput
+      MODULE PROCEDURE iom_rstdimg_rp0d, iom_rstdimg_rp123d
+   END INTERFACE
+
+   INTEGER, PARAMETER ::   jpvnl          = 32   ! variable name length
+      
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE iom_rstdimg_open( cdname, kiomid, ldwrt, ldok, kdompar )
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_open  ***
+      !!
+      !! ** Purpose :  open an input file read only (return 0 if not found)
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*)       , INTENT(inout)           ::   cdname      ! File name
+      INTEGER                , INTENT(  out)           ::   kiomid      ! iom 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=100)                      ::   clinfo                     ! info character
+      CHARACTER(LEN=100)                      ::   cltmp                      ! temporary character
+      CHARACTER(LEN=10 )                      ::   clstatus                   ! status of opened file (REPLACE or NEW)
+      INTEGER                                 ::   jv                         ! loop counter
+      INTEGER                                 ::   istop                      ! temporary storage of nstop
+      INTEGER                                 ::   idrst                      ! logical unit of the restart file
+      INTEGER                                 ::   iln                        ! lengths of character
+      INTEGER                                 ::   irecl8                     ! record length
+      INTEGER                                 ::   ios                        ! IO status
+      INTEGER                                 ::   irhd                       ! record of the header infos
+      INTEGER                                 ::   ivnum                      ! number of variables
+      INTEGER                                 ::   ishft                      ! counter shift
+      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
+      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
+      INTEGER                                 ::   ipni, ipnj, ipnij, iarea   ! domain decomposition 
+      INTEGER                                 ::   iiglo, ijglo               ! domain global size 
+      INTEGER                                 ::   jl                         ! loop variable
+      LOGICAL                                 ::   llclobber                  ! local definition of ln_clobber
+      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d     ! name of 0/1/2/3D variables
+      REAL(wp),             DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d     ! value of 0d variables or record
+      !                                                                                   ! position for 1/2/3D variables
+      !---------------------------------------------------------------------
+      clinfo = '                    iom_rstdimg_open ~~~  '
+      istop = nstop      ! store the actual value of nstop
+      ios = 0            ! default definition
+      kiomid = 0         ! default definition
+      llclobber = ldwrt .AND. ln_clobber
+      ! get a free unit
+      idrst = get_unit()  ! get a free logical unit for the restart file
+!!$#if defined key_agrif 
+!!$      idrst = Agrif_Get_Unit()      
+!!$#endif 
+      ! Open the file...
+      ! =============
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! Open existing file...
+         ! find the record length
+         OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+            &       , RECL = 8, STATUS = 'old', ACTION = 'read', IOSTAT = ios, ERR = 987 )
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8
+         CLOSE( idrst )
+         ! Open the file with the appropriate record length and parameters
+         IF( ldwrt ) THEN  ! ... in readwrite mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READWRITE mode'
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+               &       , RECL = irecl8, STATUS = 'old', ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
+         ELSE              ! ... in read mode
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode'
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'unformatted', ACCESS = 'direct'   &
+               &       , RECL = irecl8, STATUS = 'old', ACTION = 'read'     , IOSTAT = ios, ERR = 987 )
+         ENDIF
+      ELSE                                       ! the file does not exist (or we overwrite it)
+         iln = INDEX( cdname, '.dimg' )
+         IF( ldwrt ) THEN  ! the file should be open in readwrite mode so we create it...
+            irecl8= MAX( kdompar(1,1) * kdompar(2,1) * wp, ( 8*jpnij + 15 ) * 4 )
+            IF( jpnij > 1 ) THEN
+               WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea, '.dimg'
+               cdname = TRIM(cltmp)
+            ENDIF
+            IF(lwp) WRITE(numout,*) TRIM(clinfo)//' create new file: '//TRIM(cdname)//' in READWRITE mode'
+            
+            IF( llclobber ) THEN   ;   clstatus = 'REPLACE' 
+            ELSE                   ;   clstatus = 'NEW'
+            ENDIF
+            OPEN( idrst, FILE = TRIM(cdname), FORM = 'UNFORMATTED', ACCESS = 'DIRECT'   &
+               &       , RECL = irecl8, STATUS = TRIM(clstatus), ACTION = 'readwrite', IOSTAT = ios, ERR = 987 )
+         ELSE              ! the file should be open for read mode so it must exist...
+            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' )
+         ENDIF
+      ENDIF
+      ! Performs checks on the file
+      ! =============
+      IF( ldok .AND. .NOT. llclobber ) THEN      ! old file
+         READ( idrst, REC = 1   , IOSTAT = ios, ERR = 987 )              &
+              &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
+              &   ipni, ipnj, ipnij, iarea, iiglo, ijglo
+         READ( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                       &
+            &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
+            &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
+         clinfo = TRIM(clinfo)//' file '//TRIM(cdname)
+         IF( iiglo /= jpiglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in i direction' )
+         IF( ijglo /= jpjglo       )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in global domain size in j direction' )
+         IF( ldwrt ) THEN
+            IF( inx   /= kdompar(1,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in i direction' )
+            IF( iny   /= kdompar(2,1) )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in local domain size in j direction' )
+         ENDIF
+         IF( inz   /= jpk          )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in domain size in k direction' )
+         IF( ipni  /= jpni         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along I' )
+         IF( ipnj  /= jpnj         )   CALL ctl_stop( TRIM(clinfo), 'Processor splitting changed along J' )
+         IF( ipnij /= jpnij        )   CALL ctl_stop( TRIM(clinfo), 'Total number of processors changed' )
+         IF( iarea /= narea        )   CALL ctl_stop( TRIM(clinfo), 'Mismatch in area numbering ...' )
+      ENDIF
+      ! 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    = idrst
+         iom_file(kiomid)%iolib   = jprstdimg
+         iom_file(kiomid)%iduld   = -1
+         IF( ldok ) THEN      ! old file
+            ! read variables informations from the file header
+            IF(  TRIM(clna0d(1)) == 'no0d' )   in0d = 0
+            IF(  TRIM(clna1d(1)) == 'no1d' )   in1d = 0
+            IF(  TRIM(clna2d(1)) == 'no2d' )   in2d = 0
+            IF(  TRIM(clna3d(1)) == 'no3d' )   in3d = 0
+            ivnum = in0d + in1d + in2d + in3d
+            iom_file(kiomid)%nvars            = ivnum
+            iom_file(kiomid)%irec             = 2 + in1d + in2d + inz * in3d
+            iom_file(kiomid)%luld(   1:ivnum) = .FALSE.
+            iom_file(kiomid)%scf(    1:ivnum) = 1.
+            ! scalar variable
+            DO jv = 1, in0d
+               iom_file(kiomid)%cn_var(jv) = TRIM(clna0d(jv))
+               iom_file(kiomid)%nvid(  jv) = 1
+               iom_file(kiomid)%ndims( jv) = 0
+               iom_file(kiomid)%ofs(   jv) = zval0d(jv)   ! warning: trick... we use ofs to store the value
+            END DO
+            ! 1d variable
+            ishft = in0d
+            DO jv = 1, in1d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna1d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval1d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 1
+               iom_file(kiomid)%dimsz(1  , ishft + jv) = jpk
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+            ! 2d variable
+            ishft = in0d + in1d
+            DO jv = 1, in2d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna2d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval2d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 2
+               iom_file(kiomid)%dimsz(1:2, ishft + jv) = (/ inx, iny /)
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+            ! 3d variable
+            ishft = in0d + in1d + in2d 
+            DO jv = 1, in3d
+               iom_file(kiomid)%cn_var(    ishft + jv) = TRIM(clna3d(jv))
+               iom_file(kiomid)%nvid(      ishft + jv) = zval3d(jv)
+               iom_file(kiomid)%ndims(     ishft + jv) = 3
+               iom_file(kiomid)%dimsz(1:3, ishft + jv) = (/ inx, iny, jpk /)
+               iom_file(kiomid)%ofs(       ishft + jv) = 0.
+            END DO
+         ELSE                 ! new file
+            iom_file(kiomid)%nvars = 0
+            iom_file(kiomid)%irec  = 2
+            ! store file informations
+            WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, kdompar(:,1), jpk   ! store domain size
+         ENDIF
+      ENDIF
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo), '   error in opening file '//TRIM(cdname), ctmp1 )
+      ENDIF
+      !
+   END SUBROUTINE iom_rstdimg_open
+
+
+   SUBROUTINE iom_rstdimg_close( kiomid )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_close  ***
+      !!
+      !! ** Purpose : close an input file
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kiomid   ! iom identifier of the file to be closed
+      !
+      CHARACTER(LEN=100)                      ::   clinfo                     ! info character
+      INTEGER                                 ::   jv                         ! loop counter
+      INTEGER                                 ::   irecl8                     ! record length
+      INTEGER                                 ::   ios                        ! IO status
+      INTEGER                                 ::   irhd                       ! record of the header infos
+      INTEGER                                 ::   ivnum                      ! number of variables
+      INTEGER                                 ::   idrst                      ! file logical unit
+      INTEGER                                 ::   inx, iny, inz              ! x,y,z dimension of the variable
+      INTEGER                                 ::   in0d, in1d, in2d, in3d     ! number of 0/1/2/3D variables
+      CHARACTER(LEN=jpvnl), DIMENSION(jpmax_vars) ::   clna0d, clna1d, clna2d, clna3d    ! name of 0/1/2/3D variables
+      REAL(wp),          DIMENSION(jpmax_vars) ::   zval0d, zval1d, zval2d, zval3d    ! value of 0d variables or record
+      !                                                                               ! position for 1/2/3D variables
+      !---------------------------------------------------------------------
+      !
+      clinfo = '                    iom_rstdimg_close ~~~  '
+      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+      ! test if we can write in the file (test with INQUIRE gives alsways YES even with read only files...)
+      READ(  idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   
+      WRITE( idrst, REC = 1, IOSTAT = ios            ) irecl8, inx, iny, inz   
+      ! We can write in the file => we update its header before closing
+      IF( ios == 0 ) THEN
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz   ! get back domain size
+         irhd = iom_file(kiomid)%irec
+         ivnum = iom_file(kiomid)%nvars
+         in0d = 0   ;   in1d = 0   ;   in2d = 0   ;   in3d = 0
+         DO jv = 1, ivnum   ! loop on each variable to get its name and value/record position
+            SELECT CASE (iom_file(kiomid)%ndims(jv))
+            CASE (0)   ! scalar variable
+               in0d = in0d + 1
+               clna0d(in0d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval0d(in0d) = iom_file(kiomid)%ofs(jv)   ! warning: trick... we use ofs to store the value
+            CASE (1)   ! 1d variable
+               in1d = in1d + 1
+               clna1d(in1d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval1d(in1d) = iom_file(kiomid)%nvid(jv)
+            CASE (2)   ! 2d variable
+               in2d = in2d + 1
+               clna2d(in2d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval2d(in2d) = iom_file(kiomid)%nvid(jv)
+            CASE (3)   ! 3d variable
+               in3d = in3d + 1
+               clna3d(in3d) = TRIM(iom_file(kiomid)%cn_var(jv))
+               zval3d(in3d) = iom_file(kiomid)%nvid(jv)
+            CASE DEFAULT   ;   CALL ctl_stop( TRIM(clinfo), 'Should not ne there...' )
+            END SELECT
+         END DO
+         ! force to have at least 1 variable in each list (not necessary (?), but safer...)
+         IF( in0d == 0 ) THEN   ;   in0d = 1   ;   clna0d(1) = 'no0d'   ;   zval0d(1) = -1.   ;   ENDIF
+         IF( in1d == 0 ) THEN   ;   in1d = 1   ;   clna1d(1) = 'no1d'   ;   zval1d(1) = -1.   ;   ENDIF
+         IF( in2d == 0 ) THEN   ;   in2d = 1   ;   clna2d(1) = 'no2d'   ;   zval2d(1) = -1.   ;   ENDIF
+         IF( in3d == 0 ) THEN   ;   in3d = 1   ;   clna3d(1) = 'no3d'   ;   zval3d(1) = -1.   ;   ENDIF
+         ! update the file header before closing it
+         WRITE( idrst, REC = 1, IOSTAT = ios, ERR = 987 )              &
+            &   irecl8, inx, iny, inz, in0d, in1d, in2d, in3d, irhd,   &
+            &   jpni, jpnj, jpnij, narea, jpiglo, jpjglo,              &
+            &   nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+         IF( (ivnum * (jpvnl + wp)) > irecl8 ) THEN 
+            CALL ctl_stop( TRIM(clinfo),   &
+                 &   'Last record size is too big... You could reduce the value of jpvnl' )
+         ELSE 
+            WRITE( idrst, REC = irhd, IOSTAT = ios, ERR = 987 )                        &
+                 &   clna0d(1:in0d), zval0d(1:in0d), clna1d(1:in1d), zval1d(1:in1d),   &
+                 &   clna2d(1:in2d), zval2d(1:in2d), clna3d(1:in3d), zval3d(1:in3d)
+         ENDIF
+      ELSE
+         ios = 0   ! we cannot write in the file
+      ENDIF
+      !
+      CLOSE( idrst, IOSTAT = ios, ERR = 987 )
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo),   &
+            &   '   error when updating the header of '//TRIM(iom_file(kiomid)%name), ctmp1 )
+      ENDIF
+      !    
+   END SUBROUTINE iom_rstdimg_close
+
+
+   SUBROUTINE iom_rstdimg_g0d( kiomid, kvid, pvar )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_rstdimg_g0d  ***
+      !!
+      !! ** Purpose : read a scalar with RSTDIMG
+      !!-----------------------------------------------------------------------
+      INTEGER,  INTENT(in   ) ::   kiomid    ! Identifier of the file
+      INTEGER,  INTENT(in   ) ::   kvid      ! variable id
+      REAL(wp), INTENT(  out) ::   pvar      ! read field
+      !---------------------------------------------------------------------
+      !
+      pvar = iom_file(kiomid)%ofs(kvid)   ! warning: trick... we use ofs to store the value
+      !
+   END SUBROUTINE iom_rstdimg_g0d
+
+
+   SUBROUTINE iom_rstdimg_rp0d( kiomid, cdvar, kvid, pv_r0d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
+      !!
+      !! ** Purpose : write a scalar with RSTDIMG
+      !!--------------------------------------------------------------------
+      INTEGER                   , INTENT(in) ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)          , INTENT(in) ::   cdvar    ! time axis name
+      INTEGER                   , INTENT(in) ::   kvid     ! variable id
+      REAL(wp)                  , INTENT(in) ::   pv_r0d   ! written 0d field
+      !
+      CHARACTER(LEN=100) ::   clinfo     ! info character
+      INTEGER            ::   idvar      ! variable id
+      !---------------------------------------------------------------------
+      !  
+      clinfo = '                    iom_rstdimg_rp0d ~~~  '
+      IF( kvid <= 0 ) THEN   !   new variable
+         idvar = iom_file(kiomid)%nvars + 1
+      ELSE                   !   the variable already exists in the file
+         idvar = kvid
+      ENDIF
+      IF( idvar <= jpmax_vars ) THEN
+         iom_file(kiomid)%nvars = idvar
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(   idvar) = 1   ! useless, Od variables a strored in record 1
+         iom_file(kiomid)%ndims(  idvar) = 0
+         iom_file(kiomid)%luld(   idvar) = .FALSE.
+         iom_file(kiomid)%scf(    idvar) = 1.
+         iom_file(kiomid)%ofs(    idvar) = pv_r0d   ! warning: trick... we use ofs to store the value
+      ELSE
+         CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
+      ENDIF
+   END SUBROUTINE iom_rstdimg_rp0d
+
+
+   SUBROUTINE iom_rstdimg_g123d( kiomid, kdom  , kvid, kx1, kx2, ky1, ky2,   &
+         &                       pv_r1d, pv_r2d, pv_r3d )
+      !!-----------------------------------------------------------------------
+      !!                  ***  ROUTINE  iom_rstdimg_g123d  ***
+      !!
+      !! ** Purpose : read a 1D/2D/3D variable with RSTDIMG
+      !!
+      !! ** Method : read ONE record at each CALL
+      !!-----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   )           ::   kiomid     ! iom identifier of the file
+      INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read
+      INTEGER                    , INTENT(in   )           ::   kvid       ! variable id
+      INTEGER ,                    INTENT(inout)           ::   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            ::   ios                  ! IO status
+      INTEGER            ::   jk                   ! loop counter
+      INTEGER            ::   idrst                ! logical unit of the restart file
+      !---------------------------------------------------------------------
+      clinfo = '                    iom_rstdimg_g123d ~~~  '
+      !
+      IF( kdom == jpdom_data .OR. kdom == jpdom_global ) THEN
+         CALL ctl_stop( TRIM(clinfo), TRIM(iom_file(kiomid)%cn_var(kvid))//': case not coded for rstdimg files' )
+      ELSE
+      !
+         idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+         ! modify the subdomain indexes because we cannot directly extract the appropriate subdomaine
+         IF(     kdom == jpdom_local_full    ) THEN   ;   kx1 = 1   ;   kx2 = jpi    ;   ky1 = 1
+         ELSEIF( kdom == jpdom_local_noextra ) THEN   ;   kx1 = 1   ;   kx2 = nlci   ;   ky1 = 1
+         ENDIF
+         !
+         IF(     PRESENT(pv_r1d) ) THEN   ! read 1D variables
+            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r1d(:)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ! read 2D variables
+            READ(    idrst, REC = iom_file(kiomid)%nvid(kvid)         , IOSTAT = ios, ERR = 987 )   pv_r2d(kx1:kx2, ky1:ky2    )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ! read 3D variables
+            DO jk = 1, iom_file(kiomid)%dimsz(3,kvid)   ! do loop on each level
+               READ( idrst, REC = iom_file(kiomid)%nvid(kvid) + jk - 1, IOSTAT = ios, ERR = 987 )   pv_r3d(kx1:kx2, ky1:ky2, jk)
+            END DO
+         ENDIF
+987      CONTINUE
+         IF( ios /= 0 ) THEN
+            WRITE(ctmp1,*) '           iostat = ', ios
+            CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE iom_rstdimg_g123d
+
+
+   SUBROUTINE iom_rstdimg_rp123d( kiomid, cdvar, kvid, pv_r1d, pv_r2d, pv_r3d )
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_rstdimg_rstput  ***
+      !!
+      !! ** Purpose : write a 2D/3D variable with RSTDIMG
+      !!--------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::   kiomid   ! Identifier of the file 
+      CHARACTER(len=*)                , INTENT(in)           ::   cdvar    ! time axis name
+      INTEGER                         , INTENT(in)           ::   kvid     ! variable id
+      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
+      !
+      CHARACTER(LEN=100)    ::   clinfo               ! info character
+      INTEGER               ::   irecl8               ! reacord length
+      INTEGER               ::   ios                  ! IO status
+      INTEGER               ::   idrst                ! reacord length
+      INTEGER               ::   inx, iny, inz        ! x,y,z dimension of the variable
+      INTEGER               ::   idvar                ! variable id
+      INTEGER               ::   istop                ! temporary storage of nstop
+      INTEGER               ::   irec                 ! record number
+      INTEGER               ::   ix1, ix2, iy1, iy2   ! subdomain indexes
+      INTEGER               ::   jk                   ! loop counter
+      !---------------------------------------------------------------------
+      !
+      clinfo = '          iom_rstdimg_rp123d, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar)
+      istop = nstop                   ! store the actual value of nstop
+      irec = iom_file(kiomid)%irec    ! get back the record number of the variable
+      idrst = iom_file(kiomid)%nfid   ! get back the logical unit of the restart file
+      IF( kvid <= 0 ) THEN   !   new variable
+         idvar = iom_file(kiomid)%nvars + 1
+      ELSE                   !   the variable already exists in the file
+         idvar = kvid
+      ENDIF
+      IF( idvar > jpmax_vars )   CALL ctl_stop( TRIM(clinfo), 'increase the value of jpmax_vars' )
+      IF( .NOT. PRESENT(pv_r1d) ) THEN
+         ! find which part of data must be written
+         READ( idrst, REC = 1, IOSTAT = ios, ERR = 987 ) irecl8, inx, iny, inz
+         IF(     inx == (nlei - nldi + 1) .AND. iny == (nlej - nldj + 1) ) THEN
+            ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej
+         ELSEIF( inx == nlci              .AND. iny == nlcj              ) THEN
+            ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj
+         ELSEIF( inx == jpi               .AND. iny == jpj               ) THEN
+            ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj
+         ELSE 
+            CALL ctl_stop( clinfo, 'should have been an impossible case...' )
+         ENDIF
+      ENDIF
+      IF( istop == nstop ) THEN
+         ! write the data
+         IF(     PRESENT(pv_r1d) ) THEN   ! 1D variable
+            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r1d(:)
+         ELSEIF( PRESENT(pv_r2d) ) THEN   ! 2D variable
+            WRITE( idrst, REC = irec            , IOSTAT = ios, ERR = 987 ) pv_r2d(ix1:ix2, iy1:iy2    )
+         ELSEIF( PRESENT(pv_r3d) ) THEN   ! 3D variable
+            DO jk = 1, jpk   ! do loop on each level
+               WRITE( idrst, REC = irec + jk - 1, IOSTAT = ios, ERR = 987 ) pv_r3d(ix1:ix2, iy1:iy2, jk)
+            END DO
+         ENDIF
+         ! fill the file informations
+         iom_file(kiomid)%nvars = idvar
+         IF(     PRESENT(pv_r1d) ) THEN
+            iom_file(kiomid)%irec              = irec + 1
+            iom_file(kiomid)%ndims(     idvar) = 1
+            iom_file(kiomid)%dimsz(1  , idvar) = inz
+         ELSEIF( PRESENT(pv_r2d) ) THEN
+            iom_file(kiomid)%irec              = irec + 1
+            iom_file(kiomid)%ndims(     idvar) = 2
+            iom_file(kiomid)%dimsz(1:2, idvar) = (/ inx, iny /)
+         ELSEIF( PRESENT(pv_r3d) ) THEN
+            iom_file(kiomid)%irec              = irec + inz
+            iom_file(kiomid)%ndims(     idvar) = 3
+            iom_file(kiomid)%dimsz(1:3, idvar) = (/ inx, iny, inz /)
+         ENDIF
+         iom_file(kiomid)%cn_var(idvar) = TRIM(cdvar)
+         iom_file(kiomid)%nvid(  idvar) = irec
+         iom_file(kiomid)%luld(  idvar) = .FALSE.
+         iom_file(kiomid)%scf(   idvar) = 1.
+         iom_file(kiomid)%ofs(   idvar) = 0.
+      ENDIF
+987   CONTINUE
+      IF( ios /= 0 ) THEN
+         WRITE(ctmp1,*) '           iostat = ', ios
+         CALL ctl_stop( TRIM(clinfo), '   IO error with file '//TRIM(iom_file(kiomid)%name), ctmp1 )
+      ELSE
+         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' written ok'
+      ENDIF
+      !     
+   END SUBROUTINE iom_rstdimg_rp123d
+
+
+   !!======================================================================
+END MODULE iom_rstdimg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90	(revision 3437)
@@ -0,0 +1,579 @@
+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
+
+   !!----------------------------------------------------------------------
+   !! 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 ( clinfo3 == 'tra' )  THEN
+             zvctl1 = t_ctll(jn)
+             zvctl2 = s_ctll(jn)
+         ELSEIF ( clinfo3 == 'dyn' )   THEN
+             zvctl1 = u_ctll(jn)
+             zvctl2 = v_ctll(jn)
+         ENDIF
+
+         ! Compute the sum control
+         ! 2D arrays
+         IF( PRESENT(tab2d_1) )   THEN
+            zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) )
+            zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) )
+         ENDIF
+
+         ! 3D arrays
+         IF( PRESENT(tab3d_1) )   THEN
+            zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) )
+            zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) )
+         ENDIF
+
+         ! Print the result
+         IF( PRESENT(clinfo3) )   THEN
+            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2
+            SELECT CASE( clinfo3 )
+            CASE ( 'tra-ta' ) 
+               t_ctll(jn) = zsum1
+            CASE ( 'tra' ) 
+                t_ctll(jn) = zsum1
+                s_ctll(jn) = zsum2
+            CASE ( 'dyn' ) 
+                u_ctll(jn) = zsum1
+                v_ctll(jn) = zsum2 
+            END SELECT
+         ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN
+            WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2
+         ELSE
+            WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1
+         ENDIF
+
+      ENDDO
+
+      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(:) = nldit(:) 
+         nleitl(:) = nleit(:) 
+         nldjtl(:) = nldjt(:) 
+         nlejtl(:) = nlejt(:) 
+         !
+         nimpptl(:) = nimppt(:)
+         njmpptl(:) = njmppt(:)
+         !
+         nlcitl(:) = nlcit(:)
+         nlcjtl(:) = nlcjt(:)
+         !
+         ibonitl(:) = ibonit(:)
+         ibonjtl(:) = ibonjt(:)
+      ELSE
+         sind = 1
+         eind = ijsplt
+         clb_name = "('mono.output_',I4.4)"
+         cl_run = 'MONO processor run '
+         ! compute indices for each area as done in mpp_init subroutine
+         CALL sub_dom
+      ENDIF
+
+      ALLOCATE( numid(eind-sind+1) )
+
+      DO jn = sind, eind
+         WRITE(clfile_out,FMT=clb_name) jn-1
+         CALL 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, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+      !  Computation of local domain sizes ilcitl() ilcjtl()
+      !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array (cf. par_oce.F90).
+
+      ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci
+#if defined key_nemocice_decomp
+      ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
+#else
+      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj
+#endif
+
+      ALLOCATE(ilcitl (isplt,jsplt))
+      ALLOCATE(ilcjtl (isplt,jsplt))
+
+      nrecil  = 2 * jpreci
+      nrecjl  = 2 * jprecj
+      irestil = MOD( jpiglo - nrecil , isplt )
+      irestjl = MOD( jpjglo - nrecjl , jsplt )
+
+      IF(  irestil == 0 )   irestil = isplt
+#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
+      ! -------------------------------
+
+      ALLOCATE(iimpptl(isplt,jsplt))
+      ALLOCATE(ijmpptl(isplt,jsplt))
+      
+      iimpptl(:,:) = 1
+      ijmpptl(:,:) = 1
+      
+      IF( isplt > 1 ) THEN
+         DO jj = 1, jsplt
+            DO ji = 2, isplt
+               iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil
+            END DO
+         END DO
+      ENDIF
+
+      IF( jsplt > 1 ) THEN
+         DO jj = 2, jsplt
+            DO ji = 1, isplt
+               ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, ijsplt
+         ii = 1 + MOD( jn-1, isplt )
+         ij = 1 + (jn-1) / isplt
+         nimpptl(jn) = iimpptl(ii,ij)
+         njmpptl(jn) = ijmpptl(ii,ij)
+         nlcitl (jn) = ilcitl (ii,ij)     
+         nlcil       = nlcitl (jn)     
+         nlcjtl (jn) = ilcjtl (ii,ij)     
+         nlcjl       = nlcjtl (jn)
+         nbondjl = -1                                    ! general case
+         IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor
+         IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
+         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
+         ibonjtl(jn) = nbondjl
+         
+         nbondil = 0                                     ! 
+         IF( MOD( jn, isplt ) == 1 )   nbondil = -1      !
+         IF( MOD( jn, isplt ) == 0 )   nbondil =  1      !
+         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
+         ibonitl(jn) = nbondil
+         
+         nldil =  1   + jpreci
+         nleil = nlcil - jpreci
+         IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1
+         IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil
+         nldjl =  1   + jprecj
+         nlejl = nlcjl - jprecj
+         IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1
+         IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl
+         nlditl(jn) = nldil
+         nleitl(jn) = nleil
+         nldjtl(jn) = nldjl
+         nlejtl(jn) = nlejl
+      END DO
+      !
+      DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl )
+      !
+   END SUBROUTINE sub_dom
+
+   !!======================================================================
+END MODULE prtctl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90	(revision 3437)
@@ -0,0 +1,227 @@
+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)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 phycst          ! physical constants
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE eosbn2          ! equation of state            (eos bn2 routine)
+   USE trdmld_oce      ! ocean active mixed layer tracers trends variables
+   USE domvvl          ! variable volume
+
+   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 opa  module
+
+   LOGICAL, PUBLIC ::   lrst_oce =  .FALSE.   !: logical to control the oce restart write 
+   INTEGER, PUBLIC ::   numror, numrow        !: logical unit for cean restart (read and write)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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   ! ice output restart file name
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN   ! default definitions
+         lrst_oce = .FALSE.   
+         nitrst = nitend
+      ENDIF
+      IF( MOD( kt - 1, nstock ) == 0 ) THEN   
+         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment
+         nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing
+         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run
+      ENDIF
+      ! 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
+         ! beware of the format used to write kt (default is i8.8, that should be large enough...)
+         IF( nitrst > 999999999 ) THEN   ;   WRITE(clkt, *       ) nitrst
+         ELSE                            ;   WRITE(clkt, '(i8.8)') nitrst
+         ENDIF
+         ! create the file
+         clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out)
+         IF(lwp) THEN
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart binary file: '//clname
+            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart NetCDF file: '//clname
+            END SELECT
+            IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression'
+            IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt
+            ELSE                          ;   WRITE(numout,*) '             kt = '             , kt
+            ENDIF
+         ENDIF
+         !
+         CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib )
+         lrst_oce = .TRUE.
+      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 time step
+                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step
+
+                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      )
+      IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )
+                     !
+                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields
+                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        )
+                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     )
+                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      )
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      )
+#if defined key_zdfkpp
+                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       )
+#endif
+      IF( kt == nitrst ) THEN
+         CALL iom_close( numrow )     ! close the restart file (only at last time step)
+         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE.
+      ENDIF
+      !
+   END SUBROUTINE rst_write
+
+
+   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, zrdttra1
+      INTEGER  ::   jk, jlibalt = jprstlib
+      LOGICAL  ::   llok
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN                                             ! Contol prints
+         WRITE(numout,*)
+         SELECT CASE ( jprstlib )
+         CASE ( jpnf90    )   ;   WRITE(numout,*) 'rst_read : read oce NetCDF restart file'
+         CASE ( jprstdimg )   ;   WRITE(numout,*) 'rst_read : read oce binary restart file'
+         END SELECT
+         IF ( snc4set%luse )      WRITE(numout,*) 'rst_read : configured with NetCDF4 support'
+         WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+
+      IF ( jprstlib == jprstdimg ) THEN
+        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+        ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90
+        INQUIRE( FILE = TRIM(cn_ocerst_in)//'.nc', EXIST = llok )
+        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+      ENDIF
+      CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )
+
+      ! 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
+      IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 )   THEN
+         CALL iom_get( numror, 'rdttra1', zrdttra1 )
+         IF( zrdttra1 /= rdttra(1) )   neuler = 0
+      ENDIF
+      ! 
+                     CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) )
+                     CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    )
+      IF( lk_vvl )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )
+                     !
+                     CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields
+                     CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      )
+                     CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) )
+                     CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) )
+                     CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   )
+                     CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    )
+                     CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density
+#if defined key_zdfkpp
+      IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN
+                     CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly
+      ELSE
+                     CALL eos( tsn, rhd )   ! compute rhd
+      ENDIF
+#endif
+      !
+      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0)
+         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values
+         ub   (:,:,:)   = un   (:,:,:)
+         vb   (:,:,:)   = vn   (:,:,:)
+         rotb (:,:,:)   = rotn (:,:,:)
+         hdivb(:,:,:)   = hdivn(:,:,:)
+         sshb (:,:)     = sshn (:,:)
+         IF( lk_vvl ) THEN
+            DO jk = 1, jpk
+               fse3t_b(:,:,jk) = fse3t_n(:,:,jk)
+            END DO
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE rst_read
+
+   !!=====================================================================
+END MODULE restart
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90	(revision 3437)
@@ -0,0 +1,756 @@
+MODULE cla
+   !!======================================================================
+   !!                    ***  MODULE  cla  ***
+   !! Cross Land Advection : specific update of the horizontal divergence,
+   !!                        tracer trends and after velocity
+   !!
+   !!                 ---   Specific to ORCA_R2   ---
+   !!
+   !!======================================================================
+   !! History :  1.0  ! 2002-11 (A. Bozec)  Original code
+   !!            3.2  ! 2009-07 (G. Madec)  merge cla, cla_div, tra_cla, cla_dynspg
+   !!                 !                     and correct a mpp bug reported by A.R. Porter
+   !!----------------------------------------------------------------------
+#if defined key_orca_r2
+   !!----------------------------------------------------------------------
+   !!   'key_orca_r2'                                 global ocean model R2
+   !!----------------------------------------------------------------------
+   !!   cla_div           : update of horizontal divergence at cla straits
+   !!   tra_cla           : update of tracers at cla straits
+   !!   cla_dynspg        : update of after horizontal velocities at cla straits
+   !!   cla_init          : initialisation - control check
+   !!   cla_bab_el_mandeb : cross land advection for Bab-el-mandeb strait
+   !!   cla_gibraltar     : cross land advection for Gibraltar strait
+   !!   cla_hormuz        : cross land advection for Hormuz strait
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and tracers
+   USE dom_oce        ! ocean space and time domain
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE dynspg_oce     ! ocean dynamics: surface pressure gradient variables
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distributed memory computing library
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   cla_init     ! routine called by opa.F90
+   PUBLIC   cla_div      ! routine called by divcur.F90
+   PUBLIC   cla_traadv   ! routine called by traadv.F90
+   PUBLIC   cla_dynspg   ! routine called by dynspg_flt.F90
+
+   INTEGER  ::   nbab, ngib, nhor   ! presence or not of required grid-point on local domain
+   !                                ! for Bab-el-Mandeb, Gibraltar, and Hormuz straits
+   
+   !                                           !   fixed part  !  time evolving    !!! profile of hdiv for some straits
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_101, hdiv_139_101_kt    ! Gibraltar     (i,j)=(172,101)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_139_102                     ! Gibraltar     (i,j)=(139,102)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_141_102, hdiv_141_102_kt    ! Gibraltar     (i,j)=(141,102)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_88 , hdiv_161_88_kt     ! Bab-el-Mandeb (i,j)=(161,88)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_161_87                      ! Bab-el-Mandeb (i,j)=(161,87)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_160_89 , hdiv_160_89_kt     ! Bab-el-Mandeb (i,j)=(160,89)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   hdiv_172_94                      ! Hormuz        (i,j)=(172, 94)
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION (:) ::   t_171_94_hor, s_171_94_hor       ! Temperature, salinity in Hormuz strait
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cla_div( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE div_cla  ***
+      !!
+      !! ** Purpose :   update the horizontal divergence of the velocity field
+      !!              at some straits ( Gibraltar, Bab el Mandeb and Hormuz ).
+      !!
+      !! ** Method  : - first time-step: initialisation of cla
+      !!              - all   time-step: using imposed transport at each strait, 
+      !!              the now horizontal divergence is updated
+      !!
+      !! ** Action  :   phdivn   updted now horizontal divergence at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !     
+      IF( kt == nit000 ) THEN
+         !
+         CALL cla_init                                        ! control check 
+         !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'div_cla : cross land advection on hdiv '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+         !
+         IF( nbab == 1 )   CALL cla_bab_el_mandeb('ini')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+         IF( ngib == 1 )   CALL cla_gibraltar    ('ini')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+         IF( nhor == 1 )   CALL cla_hormuz       ('ini')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+         !
+      ENDIF                           
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('div')    ! Bab el Mandeb ( Red Sea - Indian ocean )
+      IF( ngib == 1    )   CALL cla_gibraltar    ('div')    ! Gibraltar strait (Med Sea - Atlantic ocean)
+      IF( nhor == 1    )   CALL cla_hormuz       ('div')    ! Hormuz Strait ( Persian Gulf - Indian ocean )
+      !
+!!gm  lbc useless here, no?
+!!gm      CALL lbc_lnk( hdivn, 'T', 1. )                    ! Lateral boundary conditions on hdivn
+      !
+   END SUBROUTINE cla_div
+   
+   
+   SUBROUTINE cla_traadv( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_cla  ***
+      !!                   
+      !! ** Purpose :   Update the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations
+      !!      at some straits ( Bab el Mandeb, Gibraltar, Hormuz ).
+      !!
+      !! ** Method  :   using both imposed transport at each strait and T & S
+      !!              budget, the now tracer trends is updated
+      !!
+      !! ** Action  :   (ta,sa)   updated now tracer trends at cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_cla : cross land advection on tracers '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('tra')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('tra')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('tra')      ! Hormuz Strait ( Persian Gulf)
+      !
+   END SUBROUTINE cla_traadv
+
+   
+   SUBROUTINE cla_dynspg( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_dynspg  ***
+      !!                   
+      !! ** Purpose :   Update the after velocity at some straits 
+      !!              (Bab el Mandeb, Gibraltar, Hormuz).
+      !!
+      !! ** Method  :   required to compute the filtered surface pressure gradient 
+      !!
+      !! ** Action  :   (ua,va)   after velocity at the cla straits
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'cla_dynspg : cross land advection on (ua,va) '
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+      ENDIF
+      !
+      IF( nbab == 1    )   CALL cla_bab_el_mandeb('spg')      ! Bab el Mandeb strait
+      IF( ngib == 1    )   CALL cla_gibraltar    ('spg')      ! Gibraltar strait
+      IF( nhor == 1    )   CALL cla_hormuz       ('spg')      ! Hormuz Strait ( Persian Gulf)
+      !
+!!gm lbc is needed here, not?
+!!gm      CALL lbc_lnk( hdivn, 'U', -1. )   ;   CALL lbc_lnk( hdivn, 'V', -1. )      ! Lateral boundary conditions 
+      !
+   END SUBROUTINE cla_dynspg
+
+
+   SUBROUTINE cla_init
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE cla_init  ***
+      !!           
+      !! ** Purpose :   control check for mpp computation  
+      !!
+      !! ** Method  : - All the strait grid-points must be inside one of the 
+      !!              local domain interior for the cla advection to work
+      !!              properly in mpp (i.e. inside (2:jpim1,2:jpjm1) ).
+      !!              Define the corresponding indicators (nbab, ngib, nhor)
+      !!              - The profiles of cross-land fluxes are currently hard
+      !!              coded for L31 levels. Stop if jpk/=31
+      !!
+      !! ** Action  :   nbab, ngib, nhor   strait inside the local domain or not
+      !!---------------------------------------------------------------------
+      REAL(wp) ::   ztemp   ! local scalar
+      INTEGER  ::   ierr    ! local integer
+      !!---------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cla_init : cross land advection initialisation '
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~'
+      !
+      !                           ! Allocate arrays for this module
+      ALLOCATE( hdiv_139_101(jpk) , hdiv_139_101_kt(jpk) ,     &    ! Gibraltar
+         &      hdiv_139_102(jpk) ,                            &
+         &      hdiv_141_102(jpk) , hdiv_141_102_kt(jpk) ,     &
+         &      hdiv_161_88 (jpk) , hdiv_161_88_kt (jpk) ,     &    ! Bab-el-Mandeb
+         &      hdiv_161_87 (jpk) ,                            &                     
+         &      hdiv_160_89 (jpk) , hdiv_160_89_kt (jpk) ,     &     ! Hormuz
+         &      hdiv_172_94 (jpk) ,                            &
+         &      t_171_94_hor(jpk) , s_171_94_hor   (jpk) , STAT=ierr )
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cla_init: unable to allocate arrays' )
+      !
+      IF( .NOT.lk_dynspg_flt )   CALL ctl_stop( 'cla_init: Cross Land Advection works only with lk_dynspg_flt=T ' )
+      !
+      IF( lk_vvl             )   CALL ctl_stop( 'cla_init: Cross Land Advection does not work with lk_vvl=T option' )
+      !
+      IF( jpk /= 31          )   CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2_L31' )
+      !
+      !                                        _|_______|_______|_
+      !                                     89  |       |///////|  
+      !                                        _|_______|_______|_
+      ! ------------------------ !          88  |///////|       | 
+      !   Bab el Mandeb strait   !             _|_______|_______|_
+      ! ------------------------ !          87  |///////|       | 
+      !                                        _|_______|_______|_
+      !                                         |  160  |  161  |  
+      !
+      ! The 6 Bab el Mandeb grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nbab = 0
+      IF(  ( 1 <= mj0( 88) .AND. mj1( 89) <= jpj ) .AND.    &  !* (161,89), (161,88) and (161,88) on the local pocessor
+         & ( 1 <= mi0(160) .AND. mi1(161) <= jpi )       )    nbab = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nbab )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! Only 2 points in each direction, this should never be a problem
+         CALL ctl_stop( ' cross land advection at Bab-el_Mandeb does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        ___________________________
+      ! ------------------------ !         102  |       |///////|       |
+      !     Gibraltar strait     !             _|_______|_______|_______|_
+      ! ------------------------ !         101  |       |///////|       |
+      !                                        _|_______|_______|_______|_ 
+      !                                         |  139  |  140  |  141  |
+      !
+      ! The 6 Gibraltar grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      ngib = 0
+      IF(  ( 2 <= mj0(101) .AND. mj1(102) <= jpjm1 ) .AND.    &  !* (139:141,101:102) on the local pocessor
+         & ( 2 <= mi0(139) .AND. mi1(141) <= jpim1 )       )    ngib = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( ngib )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Gibraltar does not work with your processor cutting: change it' )
+      ENDIF
+      !                                        _______________
+      ! ------------------------ !          94  |/////|     | 
+      !       Hormuz strait      !             _|_____|_____|_
+      ! ------------------------ !                171   172     
+      !           
+      ! The 2 Hormuz grid-points must be inside one of the interior of the
+      ! local domain for the cla advection to work properly (i.e. (2:jpim1,2:jpjm1)
+      nhor = 0
+      IF(    2 <= mj0( 94) .AND. mj1( 94) <= jpjm1  .AND.  & 
+         &   2 <= mi0(171) .AND. mi1(172) <= jpim1         )   nhor = 1 
+      !
+      ! test if there is no local domain that includes all required grid-points
+      ztemp = REAL( nhor )
+      IF( lk_mpp )   CALL mpp_sum( ztemp )      ! sum with other processors value
+      IF( ztemp == 0 ) THEN                     ! 3 points in i-direction, this may be a problem with some cutting
+           CALL ctl_stop( ' cross land advection at Hormuz does not work with your processor cutting: change it' )
+      ENDIF
+      !
+   END SUBROUTINE cla_init
+
+
+   SUBROUTINE cla_bab_el_mandeb( cd_td )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE cla_bab_el_mandeb  ***
+      !!       
+      !! ** Purpose :   update the now horizontal divergence, the tracer tendancy
+      !!              and the after velocity in vicinity of Bab el Mandeb ( Red Sea - Indian ocean).
+      !!
+      !! ** Method  :   compute the exchanges at each side of the strait :
+      !!
+      !!       surf. zio_flow
+      !! (+ balance of emp) /\  |\\\\\\\\\\\|
+      !!                    ||  |\\\\\\\\\\\|  
+      !!    deep zio_flow   ||  |\\\\\\\\\\\|  
+      !!            |  ||   ||  |\\\\\\\\\\\|  
+      !!        89  |  ||   ||  |\\\\\\\\\\\|  
+      !!            |__\/_v_||__|____________ 
+      !!            !\\\\\\\\\\\|          surf. zio_flow
+      !!            |\\\\\\\\\\\|<===    (+ balance of emp)
+      !!            |\\\\\\\\\\\u
+      !!        88  |\\\\\\\\\\\|<---      deep  zrecirc (upper+deep at 2 different levels)
+      !!            |___________|__________   
+      !!            !\\\\\\\\\\\|         
+      !!            |\\\\\\\\\\\| ---\     deep  zrecirc (upper+deep) 
+      !!        87  !\\\\\\\\\\\u ===/   + deep  zio_flow   (all at the same level)
+      !!            !\\\\\\\\\\\|  
+      !!            !___________|__________ 
+      !!                160         161
+      !!
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_red     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                   
+         zio_flow    = 0.4e6                       ! imposed in/out flow
+         zrecirc_upp = 0.2e6                       ! imposed upper recirculation water
+         zrecirc_bot = 0.5e6                       ! imposed bottom  recirculation water
+
+         hdiv_161_88(:) = 0.e0                     ! (161,88) Gulf of Aden side, north point
+         hdiv_161_87(:) = 0.e0                     ! (161,87) Gulf of Aden side, south point
+         hdiv_160_89(:) = 0.e0                     ! (160,89) Red sea side
+
+         DO jj = mj0(88), mj1(88)              !** profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               DO jk = 1, 8                        ! surface in/out flow   (Ind -> Red)   (div >0)
+                  hdiv_161_88(jk) = + zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! recirculation water   (Ind -> Red)   (div >0)
+               hdiv_161_88(20) =                 + zrecirc_upp   / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,20) )
+               hdiv_161_88(21) = + ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(87), mj1(87)              !** profile of hdiv at (161,88)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161)         !------------------------------
+               !                                   ! deep out flow + recirculation   (Red -> Ind)   (div <0)
+               hdiv_161_87(21) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,21) )
+            END DO
+         END DO
+         !
+         DO jj = mj0(89), mj1(89)              !** profile of hdiv at (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)         !------------------------------
+               DO jk = 1, 8                        ! surface inflow    (Ind -> Red)   (div <0)
+                  hdiv_160_89(jk) = - zio_flow / ( 8. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                   ! deep    outflow   (Red -> Ind)   (div >0)
+               hdiv_160_89(16)    = + zio_flow / (      e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,16) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Red Sea   (div >0) 
+         zemp_red = 0.e0                       !---------------------
+         DO jj = mj0(87), mj1(96)                  ! sum over the Red sea
+            DO ji = mi0(148), mi1(160) 
+               zemp_red = zemp_red + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_red )   ! sum with other processors value
+         zemp_red = zemp_red * 1.e-3               ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(88), mj1(88)                  !* profile of hdiv at (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               hdiv_161_88_kt(:) = hdiv_161_88(:)
+               DO jk = 1, 8                              ! increase the inflow from the Indian   (div >0) 
+                  hdiv_161_88_kt(jk) = hdiv_161_88(jk) + zemp_red / (8. * e2u(ji,jj) * fse3u(ji,jj,jk) )
+               END DO
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_88_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)                  !* profile of divergence at (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_161_87(:)
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)                  !* profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160) 
+               hdiv_160_89_kt(:) = hdiv_160_89(:)
+               DO jk = 1, 18                              ! increase the inflow from the Indian   (div <0) 
+                  hdiv_160_89_kt(jk) = hdiv_160_89(jk) - zemp_red / (10. * e1v(ji,jj) * fse3v(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_160_89_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(88), mj1(88)              !** (161,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(161), mi1(161) 
+               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal)
+               END DO
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (161,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(161), mi1(161) 
+               jk =  21                                 ! deep outflow + recirulation (combined flux)
+               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden
+                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden
+                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea
+               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   &
+                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   &
+                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)   
+            END DO
+         END DO
+         DO jj = mj0(89), mj1(89)              !** (161,88)   (Red sea side)
+            DO ji = mi0(160), mi1(160)
+               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal)
+               END DO
+               !                                  ! deep    outflow (from Red sea)
+               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem)
+               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal)
+            END DO
+         END DO
+         !
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(88), mj1(88)              !** (160,88)   (Gulf of Aden side, north point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_88_kt(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                              * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(87), mj1(87)              !** (160,87)   (Gulf of Aden side, south point)
+            DO ji = mi0(160), mi1(160)                   ! 160, not 161 as it is a U-point) 
+               ua(ji,jj,:) = - hdiv_161_87(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(88), mj1(88)              !** profile of divergence at (160,89)   (Red sea side)
+            DO ji = mi0(160), mi1(160)                   ! 88, not 89 as it is a V-point)
+               va(ji,jj,:) = - hdiv_160_89_kt(:) / ( e1t(ji,jj+1) * e2t(ji,jj+1) * fse3t(ji,jj+1,:) )   &
+                  &                              * e1v(ji,jj) * fse3v(ji,jj,:)
+            END DO
+         END DO
+      END SELECT
+      !
+   END SUBROUTINE cla_bab_el_mandeb
+   
+
+   SUBROUTINE cla_gibraltar( cd_td )
+      !! -------------------------------------------------------------------
+      !!                 ***  ROUTINE cla_gibraltar  ***
+      !!        
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Gibraltar 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method :
+      !!                     _______________________            
+      !!      deep  zio_flow /====|///////|====> surf. zio_flow
+      !!    + deep  zrecirc  \----|///////|     (+balance of emp)
+      !! 102                      u///////u
+      !!      mid.  recicul    <--|///////|<==== deep  zio_flow
+      !!                     _____|_______|_____  
+      !!      surf. zio_flow ====>|///////|       
+      !!    (+balance of emp)     |///////|
+      !! 101                      u///////|             
+      !!      mid.  recicul    -->|///////|               Caution: zrecirc split into 
+      !!      deep  zrecirc  ---->|///////|                  upper & bottom recirculation
+      !!                   _______|_______|_______ 
+      !!                     139     140     141  
+      !!
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='div' update the divergence
+      !                                         ! ='tra' update the tracers
+      !                                         ! ='spg' update after velocity
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zemp_med     ! temporary scalar
+      REAL(wp) ::   zio_flow, zrecirc_upp, zrecirc_mid, zrecirc_bot
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** initialization of the velocity
+         hdiv_139_101(:) = 0.e0                     !  139,101 (Atlantic side, south point)
+         hdiv_139_102(:) = 0.e0                     !  139,102 (Atlantic side, north point)
+         hdiv_141_102(:) = 0.e0                     !  141,102 (Med sea  side)
+            
+         !                                     !** imposed transport
+         zio_flow    = 0.8e6                        ! inflow surface  water
+         zrecirc_mid = 0.7e6                        ! middle recirculation water
+         zrecirc_upp = 2.5e6                        ! upper  recirculation water
+         zrecirc_bot = 3.5e6                        ! bottom recirculation water
+         !
+         DO jj = mj0(101), mj1(101)            !** profile of hdiv at 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 1, 14                        ! surface in/out flow (Atl -> Med)   (div >0)
+                  hdiv_139_101(jk) = + zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 15, 20                       ! middle  reciculation (Atl 101 -> Atl 102)   (div >0)   
+                  hdiv_139_101(jk) = + zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! upper reciculation (Atl 101 -> Atl 101)   (div >0)
+               hdiv_139_101(21) =               + zrecirc_upp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               !
+               !                                    ! upper & bottom reciculation (Atl 101 -> Atl 101 & 102)   (div >0)
+               hdiv_139_101(22) = ( zrecirc_bot - zrecirc_upp ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** profile of hdiv at 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)         !-----------------------------
+               DO jk = 15, 20                       ! middle reciculation (Atl 101 -> Atl 102)   (div <0)                
+                  hdiv_139_102(jk) = - zrecirc_mid / ( 6. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! outflow of Mediterranean sea + deep recirculation   (div <0) 
+               hdiv_139_102(22) = - ( zio_flow + zrecirc_bot ) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** velocity profile at 141,102  (Med sea side)
+            DO ji = mi0(141), mi1(141)         !------------------------------
+               DO  jk = 1, 14                       ! surface inflow in the Med     (div <0)
+                  hdiv_141_102(jk) = - zio_flow / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               !                                    ! deep    outflow toward the Atlantic    (div >0) 
+               hdiv_141_102(21)    = + zio_flow / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                     !** emp on the Mediterranean Sea  (div >0) 
+         zemp_med = 0.e0                       !-------------------------------
+         DO jj = mj0(96), mj1(110)                  ! sum over the Med sea
+            DO ji = mi0(141),mi1(181)
+               zemp_med = zemp_med + emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) 
+            END DO
+         END DO
+         DO jj = mj0(96), mj1(96)                   ! minus 2 points in Red Sea 
+            DO ji = mi0(148),mi1(148)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+            DO ji = mi0(149),mi1(149)
+               zemp_med = zemp_med - emp(ji,jj) * e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj)
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( zemp_med )    ! sum with other processors value
+         zemp_med = zemp_med * 1.e-3                ! convert in m3
+         !
+         !                                     !** Correct hdivn (including emp adjustment)
+         !                                     !-------------------------------------------
+         DO jj = mj0(101), mj1(101)                 !* 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139) 
+               hdiv_139_101_kt(:) = hdiv_139_101(:)      
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div >0) 
+                  hdiv_139_101_kt(jk) = hdiv_139_101(jk) + zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_139_101_kt(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_139_102(:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)
+            DO ji = mi0(141), mi1(141) 
+               hdiv_141_102(:) = hdiv_141_102(:)
+               DO jk = 1, 14                              ! increase the inflow from the Atlantic   (div <0)
+                  hdiv_141_102_kt(jk) = hdiv_141_102(jk) - zemp_med / ( 14. * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               hdivn(ji, jj,:) = hdivn(ji, jj,:) + hdiv_141_102_kt(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)   (div >0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)	
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal)
+               END DO
+            END DO
+         END DO
+         !
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)   (div <0)
+            DO ji = mi0(139), mi1(139) 
+               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal)
+               END DO
+               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0)
+               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0)
+               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow  
+                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation  
+                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation  
+               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   &
+                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   &
+                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal) 
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)                 !* 141,102 (Med side)   (div <0)
+            DO ji = mi0(141), mi1(141) 
+               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal)
+               END DO
+               !                                         ! deeper flow from Med sea to Atlantic
+               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem)
+               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         !
+         DO jj = mj0(101), mj1(101)            !** 139,101 (Atlantic side, south point)
+            DO ji = mi0(139), mi1(139)                    ! div >0 => ua >0, same sign
+               ua(ji,jj,:) = hdiv_139_101_kt(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                             * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 139,102 (Atlantic side, north point)
+            DO ji = mi0(139), mi1(139)                    ! div <0 => ua <0, same sign
+               ua(ji,jj,:) = hdiv_139_102(:) / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,:) )   &
+                  &                          * e2u(ji,jj) * fse3u(ji,jj,:)   
+            END DO
+         END DO
+         DO jj = mj0(102), mj1(102)            !** 140,102 (Med side) (140 not 141 as it is a U-point)
+            DO ji = mi0(140), mi1(140)                    ! div >0 => ua <0, opposite sign
+               ua(ji,jj,:) = - hdiv_141_102(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                            * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_gibraltar
+
+
+   SUBROUTINE cla_hormuz( cd_td )
+      !! -------------------------------------------------------------------
+      !!                   ***  ROUTINE div_hormuz  ***
+      !!              
+      !! ** Purpose :   update the now horizontal divergence, the tracer 
+      !!              tendancyand the after velocity in vicinity of Hormuz 
+      !!              strait ( Persian Gulf - Indian ocean ).
+      !!
+      !! ** Method  :   Hormuz strait
+      !!            ______________   
+      !!            |/////|<==      surface inflow
+      !!        94  |/////|     
+      !!            |/////|==>      deep    outflow
+      !!            |_____|_______
+      !!              171    172     
+      !!---------------------------------------------------------------------
+      CHARACTER(len=1), INTENT(in) ::   cd_td   ! ='ini' initialisation
+      !!                                        ! ='div' update the divergence
+      !!                                        ! ='tra' update the tracers
+      !!                                        ! ='spg' update after velocity
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zio_flow     ! temporary scalar
+      !!---------------------------------------------------------------------
+      !
+      SELECT CASE( cd_td ) 
+      !                     ! ---------------- !
+      CASE( 'ini' )         !  initialisation  ! 
+         !                  ! ---------------- ! 
+         !                                     !** profile of horizontal divergence due to cross-land advection
+         zio_flow  = 1.e6                          ! imposed in/out flow
+         !
+         hdiv_172_94(:) = 0.e0         
+         !
+         DO jj = mj0(94), mj1(94)                  ! in/out flow at (i,j) = (172,94)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                            ! surface inflow  (Indian ocean to Persian Gulf) (div<0)
+                  hdiv_172_94(jk) = - ( zio_flow / 8.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+               DO jk = 16, 18                          ! deep    outflow (Persian Gulf to Indian ocean) (div>0)
+                  hdiv_172_94(jk) = + ( zio_flow / 3.e0 * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !                                     !** T & S profile in the Hormuz strait (use in deep outflow)
+         !      Temperature       and         Salinity
+         t_171_94_hor(:)  = 0.e0   ;   s_171_94_hor(:)  = 0.e0
+         t_171_94_hor(16) = 18.4   ;   s_171_94_hor(16) = 36.27
+         t_171_94_hor(17) = 17.8   ;   s_171_94_hor(17) = 36.4
+         t_171_94_hor(18) = 16.    ;   s_171_94_hor(18) = 36.27
+         !
+         !                  ! ---------------- !
+      CASE( 'div' )         !   update hdivn   ! (call by divcur module)
+         !                  ! ---------=====-- ! 
+         !                                   
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               hdivn(ji,jj,:) = hdivn(ji,jj,:) + hdiv_172_94(:)
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'tra' )         !  update (ta,sa)  ! (call by traadv module)
+         !                  ! --------=======- !
+         !                          
+         DO jj = mj0(94), mj1(94)              !** 172,94 (Indian ocean side)
+            DO ji = mi0(172), mi1(172) 
+               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem) 
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal) 
+               END DO
+               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk)
+               END DO
+            END DO
+         END DO
+         !                  ! ---------------- !
+      CASE( 'spg' )         !  update (ua,va)  ! (call by dynspg module)
+         !                  ! --------=======- !
+         ! No barotropic flow through Hormuz strait
+         ! at this stage, (ua,va) are the after velocity, not the tendancy
+         ! compute the velocity from the divergence at T-point
+         DO jj = mj0(94), mj1(94)              !** 171,94 (Indian ocean side) (171 not 172 as it is the western U-point)
+            DO ji = mi0(171), mi1(171)                ! div >0 => ua >0, opposite sign
+               ua(ji,jj,:) = - hdiv_172_94(:) / ( e1t(ji+1,jj) * e2t(ji+1,jj) * fse3t(ji+1,jj,:) )   &
+                  &                           * e2u(ji,jj) * fse3u(ji,jj,:)
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE cla_hormuz
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                            Dummy module
+   !!----------------------------------------------------------------------
+   USE lib_mpp, ONLY:   ctl_stop
+CONTAINS
+   SUBROUTINE cla_init
+      CALL ctl_stop( 'cla_init: Cross Land Advection hard coded for ORCA_R2 with 31 levels' )
+   END SUBROUTINE cla_init
+   SUBROUTINE cla_div( kt )
+      WRITE(*,*) 'cla_div: You should have not see this print! error?', kt
+   END SUBROUTINE cla_div
+   SUBROUTINE cla_traadv( kt ) 
+      WRITE(*,*) 'cla_traadv: You should have not see this print! error?', kt
+   END SUBROUTINE cla_traadv
+   SUBROUTINE cla_dynspg( kt ) 
+      WRITE(*,*) 'dyn_spg_cla: You should have not see this print! error?', kt
+   END SUBROUTINE cla_dynspg
+#endif
+   
+   !!======================================================================
+END MODULE cla
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90	(revision 3437)
@@ -0,0 +1,275 @@
+MODULE lbclnk
+   !!======================================================================
+   !!                       ***  MODULE  lbclnk  ***
+   !! Ocean        : lateral boundary conditions
+   !!=====================================================================
+   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
+   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
+   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment  
+   !!----------------------------------------------------------------------
+#if   defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'             MPI massively parallel processing library
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
+   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
+   !!----------------------------------------------------------------------
+   USE lib_mpp          ! distributed memory computing library
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE mpp_lnk_2d_e
+   END INTERFACE
+
+   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
+   PUBLIC lbc_lnk_e
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                              shared memory computing
+   !!----------------------------------------------------------------------
+   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
+   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
+   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O manager
+   USE lbcnfd          ! north fold
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_lnk
+      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
+   END INTERFACE
+
+   INTERFACE lbc_lnk_e
+      MODULE PROCEDURE lbc_lnk_2d
+   END INTERFACE
+
+   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
+   PUBLIC   lbc_lnk_e 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign 
+      !!----------------------------------------------------------------------
+      !
+      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
+      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
+      !
+   END SUBROUTINE lbc_lnk_3d_gather
+
+
+   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE lbc_lnk_3d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
+      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+
+      IF( PRESENT( cd_mpp ) ) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE
+         !
+         !                                     !  East-West boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
+            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
+            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
+            !
+         CASE DEFAULT                             !**  East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d( 1 ,:,:) = zland
+               pt3d(jpi,:,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(jpi,:,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt3d(:, 1 ,:) = pt3d(:,3,:)
+               pt3d(:,jpj,:) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt3d(:, 1 ,:) = zland
+            END SELECT
+            !                                          ! North fold
+            pt3d( 1 ,jpj,:) = zland
+            pt3d(jpi,jpj,:) = zland
+            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1 ,:) = zland
+               pt3d(:,jpj,:) = zland
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,jpj,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE lbc_lnk_3d
+
+
+   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!---------------------------------------------------------------------
+      !!                 ***  ROUTINE lbc_lnk_2d  ***
+      !!
+      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
+      !!
+      !! ** Method  :   psign = -1 :    change the sign across the north fold
+      !!                      =  1 : no change of the sign across the north fold
+      !!                      =  0 : no change of the sign across the north fold and
+      !!                             strict positivity preserved: use inner row/column
+      !!                             for closed boundaries.
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
+      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign 
+      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
+      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
+      !!
+      REAL(wp) ::   zland
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
+      ELSE                         ;   zland = 0.e0
+      ENDIF
+
+      IF (PRESENT(cd_mpp)) THEN
+         ! only fill the overlap area and extra allows 
+         ! this is in mpp case. In this module, just do nothing
+      ELSE      
+         !
+         !                                     ! East-West boundaries
+         !                                     ! ====================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
+            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
+            pt2d(jpi,:) = pt2d(  2  ,:)
+            !
+         CASE DEFAULT                             !** East closed  --  West closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
+               pt2d( 1 ,:) = zland
+               pt2d(jpi,:) = zland
+            CASE ( 'F' )                              ! F-point
+               pt2d(jpi,:) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+         !                                     ! North-South boundaries
+         !                                     ! ======================
+         SELECT CASE ( nperio )
+         !
+         CASE ( 2 )                               !**  South symmetric  --  North closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
+               pt2d(:, 1 ) = pt2d(:,3)
+               pt2d(:,jpj) = zland
+            CASE ( 'V' , 'F' )                         ! V-, F-points
+               pt2d(:, 1 ) = psgn * pt2d(:,2)
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
+            SELECT CASE ( cd_type )                    ! South : closed
+            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
+               pt2d(:, 1 ) = zland
+            END SELECT
+            !                                          ! North fold
+            pt2d( 1 ,1  ) = zland 
+            pt2d( 1 ,jpj) = zland 
+            pt2d(jpi,jpj) = zland
+            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
+            !
+         CASE DEFAULT                             !**  North closed  --  South closed
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt2d(:, 1 ) = zland
+               pt2d(:,jpj) = zland
+            CASE ( 'F' )                               ! F-point
+               pt2d(:,jpj) = zland
+            END SELECT
+            !
+         END SELECT
+         !
+      ENDIF
+      !    
+   END SUBROUTINE lbc_lnk_2d
+
+#endif
+
+   !!======================================================================
+END MODULE lbclnk
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90	(revision 3437)
@@ -0,0 +1,345 @@
+MODULE lbcnfd
+   !!======================================================================
+   !!                       ***  MODULE  lbcnfd  ***
+   !! Ocean        : north fold  boundary conditions
+   !!======================================================================
+   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
+   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
+   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE lbc_nfd
+      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
+   END INTERFACE
+
+   PUBLIC   lbc_nfd   ! north fold conditions
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_3d  ***
+      !!
+      !! ** Purpose :   3D lateral boundary condition : North fold treatment
+      !!              without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt3d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                        !   = T , U , V , F , W points
+      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                        !   = -1. , the sign is changed if north fold boundary
+      !                                                        !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
+      !
+      INTEGER  ::   ji, jk
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      ijpjm1 = ijpj-1
+
+      DO jk = 1, jpk
+         !
+         SELECT CASE ( npolj )
+         !
+         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
+               END DO
+            END SELECT
+            !
+         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
+            !
+            SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )                         ! T-, W-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
+               END DO
+            CASE ( 'U' )                               ! U-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
+               END DO
+            CASE ( 'V' )                               ! V-point
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
+               END DO
+            CASE ( 'F' )                               ! F-point
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
+               END DO
+               DO ji = jpiglo/2+1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
+               END DO
+            END SELECT
+            !
+         CASE DEFAULT                           ! *  closed : the code probably never go through
+            !
+            SELECT CASE ( cd_type)
+            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
+               pt3d(:, 1  ,jk) = 0.e0
+               pt3d(:,ijpj,jk) = 0.e0
+            CASE ( 'F' )                               ! F-point
+               pt3d(:,ijpj,jk) = 0.e0
+            END SELECT
+            !
+         END SELECT     !  npolj
+         !
+      END DO
+      !
+   END SUBROUTINE lbc_nfd_3d
+
+
+   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine lbc_nfd_2d  ***
+      !!
+      !! ** Purpose :   2D lateral boundary condition : North fold treatment
+      !!       without processor exchanges. 
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :   pt2d with updated values along the north fold
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
+      !                                                      ! = T , U , V , F , W points
+      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
+      !                                                      !   = -1. , the sign is changed if north fold boundary
+      !                                                      !   =  1. , the sign is kept  if north fold boundary
+      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
+      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
+      !
+      INTEGER  ::   ji, jl, ipr2dj
+      INTEGER  ::   ijt, iju, ijpj, ijpjm1
+      !!----------------------------------------------------------------------
+
+      SELECT CASE ( jpni )
+      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
+      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
+      END SELECT
+      !
+      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
+         ipr2dj = pr2dj
+         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
+      ELSE
+         ipr2dj = 0 
+      ENDIF
+      !
+      ijpjm1 = ijpj-1
+
+
+      SELECT CASE ( npolj )
+      !
+      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
+         !
+         SELECT CASE ( cd_type )
+         !
+         CASE ( 'T' , 'W' )                               ! T- , W-points
+            DO jl = 0, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt=jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt=jpiglo-ji+2
+               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
+            END DO
+         CASE ( 'U' )                                     ! U-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'V' )                                     ! V-point
+            DO jl = -1, ipr2dj
+               DO ji = 2, jpiglo
+                  ijt = jpiglo-ji+2
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'F' )                                     ! F-point
+            DO jl = -1, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
+               END DO
+            END DO
+         CASE ( 'I' )                                     ! ice U-V point (I-point)
+            DO jl = 0, ipr2dj
+               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
+               DO ji = 3, jpiglo
+                  iju = jpiglo - ji + 3
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
+               END DO
+            END DO
+         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
+         CASE ( 'V' )                                     ! V-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo
+                  ijt = jpiglo-ji+1
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo
+               ijt = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
+            END DO
+         CASE ( 'F' )                               ! F-point
+            DO jl = 0, ipr2dj
+               DO ji = 1, jpiglo-1
+                  iju = jpiglo-ji
+                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
+               END DO
+            END DO
+            DO ji = jpiglo/2+1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'I' )                                  ! ice U-V point (I-point)
+            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
+            DO jl = 0, ipr2dj
+               DO ji = 2 , jpiglo-1
+                  ijt = jpiglo - ji + 2
+                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
+               END DO
+            END DO
+         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
+
+   !!======================================================================
+END MODULE lbcnfd
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 3437)
@@ -0,0 +1,3011 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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.
+   !!   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)
+   !!   mpprecv         :
+   !!   mppsend       :   SUBROUTINE mpp_ini_znl
+   !!   mppscatter    :
+   !!   mppgather     :
+   !!   mpp_min       : generic interface for mppmin_int , mppmin_a_int , mppmin_real, mppmin_a_real
+   !!   mpp_max       : generic interface for mppmax_int , mppmax_a_int , mppmax_real, mppmax_a_real
+   !!   mpp_sum       : generic interface for mppsum_int , mppsum_a_int , mppsum_real, mppsum_a_real
+   !!   mpp_minloc    :
+   !!   mpp_maxloc    :
+   !!   mppsync       :
+   !!   mppstop       :
+   !!   mppobc        : variant of mpp_lnk for open boundary condition
+   !!   mpp_ini_north : initialisation of north fold
+   !!   mpp_lbc_north : north fold processors gathering
+   !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo
+   !!----------------------------------------------------------------------
+   USE dom_oce        ! ocean space and time domain 
+   USE lbcnfd         ! north fold treatment
+   USE in_out_manager ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn
+   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free
+   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e
+   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc
+   PUBLIC   mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e
+   PUBLIC   mppscatter, mppgather
+   PUBLIC   mppobc, mpp_ini_ice, mpp_ini_znl
+   PUBLIC   mppsize
+   PUBLIC   lib_mpp_alloc   ! Called in nemogcm.F90
+
+   !! * 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
+   
+   !! ========================= !!
+   !!  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
+   INTEGER ::   ngrp_world        ! group ID for the world processors
+   INTEGER ::   ngrp_opa          ! group ID for the opa processors
+   INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold)
+   INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north
+   INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !)
+   INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line
+   INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm
+   INTEGER, DIMENSION(:), ALLOCATABLE, SAVE ::   nrank_north   ! dimension ndim_rank_north
+
+   ! Type of send : standard, buffered, immediate
+   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend)
+   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I')
+   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend 
+      
+   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon  ! buffer in case of bsend
+
+   ! message passing arrays
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ns, t4sn   ! 2 x 3d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4ew, t4we   ! 2 x 3d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE ::   t4p1, t4p2   ! 2 x 3d for north fold
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ns, t3sn   ! 3d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3ew, t3we   ! 3d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:,:)  , ALLOCATABLE, SAVE ::   t3p1, t3p2   ! 3d for north fold
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ns, t2sn   ! 2d for north-south & south-north
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2ew, t2we   ! 2d for east-west & west-east
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   t2p1, t2p2   ! 2d for north fold
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo
+   REAL(wp), DIMENSION(:,:,:)    , ALLOCATABLE, SAVE ::   tr2ew, tr2we ! 2d for east-west   & west-east   + extra outer halo
+
+   ! Arrays used in mpp_lbc_north_3d()
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   ztab, znorthloc
+   REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE   ::   znorthgloio
+   REAL(wp), DIMENSION(:,:,:)  , ALLOCATABLE, SAVE   ::   zfoldwk      ! Workspace for message transfers avoiding mpi_allgather
+
+   ! Arrays used in mpp_lbc_north_2d()
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_2d, znorthloc_2d
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_2d
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   zfoldwk_2d    ! Workspace for message transfers avoiding mpi_allgather
+
+   ! Arrays used in mpp_lbc_north_e()
+   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, SAVE    ::   ztab_e, znorthloc_e
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE    ::   znorthgloio_e
+
+   ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public
+   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 8                 ! Assumed maximum number of active neighbours
+   INTEGER, PUBLIC,  PARAMETER :: jptyps   = 5                 ! Number of different neighbour lists to be used for northfold exchanges 
+   INTEGER, PUBLIC,  DIMENSION (jpmaxngh,jptyps)    ::   isendto
+   INTEGER, PUBLIC,  DIMENSION (jptyps)             ::   nsndto
+   LOGICAL, PUBLIC                                  ::   ln_nnogather     = .FALSE.  ! 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
+
+   INTEGER FUNCTION lib_mpp_alloc( kumout )
+      !!----------------------------------------------------------------------
+      !!              ***  routine lib_mpp_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kumout   ! ocean.output logical unit
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE( t4ns(jpi,jprecj,jpk,2,2) , t4sn(jpi,jprecj,jpk,2,2) ,                                            &
+         &      t4ew(jpj,jpreci,jpk,2,2) , t4we(jpj,jpreci,jpk,2,2) ,                                            &
+         &      t4p1(jpi,jprecj,jpk,2,2) , t4p2(jpi,jprecj,jpk,2,2) ,                                            &
+         &      t3ns(jpi,jprecj,jpk,2)   , t3sn(jpi,jprecj,jpk,2)   ,                                            &
+         &      t3ew(jpj,jpreci,jpk,2)   , t3we(jpj,jpreci,jpk,2)   ,                                            &
+         &      t3p1(jpi,jprecj,jpk,2)   , t3p2(jpi,jprecj,jpk,2)   ,                                            &
+         &      t2ns(jpi,jprecj    ,2)   , t2sn(jpi,jprecj    ,2)   ,                                            &
+         &      t2ew(jpj,jpreci    ,2)   , t2we(jpj,jpreci    ,2)   ,                                            &
+         &      t2p1(jpi,jprecj    ,2)   , t2p2(jpi,jprecj    ,2)   ,                                            &
+         !
+         &      tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) ,                                                     &
+         &      tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         &      tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) ,                                                     &
+         !
+         &      ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) ,                        &
+         &      zfoldwk(jpi,4,jpk) ,                                                                             &
+         !
+         &      ztab_2d(jpiglo,4)  , znorthloc_2d(jpi,4)  , znorthgloio_2d(jpi,4,jpni)  ,                        &
+         &      zfoldwk_2d(jpi,4)  ,                                                                             &
+         !
+         &      ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) ,   &
+         !
+         &      STAT=lib_mpp_alloc )
+         !
+      IF( lib_mpp_alloc /= 0 ) THEN
+         WRITE(kumout,cform_war)
+         WRITE(kumout,*) 'lib_mpp_alloc : failed to allocate arrays'
+      ENDIF
+      !
+   END FUNCTION lib_mpp_alloc
+
+
+   FUNCTION mynode( ldtxt, kumnam, kstop, localComm )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mynode  ***
+      !!                    
+      !! ** Purpose :   Find processor unit
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(in   ) ::   kumnam       ! namelist logical unit 
+      INTEGER                      , INTENT(inout) ::   kstop        ! stop indicator 
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      !
+      INTEGER ::   mynode, ierr, code, ji, ii
+      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
+      !
+      jpni = -1; jpnj = -1; jpnij = -1
+      REWIND( kumnam )               ! Namelist namrun : parameters of the run
+      READ  ( kumnam, nammpp )
+      !                              ! control print
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
+
+#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 
+
+      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
+      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
+      mynode = mpprank
+      ! 
+      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
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING ptab is defined only between nld and nle
+         DO jk = 1, jpk
+            DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+               ptab(nldi  :nlei  , jj          ,jk) = ptab(nldi:nlei,     nlej,jk)   
+               ptab(1     :nldi-1, jj          ,jk) = ptab(nldi     ,     nlej,jk)
+               ptab(nlei+1:nlci  , jj          ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+            DO ji = nlci+1, jpi                 ! added column(s) (full)
+               ptab(ji           ,nldj  :nlej  ,jk) = ptab(     nlei,nldj:nlej,jk)
+               ptab(ji           ,1     :nldj-1,jk) = ptab(     nlei,nldj     ,jk)
+               ptab(ji           ,nlej+1:jpj   ,jk) = ptab(     nlei,     nlej,jk)
+            END DO
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment 
+         !
+         !                                   ! East-West boundaries
+         !                                        !* Cyclic east-west
+         IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            ptab( 1 ,:,:) = ptab(jpim1,:,:)
+            ptab(jpi,:,:) = ptab(  2  ,:,:)
+         ELSE                                     !* closed
+            IF( .NOT. cd_type == 'F' )   ptab(     1       :jpreci,:,:) = zland    ! south except F-point
+                                         ptab(nlci-jpreci+1:jpi   ,:,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+         IF( .NOT. cd_type == 'F' )   ptab(:,     1       :jprecj,:) = zland       ! south except F-point
+                                      ptab(:,nlcj-jprecj+1:jpj   ,:) = zland       ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)
+            t3we(:,jl,:,1) = ptab(iihom +jl,:,:)
+         END DO
+      END SELECT  
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t3ew(1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t3we(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, t3ew(1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t3we(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,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+            ptab(iihom+jl,:,:) = t3ew(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab(jl      ,:,:) = t3we(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)
+            t3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t3ns(1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t3sn(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, t3ns(1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t3sn(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,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab(:,jl      ,:) = t3sn(:,jl,:,2)
+            ptab(:,ijhom+jl,:) = t3ns(:,jl,:,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab(:,jl,:) = t3sn(:,jl,:,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( ptab, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( ptab, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d
+
+
+   SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d     ! 2D array on which the boundary condition is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type  ! define the nature of ptab array grid-points
+      !                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the north fold boundary
+      !                                                         ! =  1. , the sign is kept
+      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
+      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval     ! background value (used at closed boundaries)
+      !!
+      INTEGER  ::   ji, jj, jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      REAL(wp) ::   zland
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
+      ELSE                         ;   zland = 0.e0      ! zero by default
+      ENDIF
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !
+      IF( PRESENT( cd_mpp ) ) THEN      ! only fill added line/raw with existing values
+         !
+         ! WARNING pt2d is defined only between nld and nle
+         DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
+            pt2d(nldi  :nlei  , jj          ) = pt2d(nldi:nlei,     nlej)   
+            pt2d(1     :nldi-1, jj          ) = pt2d(nldi     ,     nlej)
+            pt2d(nlei+1:nlci  , jj          ) = pt2d(     nlei,     nlej)
+         END DO
+         DO ji = nlci+1, jpi                 ! added column(s) (full)
+            pt2d(ji           ,nldj  :nlej  ) = pt2d(     nlei,nldj:nlej)
+            pt2d(ji           ,1     :nldj-1) = pt2d(     nlei,nldj     )
+            pt2d(ji           ,nlej+1:jpj   ) = pt2d(     nlei,     nlej)
+         END DO
+         !
+      ELSE                              ! standard close or cyclic treatment 
+         !
+         !                                   ! East-West boundaries
+         IF( nbondi == 2 .AND.   &                ! Cyclic east-west
+            &    (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+            pt2d( 1 ,:) = pt2d(jpim1,:)                                    ! west
+            pt2d(jpi,:) = pt2d(  2  ,:)                                    ! east
+         ELSE                                     ! closed
+            IF( .NOT. cd_type == 'F' )   pt2d(     1       :jpreci,:) = zland    ! south except F-point
+                                         pt2d(nlci-jpreci+1:jpi   ,:) = zland    ! north
+         ENDIF
+         !                                   ! North-South boundaries (always closed)
+            IF( .NOT. cd_type == 'F' )   pt2d(:,     1       :jprecj) = zland    !south except F-point
+                                         pt2d(:,nlcj-jprecj+1:jpj   ) = zland    ! north
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            t2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+         CALL mpprecv( 2, t2we(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, t2ew(1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t2we(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,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+            pt2d(iihom+jl,:) = t2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            pt2d(jl      ,:) = t2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj
+         DO jl = 1, jprecj
+            t2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            t2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+         CALL mpprecv( 4, t2sn(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, t2ns(1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t2sn(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) = t2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+            pt2d(:,ijhom+jl) = t2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, jprecj
+            pt2d(:,jl      ) = t2sn(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      !
+      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd      ( pt2d, cd_type, psgn )   ! only 1 northern proc, no mpp
+         CASE DEFAULT   ;   CALL mpp_lbc_north( pt2d, cd_type, psgn )   ! for all northern procs.
+         END SELECT
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_2d
+
+
+   SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_3d_gather  ***
+      !!
+      !! ** Purpose :   Message passing manadgement for two 3D arrays
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !! ** Action  :   ptab1 and ptab2  with update value at its periphery
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab1     ! first and second 3D array on which 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptab2     ! the boundary condition is applied
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1  ! nature of ptab1 and ptab2 arrays 
+      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type2  ! i.e. grid-points = T , U , V , F or W points
+      REAL(wp)                        , INTENT(in   ) ::   psgn      ! =-1 the sign change across the north fold boundary
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         ptab1( 1 ,:,:) = ptab1(jpim1,:,:)
+         ptab1(jpi,:,:) = ptab1(  2  ,:,:)
+         ptab2( 1 ,:,:) = ptab2(jpim1,:,:)
+         ptab2(jpi,:,:) = ptab2(  2  ,:,:)
+      ELSE                                        !* closed
+         IF( .NOT. cd_type1 == 'F' )   ptab1(     1       :jpreci,:,:) = 0.e0    ! south except at F-point
+         IF( .NOT. cd_type2 == 'F' )   ptab2(     1       :jpreci,:,:) = 0.e0
+                                       ptab1(nlci-jpreci+1:jpi   ,:,:) = 0.e0    ! north
+                                       ptab2(nlci-jpreci+1:jpi   ,:,:) = 0.e0
+      ENDIF
+
+      
+      !                                      ! North-South boundaries
+      IF( .NOT. cd_type1 == 'F' )   ptab1(:,     1       :jprecj,:) = 0.e0    ! south except at F-point
+      IF( .NOT. cd_type2 == 'F' )   ptab2(:,     1       :jprecj,:) = 0.e0
+                                    ptab1(:,nlcj-jprecj+1:jpj   ,:) = 0.e0    ! north
+                                    ptab2(:,nlcj-jprecj+1:jpj   ,:) = 0.e0
+
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci
+         DO jl = 1, jpreci
+            t4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:)
+            t4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:)
+            t4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:)
+            t4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = jpreci * jpj * jpk *2
+      !
+      SELECT CASE ( nbondi ) 
+      CASE ( -1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, t4we(1,1,1,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, t4ew(1,1,1,1,2), imigr, noea )
+         CALL mpprecv( 2, t4we(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, t4ew(1,1,1,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, t4we(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,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab1(iihom+jl,:,:) = t4ew(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+            ptab2(iihom+jl,:,:) = t4ew(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jpreci
+            ptab1(jl      ,:,:) = t4we(:,jl,:,1,2)
+            ptab2(jl      ,:,:) = t4we(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj - nrecj
+         DO jl = 1, jprecj
+            t4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:)
+            t4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:)
+            t4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:)
+            t4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = jprecj * jpi * jpk * 2
+      !
+      SELECT CASE ( nbondj )     
+      CASE ( -1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, t4sn(1,1,1,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, t4ns(1,1,1,1,2), imigr, nono )
+         CALL mpprecv( 4, t4sn(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, t4ns(1,1,1,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, t4sn(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,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 0 ) 
+         DO jl = 1, jprecj
+            ptab1(:,jl      ,:) = t4sn(:,jl,:,1,2)
+            ptab1(:,ijhom+jl,:) = t4ns(:,jl,:,1,2)
+            ptab2(:,jl      ,:) = t4sn(:,jl,:,2,2)
+            ptab2(:,ijhom+jl,:) = t4ns(:,jl,:,2,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, jprecj
+            ptab1(:,jl,:) = t4sn(:,jl,:,1,2)
+            ptab2(:,jl,:) = t4sn(:,jl,:,2,2)
+         END DO
+      END SELECT
+
+
+      ! 4. north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )                                           
+            CALL lbc_nfd      ( ptab1, cd_type1, psgn )   ! only for northern procs.
+            CALL lbc_nfd      ( ptab2, cd_type2, psgn )
+         CASE DEFAULT
+            CALL mpp_lbc_north( ptab1, cd_type1, psgn )   ! for all northern procs.
+            CALL mpp_lbc_north (ptab2, cd_type2, psgn)
+         END SELECT 
+         !
+      ENDIF
+      !
+   END SUBROUTINE mpp_lnk_3d_gather
+
+
+   SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mpp_lnk_2d_e  ***
+      !!                  
+      !! ** Purpose :   Message passing manadgement for 2d array (with halo)
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
+      !!      between processors following neighboring subdomains.
+      !!            domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    jpr2di : number of rows for extra outer halo
+      !!                    jpr2dj : number of columns for extra outer halo
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points
+      !                                                                                         ! = T , U , V , F , W and I points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! =-1 the sign change across the
+      !!                                                                                        ! north boundary, =  1. otherwise
+      INTEGER  ::   jl   ! dummy loop indices
+      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers
+      INTEGER  ::   ipreci, iprecj             ! temporary integers
+      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
+      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
+      !!----------------------------------------------------------------------
+
+      ipreci = jpreci + jpr2di      ! take into account outer extra 2D overlap area
+      iprecj = jprecj + jpr2dj
+
+
+      ! 1. standard boundary treatment
+      ! ------------------------------
+      ! Order matters Here !!!!
+      !
+      !                                      !* North-South boundaries (always colsed)
+      IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jpr2dj   :  jprecj  ) = 0.e0    ! south except at F-point
+                                   pt2d(:,nlcj-jprecj+1:jpj+jpr2dj) = 0.e0    ! north
+                                
+      !                                      ! East-West boundaries
+      !                                           !* Cyclic east-west
+      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN
+         pt2d(1-jpr2di:     1    ,:) = pt2d(jpim1-jpr2di:  jpim1 ,:)       ! east
+         pt2d(   jpi  :jpi+jpr2di,:) = pt2d(     2      :2+jpr2di,:)       ! west
+         !
+      ELSE                                        !* closed
+         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpr2di   :jpreci    ,:) = 0.e0    ! south except at F-point
+                                      pt2d(nlci-jpreci+1:jpi+jpr2di,:) = 0.e0    ! north
+      ENDIF
+      !
+
+      ! north fold treatment
+      ! -----------------------
+      IF( npolj /= 0 ) THEN
+         !
+         SELECT CASE ( jpni )
+         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj )
+         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               )
+         END SELECT 
+         !
+      ENDIF
+
+      ! 2. East and west directions exchange
+      ! ------------------------------------
+      ! we play with the neigbours AND the row number because of the periodicity 
+      !
+      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
+      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
+         iihom = nlci-nreci-jpr2di
+         DO jl = 1, ipreci
+            tr2ew(:,jl,1) = pt2d(jpreci+jl,:)
+            tr2we(:,jl,1) = pt2d(iihom +jl,:)
+         END DO
+      END SELECT
+      !
+      !                           ! Migrations
+      imigr = ipreci * ( jpj + 2*jpr2dj)
+      !
+      SELECT CASE ( nbondi )
+      CASE ( -1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )
+         CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,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, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )
+         CALL mpprecv( 2, tr2we(1-jpr2dj,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,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+            pt2d( iihom+jl,:) = tr2ew(:,jl,2)
+         END DO
+      CASE ( 1 )
+         DO jl = 1, ipreci
+            pt2d(jl-jpr2di,:) = tr2we(:,jl,2)
+         END DO
+      END SELECT
+
+
+      ! 3. North and south directions
+      ! -----------------------------
+      ! always closed : we play only with the neigbours
+      !
+      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
+         ijhom = nlcj-nrecj-jpr2dj
+         DO jl = 1, iprecj
+            tr2sn(:,jl,1) = pt2d(:,ijhom +jl)
+            tr2ns(:,jl,1) = pt2d(:,jprecj+jl)
+         END DO
+      ENDIF
+      !
+      !                           ! Migrations
+      imigr = iprecj * ( jpi + 2*jpr2di )
+      !
+      SELECT CASE ( nbondj )
+      CASE ( -1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)
+      CASE ( 0 )
+         CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )
+         CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,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, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )
+         CALL mpprecv( 4, tr2sn(1-jpr2di,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) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 0 )
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+            pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)
+         END DO
+      CASE ( 1 ) 
+         DO jl = 1, iprecj
+            pt2d(:,jl-jpr2dj) = tr2sn(:,jl,2)
+         END DO
+      END SELECT
+
+   END SUBROUTINE mpp_lnk_2d_e
+
+
+   SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsend  ***
+      !!                   
+      !! ** Purpose :   Send messag passing array
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(inout) ::   pmess(*)   ! array of real
+      INTEGER , INTENT(in   ) ::   kbytes     ! size of the array pmess
+      INTEGER , INTENT(in   ) ::   kdest      ! receive process number
+      INTEGER , INTENT(in   ) ::   ktyp       ! tag of the message
+      INTEGER , INTENT(in   ) ::   md_req     ! argument for isend
+      !!
+      INTEGER ::   iflag
+      !!----------------------------------------------------------------------
+      !
+      SELECT CASE ( cn_mpi_send )
+      CASE ( 'S' )                ! Standard mpi send (blocking)
+         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'B' )                ! Buffer mpi send (blocking)
+         CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag )
+      CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+         ! be carefull, one more argument here : the mpi request identifier..
+         CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa, md_req, iflag )
+      END SELECT
+      !
+   END SUBROUTINE mppsend
+
+
+   SUBROUTINE mpprecv( ktyp, pmess, kbytes, 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)) then
+         use_source=ksource
+      end if
+
+      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 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
+
+      !! * Local variables   (MPI version)
+      INTEGER  ::    ierror
+      INTEGER  ::   localcomm
+      COMPLEX(wp) :: zwork
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      ! reduce local sums into global sum
+      CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab = zwork
+
+   END SUBROUTINE mppsum_realdd
+  
+  
+   SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsum_a_realdd  ***
+      !!
+      !! ** Purpose :   global sum in Massively Parallel Processing
+      !!                COMPLEX ARRAY case for double-double precision
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER , INTENT( in )                        ::   kdim      ! size of ytab
+      COMPLEX(wp), DIMENSION(kdim), INTENT( inout ) ::   ytab      ! input array
+      INTEGER , INTENT( in  ), OPTIONAL :: kcom
+
+      !! * Local variables   (MPI version)
+      INTEGER                      :: ierror    ! temporary integer
+      INTEGER                      ::   localcomm
+      COMPLEX(wp), DIMENSION(kdim) :: zwork     ! temporary workspace
+
+      localcomm = mpi_comm_opa
+      IF( PRESENT(kcom) ) localcomm = kcom
+
+      CALL MPI_ALLREDUCE (ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, &
+                       MPI_SUMDD,localcomm,ierror)
+      ytab(:) = zwork(:)
+
+   END SUBROUTINE mppsum_a_realdd
+   
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab    ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask   ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmin    ! Global minimum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of minimum in global frame
+      !!
+      INTEGER , DIMENSION(2)   ::   ilocs
+      INTEGER :: ierror
+      REAL(wp) ::   zmin   ! local minimum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kj = INT(zaout(2,1)/10000.)
+      ki = INT(zaout(2,1) - 10000.*kj )
+      !
+   END SUBROUTINE mpp_minloc2d
+
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj ,kk)
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_minloc  ***
+      !!
+      !! ** Purpose :   Compute the global minimum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmin         ! Global minimum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of minimum in global frame
+      !!
+      INTEGER  ::   ierror
+      REAL(wp) ::   zmin     ! local minimum
+      INTEGER , DIMENSION(3)   ::   ilocs
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmin  = MINVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmin
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror)
+      !
+      pmin = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_minloc3d
+
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :   Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method  :   Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   ptab     ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj), INTENT(in   ) ::   pmask    ! Local mask
+      REAL(wp)                     , INTENT(  out) ::   pmax     ! Global maximum of ptab
+      INTEGER                      , INTENT(  out) ::   ki, kj   ! index of maximum in global frame
+      !!  
+      INTEGER  :: ierror
+      INTEGER, DIMENSION (2)   ::   ilocs
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      !
+      zain(1,:) = zmax
+      zain(2,:) = ki + 10000. * kj
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kj   = INT( zaout(2,1) / 10000.     )
+      ki   = INT( zaout(2,1) - 10000.* kj )
+      !
+   END SUBROUTINE mpp_maxloc2d
+
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      !!------------------------------------------------------------------------
+      !!             ***  routine mpp_maxloc  ***
+      !!
+      !! ** Purpose :  Compute the global maximum of an array ptab
+      !!              and also give its global position
+      !!
+      !! ** Method : Use MPI_ALLREDUCE with MPI_MINLOC
+      !!
+      !!--------------------------------------------------------------------------
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   ptab         ! Local 2D array
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pmask        ! Local mask
+      REAL(wp)                         , INTENT(  out) ::   pmax         ! Global maximum of ptab
+      INTEGER                          , INTENT(  out) ::   ki, kj, kk   ! index of maximum in global frame
+      !!   
+      REAL(wp) :: zmax   ! local maximum
+      REAL(wp), DIMENSION(2,1) ::   zain, zaout
+      INTEGER , DIMENSION(3)   ::   ilocs
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      zmax  = MAXVAL( ptab(:,:,:) , mask= pmask == 1.e0 )
+      ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1.e0 )
+      !
+      ki = ilocs(1) + nimpp - 1
+      kj = ilocs(2) + njmpp - 1
+      kk = ilocs(3)
+      !
+      zain(1,:)=zmax
+      zain(2,:)=ki+10000.*kj+100000000.*kk
+      !
+      CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror)
+      !
+      pmax = zaout(1,1)
+      kk   = INT( zaout(2,1) / 100000000. )
+      kj   = INT( zaout(2,1) - kk * 100000000. ) / 10000
+      ki   = INT( zaout(2,1) - kk * 100000000. -kj * 10000. )
+      !
+   END SUBROUTINE mpp_maxloc3d
+
+
+   SUBROUTINE mppsync()
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppsync  ***
+      !!                   
+      !! ** Purpose :   Massively parallel processors, synchroneous
+      !!
+      !!-----------------------------------------------------------------------
+      INTEGER :: ierror
+      !!-----------------------------------------------------------------------
+      !
+      CALL mpi_barrier( mpi_comm_opa, ierror )
+      !
+   END SUBROUTINE mppsync
+
+
+   SUBROUTINE mppstop
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppstop  ***
+      !!                   
+      !! ** purpose :   Stop massively parallel processors method
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER ::   info
+      !!----------------------------------------------------------------------
+      !
+      CALL mppsync
+      CALL mpi_finalize( info )
+      !
+   END SUBROUTINE mppstop
+
+
+   SUBROUTINE mppobc( ptab, kd1, kd2, kl, kk, ktype, kij , kumout)
+      !!----------------------------------------------------------------------
+      !!                  ***  routine mppobc  ***
+      !! 
+      !! ** Purpose :   Message passing manadgement for open boundary
+      !!     conditions array
+      !!
+      !! ** Method  :   Use mppsend and mpprecv function for passing mask
+      !!       between processors following neighboring subdomains.
+      !!       domain parameters
+      !!                    nlci   : first dimension of the local subdomain
+      !!                    nlcj   : second dimension of the local subdomain
+      !!                    nbondi : mark for "east-west local boundary"
+      !!                    nbondj : mark for "north-south local boundary"
+      !!                    noea   : number for local neighboring processors 
+      !!                    nowe   : number for local neighboring processors
+      !!                    noso   : number for local neighboring processors
+      !!                    nono   : number for local neighboring processors
+      !!
+      !!----------------------------------------------------------------------
+      USE wrk_nemo        ! Memory allocation
+      !
+      INTEGER , INTENT(in   )                     ::   kd1, kd2   ! starting and ending indices
+      INTEGER , INTENT(in   )                     ::   kl         ! index of open boundary
+      INTEGER , INTENT(in   )                     ::   kk         ! vertical dimension
+      INTEGER , INTENT(in   )                     ::   ktype      ! define north/south or east/west cdt
+      !                                                           !  = 1  north/south  ;  = 2  east/west
+      INTEGER , INTENT(in   )                     ::   kij        ! horizontal dimension
+      INTEGER , INTENT(in   )                     ::   kumout     ! ocean.output logical unit
+      REAL(wp), INTENT(inout), DIMENSION(kij,kk)  ::   ptab       ! variable array
+      !
+      INTEGER ::   ji, jj, jk, jl        ! dummy loop indices
+      INTEGER ::   iipt0, iipt1, ilpt1   ! local integers
+      INTEGER ::   ijpt0, ijpt1          !   -       -
+      INTEGER ::   imigr, iihom, ijhom   !   -       -
+      INTEGER ::   ml_req1, ml_req2, ml_err    ! for key_mpi_isend
+      INTEGER ::   ml_stat(MPI_STATUS_SIZE)    ! for key_mpi_isend
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztab   ! temporary workspace
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, ztab )
+
+      ! boundary condition initialization
+      ! ---------------------------------
+      ztab(:,:) = 0.e0
+      !
+      IF( ktype==1 ) THEN                                  ! north/south boundaries
+         iipt0 = MAX( 1, MIN(kd1 - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kd2 - nimpp+1, nlci - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - nimpp+1, nlci     ) )
+         ijpt0 = MAX( 1, MIN(kl  - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kl  - njmpp+1, nlcj - 1 ) )
+      ELSEIF( ktype==2 ) THEN                              ! east/west boundaries
+         iipt0 = MAX( 1, MIN(kl  - nimpp+1, nlci     ) )
+         iipt1 = MAX( 0, MIN(kl  - nimpp+1, nlci - 1 ) )
+         ijpt0 = MAX( 1, MIN(kd1 - njmpp+1, nlcj     ) )
+         ijpt1 = MAX( 0, MIN(kd2 - njmpp+1, nlcj - 1 ) )
+         ilpt1 = MAX( 1, MIN(kd2 - njmpp+1, nlcj     ) )
+      ELSE
+         WRITE(kumout, cform_err)
+         WRITE(kumout,*) 'mppobc : bad ktype'
+         CALL mppstop
+      ENDIF
+      
+      ! Communication level by level
+      ! ----------------------------
+!!gm Remark : this is very time consumming!!!
+      !                                         ! ------------------------ !
+      DO jk = 1, kk                             !   Loop over the levels   !
+         !                                      ! ------------------------ !
+         !
+         IF( ktype == 1 ) THEN                               ! north/south boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(ji,jk)
+               END DO
+            END DO
+         ELSEIF( ktype == 2 ) THEN                           ! east/west boundaries
+            DO jj = ijpt0, ijpt1
+               DO ji = iipt0, iipt1
+                  ztab(ji,jj) = ptab(jj,jk)
+               END DO
+            END DO
+         ENDIF
+
+
+         ! 1. East and west directions
+         ! ---------------------------
+         !
+         IF( nbondi /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            iihom = nlci-nreci
+            DO jl = 1, jpreci
+               t2ew(:,jl,1) = ztab(jpreci+jl,:)
+               t2we(:,jl,1) = ztab(iihom +jl,:)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr=jpreci*jpj
+         !
+         IF( nbondi == -1 ) THEN
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            IF(l_isend)   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondi == 0 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, t2ew(1,1,2), imigr, noea )
+            CALL mpprecv( 2, t2we(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 )
+         ELSEIF( nbondi == 1 ) THEN
+            CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, t2we(1,1,2), imigr, nowe )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         iihom = nlci-jpreci
+         !
+         IF( nbondi == 0 .OR. nbondi == 1 ) THEN
+            DO jl = 1, jpreci
+               ztab(jl,:) = t2we(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondi == -1 .OR. nbondi == 0 ) THEN
+            DO jl = 1, jpreci
+               ztab(iihom+jl,:) = t2ew(:,jl,2)
+            END DO
+         ENDIF
+
+
+         ! 2. North and south directions
+         ! -----------------------------
+         !
+         IF( nbondj /= 2 ) THEN         ! Read Dirichlet lateral conditions
+            ijhom = nlcj-nrecj
+            DO jl = 1, jprecj
+               t2sn(:,jl,1) = ztab(:,ijhom +jl)
+               t2ns(:,jl,1) = ztab(:,jprecj+jl)
+            END DO
+         ENDIF
+         !
+         !                              ! Migrations
+         imigr = jprecj * jpi
+         !
+         IF( nbondj == -1 ) THEN
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ELSEIF( nbondj == 0 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, t2ns(1,1,2), imigr, nono )
+            CALL mpprecv( 4, t2sn(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 )
+         ELSEIF( nbondj == 1 ) THEN
+            CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, t2sn(1,1,2), imigr, noso)
+            IF( l_isend )   CALL mpi_wait( ml_req1, ml_stat, ml_err )
+         ENDIF
+         !
+         !                              ! Write Dirichlet lateral conditions
+         ijhom = nlcj - jprecj
+         IF( nbondj == 0 .OR. nbondj == 1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,jl) = t2sn(:,jl,2)
+            END DO
+         ENDIF
+         IF( nbondj == 0 .OR. nbondj == -1 ) THEN
+            DO jl = 1, jprecj
+               ztab(:,ijhom+jl) = t2ns(:,jl,2)
+            END DO
+         ENDIF
+         IF( ktype==1 .AND. kd1 <= jpi+nimpp-1 .AND. nimpp <= kd2 ) THEN
+            DO jj = ijpt0, ijpt1            ! north/south boundaries
+               DO ji = iipt0,ilpt1
+                  ptab(ji,jk) = ztab(ji,jj)  
+               END DO
+            END DO
+         ELSEIF( ktype==2 .AND. kd1 <= jpj+njmpp-1 .AND. njmpp <= kd2 ) THEN
+            DO jj = ijpt0, ilpt1            ! east/west boundaries
+               DO ji = iipt0,iipt1
+                  ptab(jj,jk) = ztab(ji,jj) 
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj, ztab )
+      !
+   END SUBROUTINE mppobc
+   
+
+   SUBROUTINE mpp_comm_free( kcom )
+      !!----------------------------------------------------------------------
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kcom
+      !!
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      CALL MPI_COMM_FREE(kcom, ierr)
+      !
+   END SUBROUTINE mpp_comm_free
+
+
+   SUBROUTINE mpp_ini_ice( pindic, 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
+      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
+      !!----------------------------------------------------------------------
+      !   
+      ijpj   = 4
+      ityp = -1
+      ijpjm1 = 3
+      ztab(:,:,:) = 0.e0
+      !
+      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d
+         ij = jj - nlcj + ijpj
+         znorthloc(:,ij,:) = pt3d(:,jj,:)
+      END DO
+      !
+      !                                     ! Build in procs of ncomm_north the znorthgloio
+      itaille = jpi * jpk * ijpj
+      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
+         !
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+            DO ji = 1, nlci
+               ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)
+            END DO
+         END DO
+
+         !
+         ! Set the exchange type in order to access the correct list of active neighbours
+         !
+         SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )
+               ityp = 1
+            CASE ( 'U' )
+               ityp = 2
+            CASE ( 'V' )
+               ityp = 3
+            CASE ( 'F' )
+               ityp = 4
+            CASE ( 'I' )
+               ityp = 5
+            CASE DEFAULT
+               ityp = -1                    ! Set a default value for unsupported types which 
+                                            ! will cause a fallback to the mpi_allgather method
+         END SELECT
+         IF ( ityp .gt. 0 ) THEN
+
+            DO jr = 1,nsndto(ityp)
+               CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+            END DO
+            DO jr = 1,nsndto(ityp)
+               CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))
+               iproc = isendto(jr,ityp) + 1
+               ildi = nldit (iproc)
+               ilei = nleit (iproc)
+               iilb = nimppt(iproc)
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                     ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)
+                  END DO
+               END DO
+            END DO
+            IF (l_isend) THEN
+               DO jr = 1,nsndto(ityp)
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               END DO
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                &
+            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )
+         !
+         DO jr = 1, ndim_rank_north         ! recover the global north array
+            iproc = nrank_north(jr) + 1
+            ildi  = nldit (iproc)
+            ilei  = nleit (iproc)
+            iilb  = nimppt(iproc)
+            DO jj = 1, ijpj
+               DO ji = ildi, ilei
+                  ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)
+               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.
+      !
+      CALL lbc_nfd( ztab, cd_type, psgn )   ! North fold boundary condition
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d
+         ij = jj - nlcj + ijpj
+         DO ji= 1, nlci
+            pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_3d
+
+
+   SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 (for 2d array )
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4 northern lines of the global domain on 1 processor
+      !!              and apply lbc north-fold on this sub array. Then we
+      !!              scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the b.c. is applied
+      CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
+      !                                                          !   = T ,  U , V , F or W  gridpoints
+      REAL(wp)                    , INTENT(in   ) ::   psgn      ! = -1. the sign change across the north fold 
+      !!                                                             ! =  1. , the sign is kept
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ijpjm1, ij, iproc
+      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
+      !!----------------------------------------------------------------------
+      !
+      ijpj   = 4
+      ityp = -1
+      ijpjm1 = 3
+      ztab_2d(:,:) = 0.e0
+      !
+      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc_2d the last 4 jlines of pt2d
+         ij = jj - nlcj + ijpj
+         znorthloc_2d(:,ij) = pt2d(:,jj)
+      END DO
+
+      !                                     ! Build in procs of ncomm_north the znorthgloio_2d
+      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
+         !
+         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array
+            ij = jj - nlcj + ijpj
+            DO ji = 1, nlci
+               ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)
+            END DO
+         END DO
+
+         !
+         ! Set the exchange type in order to access the correct list of active neighbours
+         !
+         SELECT CASE ( cd_type )
+            CASE ( 'T' , 'W' )
+               ityp = 1
+            CASE ( 'U' )
+               ityp = 2
+            CASE ( 'V' )
+               ityp = 3
+            CASE ( 'F' )
+               ityp = 4
+            CASE ( 'I' )
+               ityp = 5
+            CASE DEFAULT
+               ityp = -1                    ! Set a default value for unsupported types which 
+                                            ! will cause a fallback to the mpi_allgather method
+         END SELECT
+
+         IF ( ityp .gt. 0 ) THEN
+
+            DO jr = 1,nsndto(ityp)
+               CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )
+            END DO
+            DO jr = 1,nsndto(ityp)
+               CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))
+               iproc = isendto(jr,ityp) + 1
+               ildi = nldit (iproc)
+               ilei = nleit (iproc)
+               iilb = nimppt(iproc)
+               DO jj = 1, ijpj
+                  DO ji = ildi, ilei
+                     ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)
+                  END DO
+               END DO
+            END DO
+            IF (l_isend) THEN
+               DO jr = 1,nsndto(ityp)
+                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)
+               END DO
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+      IF ( ityp .lt. 0 ) THEN
+         CALL MPI_ALLGATHER( znorthloc_2d  , itaille, MPI_DOUBLE_PRECISION,        &
+            &                znorthgloio_2d, 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
+               DO ji = ildi, ilei
+                  ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)
+               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.
+      !
+      CALL lbc_nfd( ztab_2d, 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_2d(ji+nimpp-1,ij)
+         END DO
+      END DO
+      !
+   END SUBROUTINE mpp_lbc_north_2d
+
+
+   SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn)
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_lbc_north_2d  ***
+      !!
+      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
+      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
+      !!              array with outer extra halo
+      !!
+      !! ** Method  :   North fold condition and mpp with more than one proc
+      !!              in i-direction require a specific treatment. We gather 
+      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
+      !!              processor and apply lbc north-fold on this sub array. 
+      !!              Then we scatter the north fold array back to the processors.
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo
+      CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points
+      !                                                                                         !   = T ,  U , V , F or W -points
+      REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! = -1. the sign change across the  
+      !!                                                                                        ! north fold, =  1. otherwise
+      INTEGER ::   ji, jj, jr
+      INTEGER ::   ierr, itaille, ildi, ilei, iilb
+      INTEGER ::   ijpj, ij, iproc
+      !!----------------------------------------------------------------------
+      !
+      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
+      !
+   END SUBROUTINE mpp_lbc_north_e
+
+
+   SUBROUTINE mpi_init_opa( ldtxt, ksft, code )
+      !!---------------------------------------------------------------------
+      !!                   ***  routine mpp_init.opa  ***
+      !!
+      !! ** Purpose :: export and attach a MPI buffer for bsend
+      !!
+      !! ** Method  :: define buffer size in namelist, if 0 no buffer attachment
+      !!            but classical mpi_init
+      !! 
+      !! History :: 01/11 :: IDRIS initial version for IBM only  
+      !!            08/04 :: R. Benshila, generalisation
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
+      !!---------------------------------------------------------------------
+      !
+      CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
+      IF ( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+      !
+      IF( .NOT. mpi_was_called ) THEN
+         CALL mpi_init( code )
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
+         IF ( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_buffer > 0 ) THEN
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
+         ! Buffer allocation and attachment
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF( ierr /= 0 ) THEN 
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
+      ENDIF
+      !
+   END SUBROUTINE mpi_init_opa
+
+   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
+
+#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 mppobc
+      MODULE PROCEDURE mppobc_1d, mppobc_2d, mppobc_3d, mppobc_4d
+   END INTERFACE
+   INTERFACE mpp_minloc
+      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d
+   END INTERFACE
+   INTERFACE mpp_maxloc
+      MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d
+   END INTERFACE
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_mpp = .FALSE.      !: mpp flag
+   LOGICAL, PUBLIC            ::   ln_nnogather  = .FALSE.  !: namelist control of northfold comms (needed here in case "key_mpp_mpi" is not used)
+   INTEGER :: ncomm_ice
+   !!----------------------------------------------------------------------
+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, kumnam, kstop, localComm ) RESULT (function_value)
+      INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
+      CHARACTER(len=*),DIMENSION(:) ::   ldtxt 
+      INTEGER ::   kumnam, kstop
+      IF( PRESENT( localComm ) .OR. .NOT.PRESENT( localComm ) )   function_value = 0
+      IF( .FALSE. )   ldtxt(:) = 'never done'
+   END FUNCTION mynode
+
+   SUBROUTINE mppsync                       ! Dummy routine
+   END SUBROUTINE mppsync
+
+   SUBROUTINE mpp_sum_as( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_as: You should not have seen this print! error?', kdim, parr(1), kcom
+   END SUBROUTINE mpp_sum_as
+
+   SUBROUTINE mpp_sum_a2s( parr, kdim, kcom )      ! Dummy routine
+      REAL   , DIMENSION(:,:) :: parr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_a2s: You should not have seen this print! error?', kdim, parr(1,1), kcom
+   END SUBROUTINE mpp_sum_a2s
+
+   SUBROUTINE mpp_sum_ai( karr, kdim, kcom )      ! Dummy routine
+      INTEGER, DIMENSION(:) :: karr
+      INTEGER               :: kdim
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_ai: You should not have seen this print! error?', kdim, karr(1), kcom
+   END SUBROUTINE mpp_sum_ai
+
+   SUBROUTINE mpp_sum_s( psca, kcom )            ! Dummy routine
+      REAL                  :: psca
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_s: You should not have seen this print! error?', psca, kcom
+   END SUBROUTINE mpp_sum_s
+
+   SUBROUTINE mpp_sum_i( kint, kcom )            ! Dummy routine
+      integer               :: kint
+      INTEGER, OPTIONAL     :: kcom 
+      WRITE(*,*) 'mpp_sum_i: You should not have seen this print! error?', kint, kcom
+   END SUBROUTINE mpp_sum_i
+
+   SUBROUTINE 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 mppobc_1d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_1d
+
+   SUBROUTINE mppobc_2d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_2d
+
+   SUBROUTINE mppobc_3d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_3d
+
+   SUBROUTINE mppobc_4d( parr, kd1, kd2, kl, kk, ktype, kij, knum )
+      INTEGER  ::   kd1, kd2, kl , kk, ktype, kij, knum
+      REAL, DIMENSION(:,:,:,:) ::   parr           ! variable array
+      WRITE(*,*) 'mppobc: You should not have seen this print! error?', parr(1,1,1,1), kd1, kd2, kl, kk, ktype, kij, knum
+   END SUBROUTINE mppobc_4d
+
+   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj )
+      REAL                   :: pmin
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_minloc2d: You should not have seen this print! error?', pmin, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_minloc2d
+
+   SUBROUTINE mpp_minloc3d( ptab, pmask, pmin, ki, kj, kk )
+      REAL                     :: pmin
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_minloc3d: You should not have seen this print! error?', pmin, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_minloc3d
+
+   SUBROUTINE mpp_maxloc2d( ptab, pmask, pmax, ki, kj )
+      REAL                   :: pmax
+      REAL , DIMENSION (:,:) :: ptab, pmask
+      INTEGER :: ki, kj
+      WRITE(*,*) 'mpp_maxloc2d: You should not have seen this print! error?', pmax, ki, kj, ptab(1,1), pmask(1,1)
+   END SUBROUTINE mpp_maxloc2d
+
+   SUBROUTINE mpp_maxloc3d( ptab, pmask, pmax, ki, kj, kk )
+      REAL                     :: pmax
+      REAL , DIMENSION (:,:,:) :: ptab, pmask
+      INTEGER :: ki, kj, kk
+      WRITE(*,*) 'mpp_maxloc3d: You should not have seen this print! error?', pmax, ki, kj, kk, ptab(1,1,1), pmask(1,1,1)
+   END SUBROUTINE mpp_maxloc3d
+
+   SUBROUTINE mppstop
+      WRITE(*,*) 'mppstop: You should not have seen this print if running in mpp mode! error?...'
+      WRITE(*,*) 'mppstop: ..otherwise this is a stop condition raised by ctl_stop in single processor mode'
+      STOP
+   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   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
+         STOP 'ctl_opn bad opening'
+      ENDIF
+      
+   END SUBROUTINE ctl_opn
+
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90	(revision 3437)
@@ -0,0 +1,512 @@
+MODULE mppini
+   !!==============================================================================
+   !!                       ***  MODULE mppini   ***
+   !! Ocean initialization : distributed memory computing initialization
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   mpp_init       : Lay out the global domain over processors
+   !!   mpp_init2      : Lay out the global domain over processors 
+   !!                    with land processor elimination
+   !!   mpp_init_ioispl: IOIPSL initialization in mpp
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE dom_oce         ! ocean space and time domain 
+   USE in_out_manager  ! I/O Manager
+   USE lib_mpp         ! distribued memory computing library
+   USE ioipsl
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC mpp_init       ! called by opa.F90
+   PUBLIC mpp_init2      ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if ! defined key_mpp_mpi
+   !!----------------------------------------------------------------------
+   !!   Default option :                            shared memory computing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Shared memory computing, set the local processor
+      !!      variables to the value of the global domain
+      !!
+      !! History :
+      !!   9.0  !  04-01  (G. Madec, J.M. Molines)  F90 : free form, north fold jpni >1
+      !!----------------------------------------------------------------------
+
+      ! No mpp computation
+      nimpp  = 1
+      njmpp  = 1
+      nlci   = jpi
+      nlcj   = jpj
+      nldi   = 1
+      nldj   = 1
+      nlei   = jpi
+      nlej   = jpj
+      nperio = jperio
+      nbondi = 2
+      nbondj = 2
+      nidom  = FLIO_DOM_NONE
+      npolj = jperio
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'mpp_init(2) : NO massively parallel processing'
+         WRITE(numout,*) '~~~~~~~~~~~: '
+         WRITE(numout,*) '         nperio = ', nperio
+         WRITE(numout,*) '         npolj  = ', npolj
+         WRITE(numout,*) '         nimpp  = ', nimpp
+         WRITE(numout,*) '         njmpp  = ', njmpp
+      ENDIF
+
+      IF(  jpni /= 1 .OR. jpnj /= 1 .OR. jpnij /= 1 ) &
+          CALL ctl_stop( 'equality  jpni = jpnj = jpnij = 1 is not satisfied',   &
+          &              'the domain is lay out for distributed memory computing! ' )
+
+   END SUBROUTINE mpp_init
+
+
+   SUBROUTINE mpp_init2 
+      CALL mpp_init                             ! same routine as mpp_init
+   END SUBROUTINE mpp_init2
+
+#else
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_mpi'          OR         MPI massively parallel processing
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE mpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init  ***
+      !!                    
+      !! ** Purpose :   Lay out the global domain over processors.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action  : - set domain parameters
+      !!                    nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nbondi    : mark for "east-west local boundary"
+      !!                    nbondj    : mark for "north-south local boundary"
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   8.5  !  02-08  (G. Madec)  F90 : free form
+      !!   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
+      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
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           defines mpp subdomains'
+         WRITE(numout,*) '           ----------------------'
+         WRITE(numout,*) '           iresti=',iresti,' irestj=',irestj
+         WRITE(numout,*) '           jpni  =',jpni  ,' jpnj  =',jpnj
+         ifreq = 4
+         il1   = 1
+         DO jn = 1, (jpni-1)/ifreq+1
+            il2 = MIN( jpni, il1+ifreq-1 )
+            WRITE(numout,*)
+            WRITE(numout,9200) ('***',ji = il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9202) jj, ( ilcit(ji,jj),ilcjt(ji,jj),ji = il1,il2 )
+               WRITE(numout,9203) ('   ',ji = il1,il2-1)
+               WRITE(numout,9200) ('***',ji = il1,il2-1)
+            END DO
+            WRITE(numout,9201) (ji,ji = il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9200    FORMAT('     ***',20('*************',a3))
+ 9203    FORMAT('     *     ',20('         *   ',a3))
+ 9201    FORMAT('        ',20('   ',i3,'          '))
+ 9202    FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+      ENDIF
+
+      zidom = nreci
+      DO ji = 1, jpni
+         zidom = zidom + ilcit(ji,1) - nreci
+      END DO
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilcit(i,1) = ', zidom, ' jpiglo = ', jpiglo
+      
+      zjdom = nrecj
+      DO jj = 1, jpnj
+         zjdom = zjdom + ilcjt(1,jj) - nrecj
+      END DO
+      IF(lwp) WRITE(numout,*)' sum ilcit(1,j) = ', zjdom, ' jpjglo = ', jpjglo
+      IF(lwp) WRITE(numout,*)
+      
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+      
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      
+      IF( jpni > 1 ) THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilcit(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 ) THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1)+ilcjt(ji,jj-1)-nrecj
+            END DO
+         END DO
+      ENDIF
+      
+      ! 3. Subdomain description
+      ! ------------------------
+
+      DO jn = 1, jpnij
+         ii = 1 + MOD( jn-1, jpni )
+         ij = 1 + (jn-1) / jpni
+         nimppt(jn) = iimppt(ii,ij)
+         njmppt(jn) = ijmppt(ii,ij)
+         nlcit (jn) = ilcit (ii,ij)     
+         nlci       = nlcit (jn)     
+         nlcjt (jn) = ilcjt (ii,ij)     
+         nlcj       = nlcjt (jn)
+         nbondj = -1                                   ! general case
+         IF( jn   >  jpni          )   nbondj = 0      ! first row of processor
+         IF( jn   >  (jpnj-1)*jpni )   nbondj = 1      ! last  row of processor
+         IF( jpnj == 1             )   nbondj = 2      ! one processor only in j-direction
+         ibonjt(jn) = nbondj
+         
+         nbondi = 0                                    ! 
+         IF( MOD( jn, jpni ) == 1 )   nbondi = -1      !
+         IF( MOD( jn, jpni ) == 0 )   nbondi =  1      !
+         IF( jpni            == 1 )   nbondi =  2      ! one processor only in i-direction
+         ibonit(jn) = nbondi
+         
+         nldi =  1   + jpreci
+         nlei = nlci - jpreci
+         IF( nbondi == -1 .OR. nbondi == 2 )   nldi = 1
+         IF( nbondi ==  1 .OR. nbondi == 2 )   nlei = nlci
+         nldj =  1   + jprecj
+         nlej = nlcj - jprecj
+         IF( nbondj == -1 .OR. nbondj == 2 )   nldj = 1
+         IF( nbondj ==  1 .OR. nbondj == 2 )   nlej = nlcj
+         nldit(jn) = nldi
+         nleit(jn) = nlei
+         nldjt(jn) = nldj
+         nlejt(jn) = nlej
+      END DO
+      
+
+      ! 4. From global to local
+      ! -----------------------
+
+      nperio = 0
+      IF( jperio == 2 .AND. nbondj == -1 )   nperio = 2
+
+
+      ! 5. Subdomain neighbours
+      ! ----------------------
+
+      nproc = narea - 1
+      noso  = nproc - jpni
+      nowe  = nproc - 1
+      noea  = nproc + 1
+      nono  = nproc + jpni
+      ! great neighbours
+      npnw = nono - 1
+      npne = nono + 1
+      npsw = noso - 1
+      npse = noso + 1
+      nbsw = 1
+      nbnw = 1
+      IF( MOD( nproc, jpni ) == 0 ) THEN
+         nbsw = 0
+         nbnw = 0
+      ENDIF
+      nbse = 1
+      nbne = 1
+      IF( MOD( nproc, jpni ) == jpni-1 ) THEN
+         nbse = 0
+         nbne = 0
+      ENDIF
+      IF(nproc < jpni) THEN
+         nbsw = 0
+         nbse = 0
+      ENDIF
+      IF( nproc >= (jpnj-1)*jpni ) THEN
+         nbnw = 0
+         nbne = 0
+      ENDIF
+      nlcj = nlcjt(narea)  
+      nlci = nlcit(narea)  
+      nldi = nldit(narea)
+      nlei = nleit(narea)
+      nldj = nldjt(narea)
+      nlej = nlejt(narea)
+      nbondi = ibonit(narea)
+      nbondj = ibonjt(narea)
+      nimpp  = nimppt(narea)  
+      njmpp  = njmppt(narea)  
+
+     ! Save processor layout in layout.dat file 
+       IF (lwp) THEN
+        CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+        WRITE(inum,'(a)') '   jpnij     jpi     jpj     jpk  jpiglo  jpjglo'
+        WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+        WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jn = 1, jpnij
+         WRITE(inum,'(9i5)') jn, nlcit(jn), nlcjt(jn), &
+                                      nldit(jn), nldjt(jn), &
+                                      nleit(jn), nlejt(jn), &
+                                      nimppt(jn), njmppt(jn)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+
+      ! w a r n i n g  narea (zone) /= nproc (processors)!
+
+      IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+         IF( jpni == 1 )THEN
+            nbondi = 2
+            nperio = 1
+         ELSE
+            nbondi = 0
+         ENDIF
+         IF( MOD( narea, jpni ) == 0 ) THEN
+            noea = nproc-(jpni-1)
+            npne = npne-jpni
+            npse = npse-jpni
+         ENDIF
+         IF( MOD( narea, jpni ) == 1 ) THEN
+            nowe = nproc+(jpni-1)
+            npnw = npnw+jpni
+            npsw = npsw+jpni
+         ENDIF
+         nbsw = 1
+         nbnw = 1
+         nbse = 1
+         nbne = 1
+         IF( nproc < jpni ) THEN
+            nbsw = 0
+            nbse = 0
+         ENDIF
+         IF( nproc >= (jpnj-1)*jpni ) THEN
+            nbnw = 0
+            nbne = 0
+         ENDIF
+      ENDIF
+      npolj = 0
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         ijm1 = jpni*(jpnj-1)
+         imil = ijm1+(jpni+1)/2
+         IF( narea > ijm1 ) npolj = 3
+         IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 4
+         IF( npolj == 3 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+          ijm1 = jpni*(jpnj-1)
+          imil = ijm1+(jpni+1)/2
+          IF( narea > ijm1) npolj = 5
+          IF( MOD(jpni,2) == 1 .AND. narea == imil ) npolj = 6
+          IF( npolj == 5 ) nono = jpni*jpnj-narea+ijm1
+      ENDIF
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc  = ', nproc
+         WRITE(numout,*) ' nowe   = ', nowe  , ' noea   =  ', noea
+         WRITE(numout,*) ' nono   = ', nono  , ' noso   =  ', noso
+         WRITE(numout,*) ' nbondi = ', nbondi
+         WRITE(numout,*) ' nbondj = ', nbondj
+         WRITE(numout,*) ' npolj  = ', npolj
+         WRITE(numout,*) ' nperio = ', nperio
+         WRITE(numout,*) ' nlci   = ', nlci
+         WRITE(numout,*) ' nlcj   = ', nlcj
+         WRITE(numout,*) ' nimpp  = ', nimpp
+         WRITE(numout,*) ' njmpp  = ', njmpp
+         WRITE(numout,*) ' nbse   = ', nbse  , ' npse   = ', npse
+         WRITE(numout,*) ' nbsw   = ', nbsw  , ' npsw   = ', npsw
+         WRITE(numout,*) ' nbne   = ', nbne  , ' npne   = ', npne
+         WRITE(numout,*) ' nbnw   = ', nbnw  , ' npnw   = ', npnw
+      ENDIF
+
+      IF( nperio == 1 .AND. jpni /= 1 ) CALL ctl_stop( ' mpp_init: error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF (jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+      END IF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+   END SUBROUTINE mpp_init
+
+#  include "mppini_2.h90"
+
+# if defined key_dimgout
+   !!----------------------------------------------------------------------
+   !!   'key_dimgout'                  NO use of NetCDF files
+   !!----------------------------------------------------------------------
+   SUBROUTINE mpp_init_ioipsl       ! Dummy routine
+   END SUBROUTINE mpp_init_ioipsl  
+# else
+   SUBROUTINE mpp_init_ioipsl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init_ioipsl  ***
+      !!
+      !! ** Purpose :   
+      !!
+      !! ** Method  :   
+      !!
+      !! History :
+      !!   9.0  !  04-03  (G. Madec )  MPP-IOIPSL 
+      !!   " "  !  08-12  (A. Coward)  addition in case of jpni*jpnj < jpnij
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(2) ::   iglo, iloc, iabsf, iabsl, ihals, ihale, idid
+      !!----------------------------------------------------------------------
+
+      ! The domain is split only horizontally along i- or/and j- direction
+      ! So we need at the most only 1D arrays with 2 elements.
+      ! Set idompar values equivalent to the jpdom_local_noextra definition
+      ! used in IOM. This works even if jpnij .ne. jpni*jpnj.
+      iglo(1) = jpiglo
+      iglo(2) = jpjglo
+      iloc(1) = nlci
+      iloc(2) = nlcj
+      iabsf(1) = nimppt(narea)
+      iabsf(2) = njmppt(narea)
+      iabsl(:) = iabsf(:) + iloc(:) - 1
+      ihals(1) = nldi - 1
+      ihals(2) = nldj - 1
+      ihale(1) = nlci - nlei
+      ihale(2) = nlcj - nlej
+      idid(1) = 1
+      idid(2) = 2
+
+      IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2)
+          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2)
+          WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2)
+          WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2)
+      ENDIF
+      !
+      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom)
+      !
+   END SUBROUTINE mpp_init_ioipsl  
+
+# endif
+#endif
+
+   !!======================================================================
+END MODULE mppini
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90	(revision 3437)
@@ -0,0 +1,525 @@
+   SUBROUTINE mpp_init2
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE mpp_init2  ***
+      !!
+      !! * Purpose :   Lay out the global domain over processors.
+      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED
+      !!     FOR DEFINING BETTER CUTTING OUT.
+      !!       This routine is used with a the bathymetry file.
+      !!       In this version, the land processors are avoided and the adress
+      !!     processor (nproc, narea,noea, ...) are calculated again.
+      !!     The jpnij parameter can be lesser than jpni x jpnj
+      !!     and this jpnij parameter must be calculated before with an
+      !!     algoritmic preprocessing program.
+      !!
+      !! ** Method  :   Global domain is distributed in smaller local domains.
+      !!      Periodic condition is a function of the local domain position
+      !!      (global boundary or neighbouring domain) and of the global
+      !!      periodic
+      !!      Type :         jperio global periodic condition
+      !!                     nperio local  periodic condition
+      !!
+      !! ** Action :        nimpp     : longitudinal index 
+      !!                    njmpp     : latitudinal  index
+      !!                    nperio    : lateral condition type 
+      !!                    narea     : number for local area
+      !!                    nlci      : first dimension
+      !!                    nlcj      : second dimension
+      !!                    nproc     : number for local processor
+      !!                    noea      : number for local neighboring processor
+      !!                    nowe      : number for local neighboring processor
+      !!                    noso      : number for local neighboring processor
+      !!                    nono      : number for local neighboring processor
+      !!
+      !! History :
+      !!        !  94-11  (M. Guyon)  Original code
+      !!        !  95-04  (J. Escobar, M. Imbard)
+      !!        !  98-02  (M. Guyon)  FETI method
+      !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions
+      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1
+      !!----------------------------------------------------------------------
+      USE in_out_manager  ! I/O Manager
+      USE iom
+      !! 
+      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices
+      INTEGER ::  inum                        ! temporary logical unit
+      INTEGER ::   &
+         ii, ij, ifreq, il1, il2,          &  ! temporary integers
+         icont, ili, ilj,                  &  !    "          "
+         isurf, ijm1, imil,                &  !    "          "
+         iino, ijno, iiso, ijso,           &  !    "          " 
+         iiea, ijea, iiwe, ijwe,           &  !    "          "
+         iinw, ijnw, iine, ijne,           &  !    "          "
+         iisw, ijsw, iise, ijse,           &  !    "          "
+         iresti, irestj, iproc                !    "          "
+      INTEGER, DIMENSION(jpnij) ::   &
+         iin, ijn          
+      INTEGER, DIMENSION(jpni,jpnj) ::   &
+         iimppt, ijmppt, ilci  , ilcj  ,   &  ! temporary workspace
+         ipproc, ibondj, ibondi, ipolj ,   &  !    "           "
+         ilei  , ilej  , ildi  , ildj  ,   &  !    "           "
+         ioea  , iowe  , ioso  , iono  ,   &  !    "           "
+         ione  , ionw  , iose  , iosw  ,   &  !    "           "
+         ibne  , ibnw  , ibse  , ibsw         !    "           "
+      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   &
+         imask                                ! temporary global workspace
+      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
+         zdta                   ! temporary data workspace
+      REAL(wp) ::   zidom , zjdom          ! temporary scalars
+
+      ! read namelist for ln_zco
+      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id$
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+      
+      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate'
+      READ   ( numnam, namzgr )
+
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI'
+      IF(lwp)WRITE(numout,*) '~~~~~~~~'
+      IF(lwp)WRITE(numout,*) ' '
+
+      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' )
+
+      ! 0. initialisation
+      ! -----------------
+
+      ! open the file
+      ! Remember that at this level in the code, mpp is not yet initialized, so
+      ! the file must be open with jpdom_unknown, and kstart amd kcount forced 
+      IF ( ln_zco ) THEN 
+         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry
+         CALL iom_get ( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      ELSE
+         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps
+         CALL iom_get ( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/jpizoom,jpjzoom/), kcount=(/jpiglo,jpjglo/) )
+      ENDIF
+      CALL iom_close (inum)
+
+      ! land/sea mask over the global/zoom domain
+
+      imask(:,:)=1
+      WHERE ( zdta(:,:) <= 0. ) imask = 0
+
+      !  1. Dimension arrays for subdomains
+      ! -----------------------------------
+
+      !  Computation of local domain sizes ilci() ilcj()
+      !  These dimensions depend on global sizes jpni,jpnj and jpiglo,jpjglo
+      !  The subdomains are squares leeser than or equal to the global
+      !  dimensions divided by the number of processors minus the overlap
+      !  array.
+
+      nreci=2*jpreci
+      nrecj=2*jprecj
+      iresti = 1 + MOD( jpiglo - nreci -1 , jpni )
+      irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj )
+
+      ilci(1:iresti      ,:) = jpi
+      ilci(iresti+1:jpni ,:) = jpi-1
+
+      ilcj(:,      1:irestj) = jpj
+      ilcj(:, irestj+1:jpnj) = jpj-1
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~  ----------------------'
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'iresti=',iresti,' irestj=',irestj
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'jpni=',jpni,' jpnj=',jpnj
+
+      zidom = nreci + sum(ilci(:,1) - nreci ) 
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)' sum ilci(i,1)=',zidom,' jpiglo=',jpiglo
+
+      zjdom = nrecj + sum(ilcj(1,:) - nrecj ) 
+      IF(lwp) WRITE(numout,*) ' sum ilcj(1,j)=',zjdom,' jpjglo=',jpjglo
+      IF(lwp) WRITE(numout,*)
+
+
+      !  2. Index arrays for subdomains
+      ! -------------------------------
+
+      iimppt(:,:) = 1
+      ijmppt(:,:) = 1
+      ipproc(:,:) = -1
+
+      IF( jpni > 1 )THEN
+         DO jj = 1, jpnj
+            DO ji = 2, jpni
+               iimppt(ji,jj) = iimppt(ji-1,jj) + ilci(ji-1,jj) - nreci
+            END DO
+         END DO
+      ENDIF
+
+      IF( jpnj > 1 )THEN
+         DO jj = 2, jpnj
+            DO ji = 1, jpni
+               ijmppt(ji,jj) = ijmppt(ji,jj-1) + ilcj(ji,jj-1) - nrecj
+            END DO
+         END DO
+      ENDIF
+
+
+      ! 3. Subdomain description in the Regular Case
+      ! --------------------------------------------
+
+      nperio = 0
+      icont = -1
+      DO jarea = 1, jpni*jpnj
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         ili = ilci(ii,ij)
+         ilj = ilcj(ii,ij)
+
+         ibondj(ii,ij) = -1
+         IF( jarea >  jpni          )   ibondj(ii,ij) = 0
+         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1
+         IF( jpnj  == 1             )   ibondj(ii,ij) = 2
+
+         ibondi(ii,ij) = 0
+         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1
+         IF( MOD(jarea,jpni) == 0 )   ibondi(ii,ij) =  1
+         IF( jpni            == 1 )   ibondi(ii,ij) =  2
+
+         ! 2.4 Subdomain neighbors
+
+         iproc = jarea - 1
+         ioso(ii,ij) = iproc - jpni
+         iowe(ii,ij) = iproc - 1
+         ioea(ii,ij) = iproc + 1
+         iono(ii,ij) = iproc + jpni
+         ildi(ii,ij) = 1 + jpreci
+         ilei(ii,ij) = ili -jpreci
+         ionw(ii,ij) = iono(ii,ij) - 1
+         ione(ii,ij) = iono(ii,ij) + 1
+         iosw(ii,ij) = ioso(ii,ij) - 1
+         iose(ii,ij) = ioso(ii,ij) + 1
+         ibsw(ii,ij) = 1
+         ibnw(ii,ij) = 1
+         IF( MOD(iproc,jpni) == 0 ) THEN
+            ibsw(ii,ij) = 0
+            ibnw(ii,ij) = 0
+         ENDIF
+         ibse(ii,ij) = 1
+         ibne(ii,ij) = 1
+         IF( MOD(iproc,jpni) == jpni-1 ) THEN
+            ibse(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( iproc < jpni ) THEN
+            ibsw(ii,ij) = 0
+            ibse(ii,ij) = 0
+         ENDIF
+         IF( iproc >= (jpnj-1)*jpni ) THEN
+            ibnw(ii,ij) = 0
+            ibne(ii,ij) = 0
+         ENDIF
+         IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) = 1
+         IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ili
+         ildj(ii,ij) =  1  + jprecj
+         ilej(ii,ij) = ilj - jprecj
+         IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) = 1
+         IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilj
+
+         ! warning ii*ij (zone) /= nproc (processors)!
+
+         IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) THEN
+            IF( jpni == 1 )THEN
+               ibondi(ii,ij) = 2
+               nperio = 1
+            ELSE
+               ibondi(ii,ij) = 0
+            ENDIF
+            IF( MOD(jarea,jpni) == 0 ) THEN
+               ioea(ii,ij) = iproc - (jpni-1)
+               ione(ii,ij) = ione(ii,ij) - jpni
+               iose(ii,ij) = iose(ii,ij) - jpni
+            ENDIF
+            IF( MOD(jarea,jpni) == 1 ) THEN
+               iowe(ii,ij) = iproc + jpni - 1
+               ionw(ii,ij) = ionw(ii,ij) + jpni
+               iosw(ii,ij) = iosw(ii,ij) + jpni 
+            ENDIF
+            ibsw(ii,ij) = 1
+            ibnw(ii,ij) = 1
+            ibse(ii,ij) = 1
+            ibne(ii,ij) = 1
+            IF( iproc < jpni ) THEN
+               ibsw(ii,ij) = 0
+               ibse(ii,ij) = 0
+            ENDIF
+            IF( iproc >= (jpnj-1)*jpni ) THEN
+               ibnw(ii,ij) = 0
+               ibne(ii,ij) = 0
+            ENDIF
+         ENDIF
+         ipolj(ii,ij) = 0
+         IF( jperio == 3 .OR. jperio == 4 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1 ) ipolj(ii,ij) = 3
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 4
+            IF( ipolj(ii,ij) == 3 ) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+         IF( jperio == 5 .OR. jperio == 6 ) THEN
+            ijm1 = jpni*(jpnj-1)
+            imil = ijm1+(jpni+1)/2
+            IF( jarea > ijm1) ipolj(ii,ij) = 5
+            IF( MOD(jpni,2) == 1 .AND. jarea == imil ) ipolj(ii,ij) = 6
+            IF( ipolj(ii,ij) == 5) iono(ii,ij) = jpni*jpnj-jarea+ijm1
+         ENDIF
+
+         isurf = 0
+         DO jj = 1+jprecj, ilj-jprecj
+            DO  ji = 1+jpreci, ili-jpreci
+               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1
+            END DO
+         END DO
+         IF(isurf /= 0) THEN
+            icont = icont + 1
+            ipproc(ii,ij) = icont
+            iin(icont+1) = ii
+            ijn(icont+1) = ij
+         ENDIF
+      END DO
+
+      ! Control
+      IF(icont+1 /= jpnij) THEN
+         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj
+         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj' 
+         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1
+         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 )
+      ENDIF
+
+      ! 4. Subdomain print
+      ! ------------------
+
+      IF(lwp) THEN
+         ifreq = 4
+         il1 = 1
+         DO jn = 1,(jpni-1)/ifreq+1
+            il2 = MIN(jpni,il1+ifreq-1)
+            WRITE(numout,*)
+            WRITE(numout,9400) ('***',ji=il1,il2-1)
+            DO jj = jpnj, 1, -1
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2)
+               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2)
+               WRITE(numout,9403) ('   ',ji=il1,il2-1)
+               WRITE(numout,9400) ('***',ji=il1,il2-1)
+            END DO
+            WRITE(numout,9401) (ji,ji=il1,il2)
+            il1 = il1+ifreq
+         END DO
+ 9400     FORMAT('     ***',20('*************',a3))
+ 9403     FORMAT('     *     ',20('         *   ',a3))
+ 9401     FORMAT('        ',20('   ',i3,'          '))
+ 9402     FORMAT(' ',i3,' *  ',20(i3,'  x',i3,'   *   '))
+ 9404     FORMAT('     *  ',20('      ',i3,'   *   '))
+      ENDIF
+
+
+      ! 5. neighbour treatment
+      ! ----------------------
+
+      DO jarea = 1, jpni*jpnj
+         iproc = jarea-1
+         ii = 1 + MOD(jarea-1,jpni)
+         ij = 1 +    (jarea-1)/jpni
+         IF( ipproc(ii,ij) == -1 .AND. iono(ii,ij) >= 0   &
+            .AND. iono(ii,ij) <= jpni*jpnj-1 ) THEN
+            iino = 1 + MOD(iono(ii,ij),jpni)
+            ijno = 1 +    (iono(ii,ij))/jpni
+            IF( ibondj(iino,ijno) == 1 ) ibondj(iino,ijno)=2
+            IF( ibondj(iino,ijno) == 0 ) ibondj(iino,ijno) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioso(ii,ij) >= 0   &
+            .AND. ioso(ii,ij) <= jpni*jpnj-1 ) THEN
+            iiso = 1 + MOD(ioso(ii,ij),jpni)
+            ijso = 1 +    (ioso(ii,ij))/jpni
+            IF( ibondj(iiso,ijso) == -1 ) ibondj(iiso,ijso) = 2
+            IF( ibondj(iiso,ijso) ==  0 ) ibondj(iiso,ijso) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ioea(ii,ij) >= 0   &
+            .AND. ioea(ii,ij) <= jpni*jpnj-1) THEN
+            iiea = 1 + MOD(ioea(ii,ij),jpni)
+            ijea = 1 +    (ioea(ii,ij))/jpni
+            IF( ibondi(iiea,ijea) == 1 ) ibondi(iiea,ijea) = 2
+            IF( ibondi(iiea,ijea) == 0 ) ibondi(iiea,ijea) = -1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. iowe(ii,ij) >= 0   &
+            .AND. iowe(ii,ij) <= jpni*jpnj-1) THEN
+            iiwe = 1 + MOD(iowe(ii,ij),jpni)
+            ijwe = 1 +    (iowe(ii,ij))/jpni
+            IF( ibondi(iiwe,ijwe) == -1 ) ibondi(iiwe,ijwe) = 2
+            IF( ibondi(iiwe,ijwe) ==  0 ) ibondi(iiwe,ijwe) = 1
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibne(ii,ij) == 1 ) THEN
+            iine = 1 + MOD(ione(ii,ij),jpni)
+            ijne = 1 +    (ione(ii,ij))/jpni
+            IF( ibsw(iine,ijne) == 1 ) ibsw(iine,ijne) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibsw(ii,ij) == 1 ) THEN
+            iisw = 1 + MOD(iosw(ii,ij),jpni)
+            ijsw = 1 +    (iosw(ii,ij))/jpni
+            IF( ibne(iisw,ijsw) == 1 ) ibne(iisw,ijsw) = 0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibnw(ii,ij) == 1 ) THEN
+            iinw = 1 + MOD(ionw(ii,ij),jpni)
+            ijnw = 1 +    (ionw(ii,ij))/jpni
+            IF( ibse(iinw,ijnw) == 1 ) ibse(iinw,ijnw)=0
+         ENDIF
+         IF( ipproc(ii,ij) == -1 .AND. ibse(ii,ij) == 1 ) THEN
+            iise = 1 + MOD(iose(ii,ij),jpni)
+            ijse = 1 +    (iose(ii,ij))/jpni
+            IF( ibnw(iise,ijse) == 1 ) ibnw(iise,ijse) = 0
+         ENDIF
+      END DO
+
+
+      ! 6. Change processor name
+      ! ------------------------
+
+      nproc = narea-1
+      ii = iin(narea)
+      ij = ijn(narea)
+      IF( ioso(ii,ij) >= 0 .AND. ioso(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiso = 1 + MOD(ioso(ii,ij),jpni)
+         ijso = 1 +    (ioso(ii,ij))/jpni
+         noso = ipproc(iiso,ijso)
+      ENDIF
+      IF( iowe(ii,ij) >= 0 .AND. iowe(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiwe = 1 + MOD(iowe(ii,ij),jpni)
+         ijwe = 1 +    (iowe(ii,ij))/jpni
+         nowe = ipproc(iiwe,ijwe)
+      ENDIF
+      IF( ioea(ii,ij) >= 0 .AND. ioea(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iiea = 1 + MOD(ioea(ii,ij),jpni)
+         ijea = 1 +    (ioea(ii,ij))/jpni
+         noea = ipproc(iiea,ijea)
+      ENDIF
+      IF( iono(ii,ij) >= 0 .AND. iono(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iino = 1 + MOD(iono(ii,ij),jpni)
+         ijno = 1 +    (iono(ii,ij))/jpni
+         nono = ipproc(iino,ijno)
+      ENDIF
+      IF( iose(ii,ij) >= 0 .AND. iose(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iise = 1 + MOD(iose(ii,ij),jpni)
+         ijse = 1 +    (iose(ii,ij))/jpni
+         npse = ipproc(iise,ijse)
+      ENDIF
+      IF( iosw(ii,ij) >= 0 .AND. iosw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iisw = 1 + MOD(iosw(ii,ij),jpni)
+         ijsw = 1 +    (iosw(ii,ij))/jpni
+         npsw = ipproc(iisw,ijsw)
+      ENDIF
+      IF( ione(ii,ij) >= 0 .AND. ione(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iine = 1 + MOD(ione(ii,ij),jpni)
+         ijne = 1 +    (ione(ii,ij))/jpni
+         npne = ipproc(iine,ijne)
+      ENDIF
+      IF( ionw(ii,ij) >= 0 .AND. ionw(ii,ij) <= (jpni*jpnj-1) ) THEN 
+         iinw = 1 + MOD(ionw(ii,ij),jpni)
+         ijnw = 1 +    (ionw(ii,ij))/jpni
+         npnw = ipproc(iinw,ijnw)
+      ENDIF
+      nbnw = ibnw(ii,ij)
+      nbne = ibne(ii,ij)
+      nbsw = ibsw(ii,ij)
+      nbse = ibse(ii,ij)
+      nlcj = ilcj(ii,ij)  
+      nlci = ilci(ii,ij)  
+      nldi = ildi(ii,ij)
+      nlei = ilei(ii,ij)
+      nldj = ildj(ii,ij)
+      nlej = ilej(ii,ij)
+      nbondi = ibondi(ii,ij)
+      nbondj = ibondj(ii,ij)
+      nimpp = iimppt(ii,ij)  
+      njmpp = ijmppt(ii,ij)  
+      DO jproc = 1, jpnij
+         ii = iin(jproc)
+         ij = ijn(jproc)
+         nimppt(jproc) = iimppt(ii,ij)  
+         njmppt(jproc) = ijmppt(ii,ij)  
+         nlcjt(jproc) = ilcj(ii,ij)
+         nlcit(jproc) = ilci(ii,ij)
+         nldit(jproc) = ildi(ii,ij)
+         nleit(jproc) = ilei(ii,ij)
+         nldjt(jproc) = ildj(ii,ij)
+         nlejt(jproc) = ilej(ii,ij)
+      END DO
+
+      ! Save processor layout in ascii file
+      IF (lwp) THEN
+         CALL ctl_opn( inum, 'layout.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo
+         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp'
+
+        DO  jproc = 1, jpnij
+         WRITE(inum,'(9i5)') jproc, nlcit(jproc), nlcjt(jproc), &
+                                      nldit(jproc), nldjt(jproc), &
+                                      nleit(jproc), nlejt(jproc), &
+                                      nimppt(jproc), njmppt(jproc)
+        END DO
+        CLOSE(inum)   
+      END IF
+
+      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' )
+
+      ! Prepare mpp north fold
+
+      IF( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ) THEN
+         CALL mpp_ini_north
+         IF(lwp) WRITE(numout,*) ' mpp_init2 : North fold boundary prepared for jpni >1'
+      ENDIF
+
+      ! Defined npolj, either 0, 3 , 4 , 5 , 6
+      ! In this case the important thing is that npolj /= 0
+      ! Because if we go through these line it is because jpni >1 and thus
+      ! we must use lbcnorthmpp, which tests only npolj =0 or npolj /= 0
+
+      npolj = 0
+      ij = ijn(narea)
+
+      IF( jperio == 3 .OR. jperio == 4 ) THEN
+         IF( ij == jpnj ) npolj = 3
+      ENDIF
+
+      IF( jperio == 5 .OR. jperio == 6 ) THEN
+         IF( ij == jpnj ) npolj = 5
+      ENDIF
+
+      ! Prepare NetCDF output file (if necessary)
+      CALL mpp_init_ioipsl
+
+      ! Periodicity : no corner if nbondi = 2 and nperio != 1
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' nproc=  ',nproc
+         WRITE(numout,*) ' nowe=   ',nowe
+         WRITE(numout,*) ' noea=   ',noea
+         WRITE(numout,*) ' nono=   ',nono
+         WRITE(numout,*) ' noso=   ',noso
+         WRITE(numout,*) ' nbondi= ',nbondi
+         WRITE(numout,*) ' nbondj= ',nbondj
+         WRITE(numout,*) ' npolj=  ',npolj
+         WRITE(numout,*) ' nperio= ',nperio
+         WRITE(numout,*) ' nlci=   ',nlci
+         WRITE(numout,*) ' nlcj=   ',nlcj
+         WRITE(numout,*) ' nimpp=  ',nimpp
+         WRITE(numout,*) ' njmpp=  ',njmpp
+         WRITE(numout,*) ' nbse=   ',nbse,' npse= ',npse
+         WRITE(numout,*) ' nbsw=   ',nbsw,' npsw= ',npsw
+         WRITE(numout,*) ' nbne=   ',nbne,' npne= ',npne
+         WRITE(numout,*) ' nbnw=   ',nbnw,' npnw= ',npnw
+      ENDIF
+
+   END SUBROUTINE mpp_init2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90	(revision 3437)
@@ -0,0 +1,280 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_init : initialization, namelist read, and parameters control
+   !!   ldf_dyn_c3d   : 3D eddy viscosity coefficient initialization
+   !!   ldf_dyn_c2d   : 2D eddy viscosity coefficient initialization
+   !!   ldf_dyn_c1d   : 1D eddy viscosity coefficient initialization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers   
+   USE dom_oce         ! ocean space and time domain 
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE phycst          ! physical constants
+   USE ldfslp          ! ???
+   USE ioipsl
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_dyn_init   ! called by opa.F90
+
+  INTERFACE ldf_zpf
+     MODULE PROCEDURE ldf_zpf_1d, ldf_zpf_1d_3d, ldf_zpf_3d
+  END INTERFACE
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_dyn_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_init  ***
+      !!                   
+      !! ** Purpose :   set the horizontal ocean dynamics physics
+      !!
+      !! ** Method  :  
+      !!      -  default option : ahm = constant coef. = rn_ahm_0 (namelist)
+      !!      - 'key_dynldf_c1d': ahm = F(depth)                     see ldf_dyn_c1d.h90
+      !!      - 'key_dynldf_c2d': ahm = F(latitude,longitude)        see ldf_dyn_c2d.h90
+      !!      - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth)  see ldf_dyn_c3d.h90
+      !!
+      !!      N.B. User defined include files.  By default, 3d and 2d coef.
+      !!      are set to a constant value given in the namelist and the 1d
+      !!      coefficients are initialized to a hyperbolic tangent vertical
+      !!      profile.
+      !!
+      !! Reference :   Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio         ! ???
+      LOGICAL ::   ll_print = .FALSE.    ! Logical flag for printing viscosity coef.
+      !! 
+      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  &
+         &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   &
+         &                 rn_ahm_0_lap   , rn_ahmb_0      , rn_ahm_0_blp
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )                  ! Read Namelist namdyn_ldf : Lateral physics
+      READ  ( numnam, namdyn_ldf )
+
+      IF(lwp) THEN                      ! Parameter print
+         WRITE(numout,*)
+         WRITE(numout,*) 'ldf_dyn : lateral momentum physics'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters'
+         WRITE(numout,*) '      laplacian operator                      ln_dynldf_lap   = ', ln_dynldf_lap
+         WRITE(numout,*) '      bilaplacian operator                    ln_dynldf_bilap = ', ln_dynldf_bilap
+         WRITE(numout,*) '      iso-level                               ln_dynldf_level = ', ln_dynldf_level
+         WRITE(numout,*) '      horizontal (geopotential)               ln_dynldf_hor   = ', ln_dynldf_hor
+         WRITE(numout,*) '      iso-neutral                             ln_dynldf_iso   = ', ln_dynldf_iso
+         WRITE(numout,*) '      horizontal laplacian eddy viscosity     rn_ahm_0_lap    = ', rn_ahm_0_lap
+         WRITE(numout,*) '      background viscosity                    rn_ahmb_0       = ', rn_ahmb_0
+         WRITE(numout,*) '      horizontal bilaplacian eddy viscosity   rn_ahm_0_blp    = ', rn_ahm_0_blp
+      ENDIF
+
+      ahm0     = rn_ahm_0_lap              ! OLD namelist variables defined from DOCTOR namelist variables
+      ahmb0    = rn_ahmb_0
+      ahm0_blp = rn_ahm_0_blp
+
+      ! ... check of lateral diffusive operator on tracers
+      !           ==> will be done in trazdf module
+
+      ! ... Space variation of eddy coefficients
+      ioptio = 0
+#if defined key_dynldf_c3d
+      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude, depth)'
+      ioptio = ioptio+1
+#endif
+#if defined key_dynldf_c2d
+      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude)'
+      ioptio = ioptio+1
+#endif
+#if defined key_dynldf_c1d
+      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( depth )'
+      ioptio = ioptio+1
+      IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' )
+#endif
+      IF( ioptio == 0 ) THEN
+          IF(lwp) WRITE(numout,*) '   momentum mixing coef. = constant  (default option)'
+        ELSEIF( ioptio > 1 ) THEN
+           CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' )
+      ENDIF
+
+
+      IF( ln_dynldf_bilap ) THEN
+         IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion'
+         IF( .NOT. ln_dynldf_lap ) ahm0 = ahm0_blp   ! Allow spatially varying coefs, which use ahm0 as input
+         IF( ahm0_blp > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' )
+      ELSE
+         IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)'
+         IF( ahm0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' )
+      ENDIF
+
+
+      ! Lateral eddy viscosity
+      ! ======================
+#if defined key_dynldf_c3d
+      CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth )
+#elif defined key_dynldf_c2d
+      CALL ldf_dyn_c2d( ll_print )   ! ahm = 1D coef. = F( longitude, latitude )
+#elif defined key_dynldf_c1d
+      CALL ldf_dyn_c1d( ll_print )   ! ahm = 1D coef. = F( depth )
+#else
+                                     ! Constant coefficients
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: constant eddy viscosity coef. '
+      IF(lwp) WRITE(numout,*) '~~~~~~'
+      IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0
+#endif
+      !
+   END SUBROUTINE ldf_dyn_init
+
+#if defined key_dynldf_c3d
+#   include "ldfdyn_c3d.h90"
+#elif defined key_dynldf_c2d
+#   include "ldfdyn_c2d.h90"
+#elif defined key_dynldf_c1d
+#   include "ldfdyn_c1d.h90"
+#endif
+
+
+   SUBROUTINE ldf_zpf_1d( ld_print, pdam, pwam, pbot, pdep, pah )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_zpf  ***
+      !!                   
+      !! ** Purpose :   vertical adimensional profile for eddy coefficient
+      !!
+      !! ** Method  :   1D eddy viscosity coefficients ( depth )
+      !!----------------------------------------------------------------------
+      LOGICAL , INTENT(in   )                 ::   ld_print   ! If true, output arrays on numout
+      REAL(wp), INTENT(in   )                 ::   pdam       ! depth of the inflection point
+      REAL(wp), INTENT(in   )                 ::   pwam       ! width of inflection
+      REAL(wp), INTENT(in   )                 ::   pbot       ! bottom value (0<pbot<= 1)
+      REAL(wp), INTENT(in   ), DIMENSION(jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F)
+      REAL(wp), INTENT(inout), DIMENSION(jpk) ::   pah        ! adimensional vertical profile
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      zm00 = TANH( ( pdam - gdept_0(1    ) ) / pwam )
+      zm01 = TANH( ( pdam - gdept_0(jpkm1) ) / pwam )
+      zmhs = zm00 / zm01
+      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
+
+      DO jk = 1, jpk
+         pah(jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
+      END DO
+
+      IF(lwp .AND. ld_print ) THEN      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(jk), pdep(jk)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE ldf_zpf_1d
+
+
+   SUBROUTINE ldf_zpf_1d_3d( ld_print, pdam, pwam, pbot, pdep, pah )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_zpf  ***
+      !!
+      !! ** Purpose :   vertical adimensional profile for eddy coefficient
+      !!
+      !! ** Method  :   1D eddy viscosity coefficients ( depth )
+      !!----------------------------------------------------------------------
+      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
+      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
+      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
+      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
+      REAL(wp), INTENT(in   ), DIMENSION          (:) ::   pdep       ! depth of the gridpoint (T, U, V, F)
+      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   zm00, zm01, zmhb, zmhs, zcf  ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      zm00 = TANH( ( pdam - gdept_0(1    ) ) / pwam )
+      zm01 = TANH( ( pdam - gdept_0(jpkm1) ) / pwam )
+      zmhs = zm00 / zm01
+      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
+
+      DO jk = 1, jpk
+         zcf = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(jk) ) / pwam )  )
+         pah(:,:,jk) = zcf
+      END DO
+
+      IF(lwp .AND. ld_print ) THEN      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(jk)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE ldf_zpf_1d_3d
+
+
+   SUBROUTINE ldf_zpf_3d( ld_print, pdam, pwam, pbot, pdep, pah )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_zpf  ***
+      !!
+      !! ** Purpose :   vertical adimensional profile for eddy coefficient
+      !!
+      !! ** Method  :   3D for partial step or s-coordinate
+      !!----------------------------------------------------------------------
+      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout
+      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point
+      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection
+      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1)
+      REAL(wp), INTENT(in   ), DIMENSION      (:,:,:) ::   pdep       ! dep of the gridpoint (T, U, V, F)
+      REAL(wp), INTENT(inout), DIMENSION      (:,:,:) ::   pah        ! adimensional vertical profile
+      !!
+      INTEGER  ::   jk           ! dummy loop indices
+      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars
+      !!----------------------------------------------------------------------
+
+      zm00 = TANH( ( pdam - gdept_0(1    ) ) / pwam )   
+      zm01 = TANH( ( pdam - gdept_0(jpkm1) ) / pwam )
+      zmhs = zm00 / zm01
+      zmhb = ( 1.e0 - pbot ) / ( 1.e0 - zmhs ) / zm01
+
+      DO jk = 1, jpk
+         pah(:,:,jk) = 1.e0 + zmhb * ( zm00 - TANH( ( pdam - pdep(:,:,jk) ) / pwam )  )
+      END DO
+
+      IF(lwp .AND. ld_print ) THEN      ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile : '
+         WRITE(numout,*)
+         WRITE(numout,'("  jk      ahm       ","  depth t-level " )')
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4,3x,2f12.4)') jk, pah(1,1,jk), pdep(1,1,jk)
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE ldf_zpf_3d
+
+   !!======================================================================
+END MODULE ldfdyn
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_antarctic.h90	(revision 3437)
@@ -0,0 +1,43 @@
+   !!----------------------------------------------------------------------
+   !!  ldfdyn_antarctic.h90        2D (i,j) antarctic zoom viscosity coeff.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+!
+! 1.2 Modify ahm
+! --------------
+ 
+      IF(lwp)WRITE(numout,*) ' inildf: Antarctic ocean'
+      IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
+      IF(lwp)WRITE(numout,*) '         north boundary increase'
+
+      ahm1(:,:) = ahm0
+      ahm2(:,:) = ahm0
+
+      ijpt0=max(1,min(49 -njmpp+1,jpj))
+      ijpt1=max(0,min(49-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*2.
+         ahm1(:,jj)=ahm0*2.
+      END DO
+      ijpt0=max(1,min(48 -njmpp+1,jpj))
+      ijpt1=max(0,min(48-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.9
+         ahm1(:,jj)=ahm0*1.75
+      END DO
+      ijpt0=max(1,min(47 -njmpp+1,jpj))
+      ijpt1=max(0,min(47-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.5
+         ahm1(:,jj)=ahm0*1.25
+      END DO
+      ijpt0=max(1,min(46 -njmpp+1,jpj))
+      ijpt1=max(0,min(46-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.1
+      END DO
+C
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_arctic.h90	(revision 3437)
@@ -0,0 +1,43 @@
+   !!----------------------------------------------------------------------
+   !!  ldftra_arctic.h90              2D (i,j) arctic zoom viscosity coeff.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+! 1.2 Modify ahm 
+! --------------
+      IF(lwp)WRITE(numout,*) ' inildf: Arctic ocean'
+      IF(lwp)WRITE(numout,*) '         no tropics, no reduction of ahm'
+      IF(lwp)WRITE(numout,*) '         south and west boundary increase'
+
+
+      ahm1(:,:) = ahm0
+      ahm2(:,:) = ahm0
+
+      ijpt0=max(1,min(98-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(98-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*2.
+         ahm1(:,jj)=ahm0*2.
+      END DO
+      ijpt0=max(1,min(99-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(99-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.9
+         ahm1(:,jj)=ahm0*1.75
+      END DO
+      ijpt0=max(1,min(100-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(100-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.5
+         ahm1(:,jj)=ahm0*1.25
+      END DO
+      ijpt0=max(1,min(101-jpjzoom+1-njmpp+1,jpj))
+      ijpt1=max(0,min(101-jpjzoom+1-njmpp+1,jpj-1))
+      DO jj=ijpt0,ijpt1
+         ahm2(:,jj)=ahm0*1.1
+      END DO
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90	(revision 3437)
@@ -0,0 +1,124 @@
+   !!----------------------------------------------------------------------
+   !!                     ***  ldfdyn_c1d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c1d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c1d  ***
+      !!                   
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method  :   1D eddy viscosity coefficients ( depth )
+      !!      ahm3, ahm4 never used
+      !!      harmonic   operator : ahm1 defined at T-level
+      !!      biharmonic operator : ahm2 defined at T-level
+      !!      isopycnal or geopotential harmonic operator
+      !!                                      : ahm1 defined at T-level
+      !!                                      : ahm2 defined at w-level
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT(in) :: ld_print   ! If true, output arrays on numout
+      !
+      INTEGER  ::   jk   ! dummy loop indice
+      REAL(wp) ::   zdam,  zwam,  zm00,  zm01,  zmhf,  zmhs
+      REAL(wp) ::   zdam2, zwam2, zm200, zm201, zmh2f, zmh2s
+      REAL(wp) ::   zahmf, zahms
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+
+      ! Set ahm1 for laplacian     (always at t-level)
+      ! =============
+      ! (USER: modify ahm1 following your desiderata)
+
+      ! initialization of the profile
+      ! ahms, ahmf: surface and bottom values
+      zahms = ahm0
+      zahmf = ahm0/4.
+      ! zdam, zwam: depth of the inflection pt and width of inflection
+      zdam  = -300.
+      zwam  =  300.
+      ! computation coefficients
+      zm00 = TANH( (0-zdam)/zwam )
+      zm01 = TANH( (-fsdept(1,1,jpk)-zdam)/zwam )
+      zmhf = (zahms-zahmf)/(zm00-zm01)
+      zmhs = zahms-zmhf * zm00
+
+      ! Set ahm2 for bilaplacian   (always at t-level)
+      ! =============
+      ! (USER: modify ahm2 following your desiderata)
+
+      ! initialization of the profile
+      ! ahms, ahmf: surface and bottom values
+      zahm2s = ahm0_blp
+      zahm2f = ahm0_blp/4.
+      ! zdam, zwam: depth of the inflection pt and width of inflection
+      zdam2  = -300.
+      zwam2  =  300.
+      ! computation coefficients
+      zm200 = TANH( (0-zdam2)/zwam2 )
+      zm201 = TANH( (-fsdept(1,1,jpk)-zdam2)/zwam2 )
+      zmh2f = (zahm2s-zahm2f)/(zm200-zm201)
+      zmh2s = zahm2s-zmh2f * zm00
+
+
+      ! set ahm1 and ahm2 at T-level
+      DO jk = 1, jpk
+         ahm1(jk) = zmhs  + zmhf  * TANH( (-fsdept(1,1,jk)-zdam ) / zwam  )
+         ahm2(jk) = zmh2s + zmh2f * TANH( (-fsdept(1,1,jk)-zdam2) / zwam2 )
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile (laplacian): '
+         WRITE(numout,*)
+         WRITE(numout,9100)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm1(jk), fsdept(1,1,jk)
+         END DO
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm profile (bilaplacian): '
+         WRITE(numout,*)
+         WRITE(numout,9100)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm2(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+ 9100 FORMAT('  jk      ahm       ','  depth t-level ' )
+ 9110 FORMAT(i6,2f12.4,3x,2f12.4)
+
+
+      ! Set ahm3=ahm4   (always defined at w-level)
+      ! =============
+
+      ! define ahm3 from the same vertical profile used for ahm4
+      ! (always defined at w-level)
+      ! (USER: modify ahm1 following your desiderata)
+
+      DO jk = 1, jpk
+         ahm3(jk) = zmhs + zmhf * TANH( (-fsdepw(1,1,jk)-zdam) / zwam )
+         ahm4(jk) = ahm3(jk)
+      END DO
+
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm3=ahm4 profile : '
+         WRITE(numout,*)
+         WRITE(numout,9120)
+         DO jk = 1, jpk
+            WRITE(numout,9110) jk, ahm3(jk), fsdepw(1,1,jk)
+         END DO
+      ENDIF
+ 9120 FORMAT('  jk      ahm       ','  depth w-level ' )
+      !
+   END SUBROUTINE ldf_dyn_c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90	(revision 3437)
@@ -0,0 +1,454 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldfdyn_c2d.h90  ***
+   !!----------------------------------------------------------------------
+   !!   ldf_dyn_c2d  : set the lateral viscosity coefficients
+   !!   ldf_dyn_c2d_orca : specific case for orca r2 and r4
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!                  
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method :
+      !!      2D eddy viscosity coefficients ( longitude, latitude )
+      !!
+      !!       harmonic operator   : ahm1 is defined at t-point
+      !!                             ahm2 is defined at f-point
+      !!           + isopycnal     : ahm3 is defined at u-point
+      !!           or geopotential   ahm4 is defined at v-point
+      !!           iso-model level : ahm3, ahm4 not used
+      !!
+      !!       biharmonic operator : ahm3 is defined at u-point
+      !!                             ahm4 is defined at v-point
+      !!                           : ahm1, ahm2 not used
+      !!
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT (in) :: ld_print   ! If true, output arrays on numout
+      !
+      INTEGER  ::   ji, jj
+      REAL(wp) ::   za00, zd_max, zetmax, zeumax, zefmax, zevmax
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+      ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators
+      ! ===============================                       whatever its orientation is)
+      IF( ln_dynldf_lap ) THEN
+         ! define ahm1 and ahm2 at the right grid point position
+         ! (USER: modify ahm1 and ahm2 following your desiderata)
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+
+         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0 / zd_max
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
+               zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
+               ahm1(ji,jj) = za00 * zetmax
+               ahm2(ji,jj) = za00 * zefmax
+            END DO
+         END DO
+
+         IF( ln_dynldf_iso ) THEN
+            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
+            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
+            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
+            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
+         ENDIF
+
+         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! ==============================================
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   CALL ldf_dyn_c2d_orca( ld_print )
+         IF( cp_cfg == "orca" .AND.   jp_cfg == 1)                       CALL ldf_dyn_c2d_orca_R1( ld_print )
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahm1 array'
+            CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahm2 array'
+            CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+
+      ! biharmonic operator (ahm3, ahm4) : at U- and V-points (used for bilaplacian operator
+      ! =================================                      whatever its orientation is)
+      IF( ln_dynldf_bilap ) THEN
+         ! (USER: modify ahm3 and ahm4 following your desiderata)
+         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+         !       in the to horizontal direction
+
+         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+
+         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
+               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
+               ahm3(ji,jj) = za00 * zeumax * zeumax * zeumax
+               ahm4(ji,jj) = za00 * zevmax * zevmax * zevmax
+            END DO
+         END DO
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm3 array'
+            CALL prihre(ahm3,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm4 array'
+            CALL prihre(ahm4,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE ldf_dyn_c2d
+
+
+   SUBROUTINE ldf_dyn_c2d_orca( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!
+      !!                   **** W A R N I N G ****
+      !!
+      !!                ORCA R2 and R4 configurations
+      !!                  
+      !!                   **** W A R N I N G ****
+      !!                  
+      !! ** Purpose :   initializations of the lateral viscosity for orca R2
+      !!
+      !! ** Method  :   blah blah blah...
+      !!
+      !!----------------------------------------------------------------------
+      USE ldftra_oce, ONLY:   aht0
+      !
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
+      !
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      INTEGER  ::   inum, iim, ijm            ! local integers
+      INTEGER  ::   ifreq, il1, il2, ij, ii
+      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk
+      CHARACTER (len=15) ::   clexp
+      INTEGER, POINTER, DIMENSION(:,:)  :: icof
+      INTEGER, POINTER, DIMENSION(:,:)  :: idata
+      !!----------------------------------------------------------------------
+      !                                
+      CALL wrk_alloc( jpi   , jpj   , icof  )
+      CALL wrk_alloc( jpidta, jpjdta, idata )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+      IF(lwp) WRITE(numout,*) '        orca ocean configuration'
+
+#if defined key_antarctic
+#     include "ldfdyn_antarctic.h90"
+#elif defined key_arctic
+#     include "ldfdyn_arctic.h90"
+#else
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      READ(inum,9101) clexp, iim, ijm
+      READ(inum,'(/)')
+      ifreq = 40
+      il1 = 1
+      DO jn = 1, jpidta/ifreq+1
+         READ(inum,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inum,9201) ( ii, ji = il1, il2, 5 )
+         READ(inum,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            icof(ji,jj) = idata( mig(ji), mjg(jj) )
+         END DO
+      END DO
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            icof(ji,jj) = icof(ji,nlcj)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            icof(ji,jj) = icof(nlci,jj)
+         END DO
+      END DO
+
+ 9101 FORMAT(1x,a15,2i8)
+ 9201 FORMAT(3x,13(i3,12x))
+ 9202 FORMAT(i3,41i3)
+
+
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
+      ! =================
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90 to 20 degre: ahm = constant
+      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
+      ! from  2.5 to  0 degre: ahm = constant
+      ! symmetric in the south hemisphere)
+
+      zahmeq = aht0
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
+               ahm2(ji,jj) =  ahm0
+            ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
+               ahm2(ji,jj) =  zahmeq
+            ELSE
+               ahm2(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+            IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
+               ahm1(ji,jj) =  ahm0
+            ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
+               ahm1(ji,jj) =  zahmeq
+            ELSE
+               ahm1(ji,jj) = zahmeq + (ahm0-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+         END DO
+      END DO
+
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zcoft = FLOAT( icof(ji,jj) ) / 100.
+            ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1   ! NO vector opt.
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
+         END DO
+      END DO
+#endif
+      
+      ! Lateral boundary conditions on ( ahm1, ahm2 )
+      !                                ==============
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
+      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm1 array'
+         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm2 array'
+         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi   , jpj   , icof  )
+      CALL wrk_dealloc( jpidta, jpjdta, idata )
+      !
+   END SUBROUTINE ldf_dyn_c2d_orca
+
+
+   SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_dyn_c2d  ***
+      !!
+      !!                   **** W A R N I N G ****
+      !!
+      !!                ORCA R1 configuration
+      !!                  
+      !!                   **** W A R N I N G ****
+      !!                  
+      !! ** Purpose :   initializations of the lateral viscosity for orca R1
+      !!
+      !! ** Method  :   blah blah blah...
+      !!
+      !!----------------------------------------------------------------------
+      USE ldftra_oce, ONLY:   aht0
+      !
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
+      !
+      INTEGER ::   ji, jj, jn      ! dummy loop indices
+      INTEGER ::   inum            ! temporary logical unit
+      INTEGER ::   iim, ijm
+      INTEGER ::   ifreq, il1, il2, ij, ii
+      REAL(wp) ::   zahmeq, zcoft, zcoff, zmsk, zam20s
+      CHARACTER (len=15) ::   clexp
+      INTEGER, POINTER, DIMENSION(:,:)  :: icof
+      INTEGER, POINTER, DIMENSION(:,:)  :: idata
+      !!----------------------------------------------------------------------
+      !                                
+      CALL wrk_alloc( jpi   , jpj   , icof  )
+      CALL wrk_alloc( jpidta, jpjdta, idata )
+      !                                
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~  --'
+      IF(lwp) WRITE(numout,*) '        orca_r1 configuration'
+
+#if defined key_antarctic
+#     include "ldfdyn_antarctic.h90"
+#elif defined key_arctic
+#     include "ldfdyn_arctic.h90"
+#else
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL',   &
+         &           1, numout, lwp )
+      REWIND inum
+      READ(inum,9101) clexp, iim, ijm
+      READ(inum,'(/)')
+      ifreq = 40
+      il1 = 1
+      DO jn = 1, jpidta/ifreq+1
+         READ(inum,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inum,9201) ( ii, ji = il1, il2, 5 )
+         READ(inum,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            icof(ji,jj) = idata( mig(ji), mjg(jj) )
+         END DO
+      END DO
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            icof(ji,jj) = icof(ji,nlcj)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            icof(ji,jj) = icof(nlci,jj)
+         END DO
+      END DO
+
+ 9101 FORMAT(1x,a15,2i8)
+ 9201 FORMAT(3x,13(i3,12x))
+ 9202 FORMAT(i3,41i3)
+
+
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operator)
+      ! =================
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90   to 20   degrees: ahm = scaled by local metrics
+      !  from 20   to  2.5 degrees: ahm = decrease in (1-cos)/2
+      !  from  2.5 to  0   degrees: ahm = constant
+      ! symmetric in the south hemisphere)
+
+      zahmeq = aht0
+      zam20s = ahm0*COS( rad * 20. )
+      
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS( gphif(ji,jj) ) >= 20. ) THEN
+!              leave as set in ldf_dyn_c2d
+            ELSEIF( ABS( gphif(ji,jj) ) <= 2.5 ) THEN
+               ahm2(ji,jj) =  zahmeq
+            ELSE
+               ahm2(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphif(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+            IF( ABS( gphit(ji,jj) ) >= 20. ) THEN
+!             leave as set in ldf_dyn_c2d
+            ELSEIF( ABS( gphit(ji,jj) ) <= 2.5 ) THEN
+               ahm1(ji,jj) =  zahmeq
+            ELSE
+               ahm1(ji,jj) =  zahmeq + (zam20s-zahmeq)/2.   &
+                  * ( 1. - COS( rad * ( ABS(gphit(ji,jj))-2.5 ) * 180. / 17.5 ) )
+            ENDIF
+         END DO
+      END DO
+
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+          IF( ABS( gphit(ji,jj) ) < 20. ) THEN
+            zcoft = FLOAT( icof(ji,jj) ) / 100.
+            ahm1(ji,jj) = zcoft * ahm0 + (1.-zcoft) * ahm1(ji,jj) 
+          ENDIF
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+          IF( ABS( gphif(ji,jj) ) < 20. ) THEN
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj) = zcoff * ahm0 + (1.-zcoff) * ahm2(ji,jj)
+          ENDIF
+         END DO
+      END DO
+#endif
+      
+      ! Lateral boundary conditions on ( ahm1, ahm2 )
+      !                                ==============
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! T-point, unchanged sign
+      CALL lbc_lnk( ahm2, 'F', 1. )   ! F-point, unchanged sign
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm1 array'
+         CALL prihre(ahm1,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: 2D ahm2 array'
+         CALL prihre(ahm2,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi   , jpj   , icof  )
+      CALL wrk_dealloc( jpidta, jpjdta, idata )
+      !
+   END SUBROUTINE ldf_dyn_c2d_orca_R1
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90	(revision 3437)
@@ -0,0 +1,461 @@
+   !!----------------------------------------------------------------------
+   !!                        ***  ldfdyn_c3d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   'key_dynldf_c3d'             3D lateral eddy viscosity coefficients
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_dyn_c3d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c3d  ***
+      !!                   
+      !! ** Purpose :   initializations of the horizontal ocean physics
+      !!
+      !! ** Method  :   3D eddy viscosity coef. ( longitude, latitude, depth )
+      !!       laplacian operator   : ahm1, ahm2 defined at T- and F-points
+      !!                              ahm2, ahm4 never used
+      !!       bilaplacian operator : ahm1, ahm2 never used
+      !!                           :  ahm3, ahm4 defined at U- and V-points
+      !!       ??? explanation of the default is missing
+      !!----------------------------------------------------------------------
+      USE ldftra_oce, ONLY :   aht0
+      !!
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zr = 0.2     ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 )
+      REAL(wp) ::   zh = 500.    ! depth of at which start the reduction ( > dept(1) )
+      REAL(wp) ::   zd_max       ! maximum grid spacing over the global domain
+      REAL(wp) ::   za00, zc, zd, zetmax, zefmax, zeumax, zevmax   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:) :: zcoef   
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpk, zcoef )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldf_dyn_c3d : 3D lateral eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+
+      
+      ! Set ahm1 and ahm2  ( T- and F- points) (used for laplacian operators
+      ! =================                       whatever its orientation is)
+      IF( ln_dynldf_lap ) THEN
+         ! define ahm1 and ahm2 at the right grid point position
+         ! (USER: modify ahm1 and ahm2 following your desiderata)
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+
+         IF(lwp) WRITE(numout,*) '              laplacian operator: ahm proportional to e1'
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0 / zd_max
+
+         IF( ln_dynldf_iso ) THEN
+            IF(lwp) WRITE(numout,*) '              Caution, as implemented now, the isopycnal part of momentum'
+            IF(lwp) WRITE(numout,*) '                 mixing use aht0 as eddy viscosity coefficient. Thus, it is'
+            IF(lwp) WRITE(numout,*) '                 uniform and you must be sure that your ahm is greater than'
+            IF(lwp) WRITE(numout,*) '                 aht0 everywhere in the model domain.'
+         ENDIF
+
+         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm1 )   ! vertical profile
+         CALL ldf_zpf( .TRUE. , 1000., 500., 0.25, fsdept(:,:,:), ahm2 )   ! vertical profile
+         DO jk = 1,jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
+                  zefmax = MAX( e1f(ji,jj), e2f(ji,jj) )
+                  ahm1(ji,jj,jk) = za00 * zetmax * ahm1(ji,jj,jk)
+                  ahm2(ji,jj,jk) = za00 * zefmax * ahm2(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+
+         ! Special case for ORCA R1, R2 and R4 configurations (overwrite the value of ahm1 ahm2)
+         ! ==============================================
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) ) THEN 
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '              ORCA R1, R2 or R4: overwrite the previous definition of ahm'
+            IF(lwp) WRITE(numout,*) '              ================='
+            CALL ldf_dyn_c3d_orca( ld_print )
+         ENDIF
+
+      ENDIF
+      
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm1 array (k=1)'
+         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=1)'
+         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+      ENDIF
+
+
+      ! ahm3 and ahm4 at U- and V-points (used for bilaplacian operator
+      ! ================================  whatever its orientation is)
+      ! (USER: modify ahm3 and ahm4 following your desiderata)
+      ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+      !       in the to horizontal direction
+
+      IF( ln_dynldf_bilap ) THEN
+
+         zd_max = MAX( MAXVAL( e1u(:,:) ), MAXVAL( e2u(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+
+         IF(lwp) WRITE(numout,*) '              bi-laplacian operator: ahm proportional to e1**3 '
+         IF(lwp) WRITE(numout,*) '              maximum grid-spacing = ', zd_max, ' maximum value for ahm = ', ahm0
+
+         za00 = ahm0_blp / ( zd_max * zd_max * zd_max )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) )
+               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) )
+               ahm3(ji,jj,1) = za00 * zeumax * zeumax * zeumax
+               ahm4(ji,jj,1) = za00 * zevmax * zevmax * zevmax
+            END DO
+         END DO
+
+         zh = MAX( zh, fsdept(1,1,1) )   ! at least the first reach ahm0
+         IF( ln_zco ) THEN               ! z-coordinate, same profile everywhere
+            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
+            DO jk = 1, jpk
+               IF( fsdept(1,1,jk) <= zh ) THEN
+                  zcoef(jk) = 1.e0
+               ELSE
+                  zcoef(jk) = 1.e0 + ( zr - 1.e0 )   &
+                     &               * (  1. - EXP( ( fsdept(1,1,jk   ) - zh ) / zh )  )   &
+                     &               / (  1. - EXP( ( fsdept(1,1,jpkm1) - zh ) / zh )  )
+               ENDIF
+               ahm3(:,:,jk) = ahm3(:,:,1) * zcoef(jk)
+               ahm4(:,:,jk) = ahm4(:,:,1) * zcoef(jk)
+               IF(lwp) WRITE(numout,'(34x,E7.2,8x,i3)') zcoef(jk) * ahm0, jk
+            END DO
+         ELSE                            ! partial steps or s-ccordinate
+            zc = MAXVAL( fsdept(:,:,jpkm1) )
+            IF( lk_mpp )   CALL mpp_max( zc )   ! max over the global domain
+
+            zc = 1. / (  1. - EXP( ( zc - zh ) / zh )  )
+            DO jk = 2, jpkm1
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( fsdept(ji,jj,jk) <= zh ) THEN
+                        ahm3(ji,jj,jk) = ahm3(ji,jj,1)
+                        ahm4(ji,jj,jk) = ahm4(ji,jj,1)
+                     ELSE
+                        zd = 1.e0 + ( zr - 1.e0 ) * (  1. - EXP( ( fsdept(ji,jj,jk) - zh ) / zh )  ) * zc
+                        ahm3(ji,jj,jk) = ahm3(ji,jj,1) * zd
+                        ahm4(ji,jj,jk) = ahm4(ji,jj,1) * zd
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+            ahm3(:,:,jpk) = ahm3(:,:,jpkm1)
+            ahm4(:,:,jpk) = ahm4(:,:,jpkm1)
+            IF(lwp) WRITE(numout,'(36x," ahm ", 7x)')
+            DO jk = 1, jpk
+               IF(lwp) WRITE(numout,'(30x,E10.2,8x,i3)') ahm3(1,1,jk), jk
+            END DO
+         ENDIF
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm3 array at level 1'
+            CALL prihre(ahm3(:,:,1  ),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahm4 array at level 1'
+            CALL prihre(ahm4(:,:,jpk),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpk, zcoef )
+      !
+   END SUBROUTINE ldf_dyn_c3d
+
+
+   SUBROUTINE ldf_dyn_c3d_orca( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_dyn_c3d  ***
+      !!                   
+      !! ** Purpose :   ORCA R1, R2 and R4 only
+      !!
+      !! ** Method  :   blah blah blah ....
+      !!----------------------------------------------------------------------
+      USE ldftra_oce, ONLY:   aht0
+      !!
+      LOGICAL, INTENT(in) ::   ld_print   ! If true, output arrays on numout
+      !!
+      INTEGER ::   ji, jj, jk, jn      ! dummy loop indices
+      INTEGER ::   ii0, ii1, ij0, ij1  ! local integers
+      INTEGER ::   inum, iim, ijm      ! 
+      INTEGER ::   ifreq, il1, il2, ij, ii
+      REAL(wp) ::   zahmeq, zcoff, zcoft, zmsk   ! local scalars
+      REAL(wp) ::   zemax , zemin, zeref, zahmm
+      CHARACTER (len=15) ::   clexp
+      INTEGER , POINTER, DIMENSION(:,:)  :: icof
+      INTEGER , POINTER, DIMENSION(:,:)  :: idata
+      REAL(wp), POINTER, DIMENSION(:  )  :: zcoef   
+      REAL(wp), POINTER, DIMENSION(:,:)  :: zahm0
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi   , jpj   , icof  )
+      CALL wrk_alloc( jpidta, jpjdta, idata )
+      CALL wrk_alloc( jpk   ,         zcoef )
+      CALL wrk_alloc( jpi   , jpj   , zahm0 )
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '        orca R1, R2 or R4 configuration: reduced in the surface Eq. strip '
+
+      ! Read 2d integer array to specify western boundary increase in the
+      ! ===================== equatorial strip (20N-20S) defined at t-points
+
+      CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
+      READ(inum,9101) clexp, iim, ijm
+      READ(inum,'(/)')
+      ifreq = 40
+      il1 = 1
+      DO jn = 1, jpidta/ifreq+1
+         READ(inum,'(/)')
+         il2 = MIN( jpidta, il1+ifreq-1 )
+         READ(inum,9201) ( ii, ji = il1, il2, 5 )
+         READ(inum,'(/)')
+         DO jj = jpjdta, 1, -1
+            READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 )
+         END DO
+         il1 = il1 + ifreq
+      END DO
+      
+      DO jj = 1, nlcj
+         DO ji = 1, nlci
+            icof(ji,jj) = idata( mig(ji), mjg(jj) )
+         END DO
+      END DO
+      DO jj = nlcj+1, jpj
+         DO ji = 1, nlci
+            icof(ji,jj) = icof(ji,nlcj)
+         END DO
+      END DO
+      DO jj = 1, jpj
+         DO ji = nlci+1, jpi
+            icof(ji,jj) = icof(nlci,jj)
+         END DO
+      END DO
+      
+9101  FORMAT(1x,a15,2i8)
+9201  FORMAT(3x,13(i3,12x))
+9202  FORMAT(i3,41i3)
+      
+      ! Set ahm1 and ahm2
+      ! =================
+      
+      ! define ahm1 and ahm2 at the right grid point position
+      ! (USER: modify ahm1 and ahm2 following your desiderata)
+      ! biharmonic : ahm1 (ahm2) defined at u- (v-) point
+      ! harmonic   : ahm1 (ahm2) defined at t- (f-) point
+      
+      ! first level : as for 2D coefficients
+      
+      ! Decrease ahm to zahmeq m2/s in the tropics
+      ! (from 90 to 20 degre: ahm = constant
+      ! from 20 to  2.5 degre: ahm = decrease in (1-cos)/2
+      ! from  2.5 to  0 degre: ahm = constant
+      ! symmetric in the south hemisphere)
+      
+      IF( jp_cfg == 4 )   THEN
+         zahmeq = 5.0 * aht0
+         zahmm  = min( 160000.0, ahm0)
+         zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
+         zemin = MINVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 )
+         zeref = MAXVAL ( e1t(:,:) * e2t(:,:),   &
+             &   tmask(:,:,1) .GE. 0.5 .AND. ABS(gphit(:,:)) .GT. 50. )
+ 
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              zmsk = e1t(ji,jj) * e2t(ji,jj)
+              IF( abs(gphit(ji,jj)) .LE. 15 ) THEN 
+                 zahm0(ji,jj) = ahm0
+              ELSE 
+                 IF( zmsk .GE. zeref ) THEN 
+                    zahm0(ji,jj) = ahm0
+                 ELSE 
+                    zahm0(ji,jj) = zahmm + (ahm0-zahmm)*(1.0 -   &
+                        &          cos((rpi*0.5*(zmsk-zemin)/(zeref-zemin))))
+                 ENDIF 
+              ENDIF 
+           END DO 
+         END DO 
+      ENDIF
+
+      IF( jp_cfg == 2 )   THEN
+         zahmeq     = aht0
+         zahmm      = ahm0
+         zahm0(:,:) = ahm0
+      ENDIF
+
+      IF( jp_cfg == 1 )   THEN
+         zahmeq     = aht0  ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required
+         zahmm      = ahm0
+         zahm0(:,:) = ahm0
+      ENDIF
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS(gphif(ji,jj)) >= 20.) THEN
+               ahm2(ji,jj,1) =  zahm0(ji,jj)
+            ELSEIF( ABS(gphif(ji,jj)) <= 2.5) THEN
+               ahm2(ji,jj,1) =  zahmeq
+            ELSE
+               ahm2(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
+                  &            *(1.-COS( rad*(ABS(gphif(ji,jj))-2.5)*180./17.5 ) )
+            ENDIF
+            IF( ABS(gphit(ji,jj)) >= 20.) THEN
+               ahm1(ji,jj,1) =  zahm0(ji,jj)
+            ELSEIF( ABS(gphit(ji,jj)) <= 2.5) THEN
+               ahm1(ji,jj,1) =  zahmeq
+            ELSE
+               ahm1(ji,jj,1) = zahmeq + (zahm0(ji,jj)-zahmeq)/2.   &
+                  &            *(1.-COS( rad*(ABS(gphit(ji,jj))-2.5)*180./17.5 ) )
+            ENDIF
+         END DO
+      END DO
+      
+      ! increase along western boundaries of equatorial strip
+      ! t-point
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1
+            zcoft = float( icof(ji,jj) ) / 100.
+            ahm1(ji,jj,1) = zcoft * zahm0(ji,jj) + (1.-zcoft) * ahm1(ji,jj,1)
+         END DO
+      END DO
+      ! f-point
+      icof(:,:) = icof(:,:) * tmask(:,:,1)
+      DO jj = 1, jpjm1
+         DO ji = 1, jpim1   ! NO vector opt.
+            zmsk = tmask(ji,jj+1,1) + tmask(ji+1,jj+1,1) + tmask(ji,jj,1) + tmask(ji,jj+1,1)
+            IF( zmsk == 0. ) THEN
+               zcoff = 1.
+            ELSE
+               zcoff = FLOAT( icof(ji,jj+1) + icof(ji+1,jj+1) + icof(ji,jj) + icof(ji,jj+1) )   &
+                     / (zmsk * 100.)
+            ENDIF
+            ahm2(ji,jj,1) = zcoff * zahm0(ji,jj) + (1.-zcoff) * ahm2(ji,jj,1)
+         END DO
+      END DO
+
+      ! other level: re-increase the coef in the deep ocean
+      !==================================================================
+      ! Prior to v3.3, zcoeff was hardwired according to k-index jk.
+      !
+      ! From v3.3 onwards this has been generalised to a function of 
+      ! depth so that it can be used with any number of levels.
+      !
+      ! The function has been chosen to match the original values (shown
+      ! in the following comments) when using the standard 31 ORCA levels.  
+      !     DO jk = 1, 21
+      !        zcoef(jk) = 1._wp
+      !     END DO
+      !     zcoef(22) = 2._wp
+      !     zcoef(23) = 3._wp
+      !     zcoef(24) = 5._wp
+      !     zcoef(25) = 7._wp
+      !     zcoef(26) = 9._wp
+      !     DO jk = 27, jpk
+      !        zcoef(jk) = 10._wp
+      !     END DO
+      !==================================================================
+
+       IF(lwp) THEN
+          WRITE(numout,*)
+          WRITE(numout,*) '         1D zcoef array '
+          WRITE(numout,*) '         ~~~~~~~~~~~~~~ '
+          WRITE(numout,*)
+          WRITE(numout,*) '    jk        zcoef '
+       ENDIF
+
+      DO jk=1, jpk
+         zcoef(jk) = 1.0_wp + NINT(9.0_wp*(gdept_0(jk)-800.0_wp)/(3000.0_wp-800.0_wp))
+         zcoef(jk) = MIN(10.0_wp, MAX(1.0_wp, zcoef(jk)))
+         IF(lwp) WRITE(numout,'(4x,i3,6x,f7.3)') jk,zcoef(jk)
+      END DO
+
+      DO jk = 2, jpk
+         ahm1(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm1(:,:,1) )
+         ahm2(:,:,jk) = MIN( zahm0(:,:), zcoef(jk) * ahm2(:,:,1) )
+      END DO
+
+      IF( jp_cfg == 4 )   THEN         ! Limit AHM in Gibraltar strait
+         ij0 = 50   ;   ij1 = 53
+         ii0 = 69   ;   ii1 = 71
+         DO jk = 1, jpk
+            ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm1(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) ) 
+            ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) = MIN( zahmm, ahm2(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),jk) )
+         END DO
+      ENDIF
+      CALL lbc_lnk( ahm1, 'T', 1. )   ! Lateral boundary conditions (unchanged sign)
+      CALL lbc_lnk( ahm2, 'F', 1. )
+
+
+      IF(lwp) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm1 array (k=1)'
+         CALL prihre( ahm1(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=1)'
+         CALL prihre( ahm2(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) '         3D ahm2 array (k=jpk)'
+         CALL prihre( ahm2(:,:,jpk), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1.e-3, numout )
+      ENDIF
+
+
+      ! Set ahm3 and ahm4
+      ! =================
+
+      ! define ahm3 and ahm4 at the right grid point position
+      ! initialization to a constant value
+      !     (USER: modify ahm3 and ahm4 following your desiderata)
+      !     harmonic isopycnal or geopotential:
+      !                          ahm3 (ahm4) defined at u- (v-) point
+      DO jk = 1, jpk
+         DO jj = 2, jpj
+            DO ji = 2, jpi
+               ahm3(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji  ,jj-1,jk) )
+               ahm4(ji,jj,jk) = 0.5 * ( ahm2(ji,jj,jk) + ahm2(ji-1,jj  ,jk) )
+            END DO
+         END DO
+      END DO
+      ahm3 ( :, 1, :) = ahm3 ( :, 2, :)
+      ahm4 ( :, 1, :) = ahm4 ( :, 2, :)
+      
+      CALL lbc_lnk( ahm3, 'U', 1. )    ! Lateral boundary conditions (unchanged sign)
+      CALL lbc_lnk( ahm4, 'V', 1. )
+
+      ! Control print
+
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm3 array level 1'
+         CALL prihre(ahm3(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) '         ahm4 array level 1'
+         CALL prihre(ahm4(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi   , jpj   , icof  )
+      CALL wrk_dealloc( jpidta, jpjdta, idata )
+      CALL wrk_dealloc( jpk   ,         zcoef )
+      CALL wrk_dealloc( jpi   , jpj   , zahm0 )
+      !
+   END SUBROUTINE ldf_dyn_c3d_orca
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90	(revision 3437)
@@ -0,0 +1,61 @@
+MODULE ldfdyn_oce
+   !!======================================================================
+   !!                  ***  MODULE  ldfdyn_oce  ***
+   !! Ocean physics:  lateral momentum mixing coefficient defined in memory 
+   !!======================================================================
+   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !                                                  !!* Namelist namdyn_ldf : lateral mixing *
+   LOGICAL , PUBLIC ::   ln_dynldf_lap   = .TRUE.      !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_bilap = .FALSE.     !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_dynldf_level = .FALSE.     !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_dynldf_hor   = .TRUE.      !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_dynldf_iso   = .FALSE.     !: iso-neutral direction
+   REAL(wp), PUBLIC ::   rn_ahm_0_lap    = 40000._wp   !: lateral laplacian eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral laplacian background eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahm_0_blp    =     0._wp   !: lateral bilaplacian eddy viscosity (m4/s)
+   REAL(wp), PUBLIC ::   ahm0, ahmb0, ahm0_blp         !: OLD namelist names
+
+   !                                                                                  !!! eddy coeff. at U-,V-,W-pts [m2/s]
+#if defined key_dynldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahm1, ahm2, ahm3, ahm4   !: ** 3D coefficients **
+#elif defined key_dynldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
+#elif defined key_dynldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahm1, ahm2, ahm3, ahm4   !: ** 2D coefficients **
+#else
+   REAL(wp), PUBLIC                                      ::   ahm1, ahm2, ahm3, ahm4   !: ** 0D coefficients **
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION ldfdyn_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION ldfdyn_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      ldfdyn_oce_alloc = 0
+#if defined key_dynldf_c3d
+      ALLOCATE( ahm1(jpi,jpj,jpk) , ahm2(jpi,jpj,jpk) , ahm3(jpi,jpj,jpk) , ahm4(jpi,jpj,jpk) , STAT=ldfdyn_oce_alloc )
+#elif defined key_dynldf_c2d
+      ALLOCATE( ahm1(jpi,jpj    ) , ahm2(jpi,jpj    ) , ahm3(jpi,jpj    ) , ahm4(jpi,jpj    ) , STAT=ldfdyn_oce_alloc )
+#elif defined key_dynldf_c1d
+      ALLOCATE( ahm1(        jpk) , ahm2(        jpk) , ahm3(        jpk) , ahm4(        jpk) , STAT=ldfdyn_oce_alloc )
+#endif
+      IF( ldfdyn_oce_alloc /= 0 )   CALL ctl_warn('ldfdyn_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION ldfdyn_oce_alloc
+
+   !!======================================================================
+END MODULE ldfdyn_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_substitute.h90	(revision 3437)
@@ -0,0 +1,40 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  ldfdyn_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsahm., the lateral eddy viscosity coeff. 
+   !!      with a constant, or 1D, or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   !!
+   !! fsahmt, fsahmf - used for laplaian operator only
+   !! fsahmu, fsahmv - used for bilaplacian operator only
+   !!
+#if defined key_dynldf_c3d
+!   ' key_dynldf_c3d' :                  3D coefficient
+#    define   fsahmt(i,j,k)    ahm1(i,j,k)
+#    define   fsahmf(i,j,k)    ahm2(i,j,k)
+#    define   fsahmu(i,j,k)    ahm3(i,j,k)
+#    define   fsahmv(i,j,k)    ahm4(i,j,k)
+#elif defined key_dynldf_c2d
+!   ' key_dynldf_c2d' :                 2D coefficient
+#  define   fsahmt(i,j,k)    ahm1(i,j)
+#  define   fsahmf(i,j,k)    ahm2(i,j)
+#  define   fsahmu(i,j,k)    ahm3(i,j)
+#  define   fsahmv(i,j,k)    ahm4(i,j)
+#elif defined key_dynldf_c1d
+!   'key_dynldf_c1d' :                  1D coefficient
+#  define   fsahmt(i,j,k)    ahm1(k)
+#  define   fsahmf(i,j,k)    ahm1(k)
+#  define   fsahmu(i,j,k)    ahm2(k)
+#  define   fsahmv(i,j,k)    ahm2(k)
+#else
+!   default option :               Constant coefficient
+#  define   fsahmt(i,j,k)   ahm0
+#  define   fsahmf(i,j,k)   ahm0
+#  define   fsahmu(i,j,k)   ahm0_blp
+#  define   fsahmv(i,j,k)   ahm0_blp
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90	(revision 3437)
@@ -0,0 +1,262 @@
+MODULE ldfeiv
+   !!======================================================================
+   !!                     ***  MODULE  ldfeiv  ***
+   !! Ocean physics:  variable eddy induced velocity coefficients
+   !!======================================================================
+   !! History :  OPA  ! 1999-03  (G. Madec, A. Jouzeau)  Original code
+   !!   NEMO     1.0  ! 2002-06  (G. Madec)  Free form, F90
+   !!----------------------------------------------------------------------
+#if   defined key_traldf_eiv   &&   defined key_traldf_c2d
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'      and                     eddy induced velocity
+   !!   'key_traldf_c2d'                    2D tracer lateral  mixing coef.
+   !!----------------------------------------------------------------------
+   !!   ldf_eiv      : compute the eddy induced velocity coefficients
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE sbcrnf          ! river runoffs
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE phycst          ! physical constants
+   USE ldfslp          ! iso-neutral slopes
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl          ! Print control
+   USE iom             ! I/O library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   ldf_eiv    ! routine called by step.F90
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_eiv( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_eiv  ***
+      !!
+      !! ** Purpose :   Compute the eddy induced velocity coefficient from the
+      !!              growth rate of baroclinic instability.
+      !!
+      !! ** Method :
+      !!
+      !! ** Action : - uslp , vslp  : i- and j-slopes of neutral surfaces at u- & v-points
+      !!             - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points. 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zfw, ze3w, zn2, zf20, zaht, zaht_min      ! temporary scalars
+      REAL(wp), DIMENSION(:,:), POINTER ::   zn, zah, zhw, zross   ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_eiv')
+      !
+      CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'ldf_eiv : eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+      ENDIF
+      
+      ! 0. Local initialization
+      ! -----------------------
+      zn   (:,:) = 0._wp
+      zhw  (:,:) = 5._wp
+      zah  (:,:) = 0._wp
+      zross(:,:) = 0._wp
+
+
+      ! 1. Compute lateral diffusive coefficient 
+      ! ----------------------------------------
+      IF( ln_traldf_grif ) THEN
+         DO jk = 1, jpk
+#  if defined key_vectopt_loop  
+!CDIR NOVERRCHK 
+            DO ji = 1, jpij   ! vector opt.
+               ! Take the max of N^2 and zero then take the vertical sum
+               ! of the square root of the resulting N^2 ( required to compute
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
+               zn2 = MAX( rn2b(ji,1,jk), 0._wp )
+               zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
+               ! Compute elements required for the inverse time scale of baroclinic
+               ! eddies using the isopycnal slopes calculated in ldfslp.F :
+               ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+               ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
+               zah(ji,1) = zah(ji,1) + zn2 * wslp2(ji,1,jk) * ze3w
+               zhw(ji,1) = zhw(ji,1) + ze3w
+            END DO
+#  else
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+#  endif
+         END DO
+      ELSE
+         DO jk = 1, jpk
+#  if defined key_vectopt_loop  
+!CDIR NOVERRCHK 
+            DO ji = 1, jpij   ! vector opt.
+               ! Take the max of N^2 and zero then take the vertical sum
+               ! of the square root of the resulting N^2 ( required to compute
+               ! internal Rossby radius Ro = .5 * sum_jpk(N) / f
+               zn2 = MAX( rn2b(ji,1,jk), 0._wp )
+               zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)
+               ! Compute elements required for the inverse time scale of baroclinic
+               ! eddies using the isopycnal slopes calculated in ldfslp.F :
+               ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+               ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)
+               zah(ji,1) = zah(ji,1) + zn2 * ( wslpi(ji,1,jk) * wslpi(ji,1,jk)   &
+                  &                          + wslpj(ji,1,jk) * wslpj(ji,1,jk) ) * ze3w
+               zhw(ji,1) = zhw(ji,1) + ze3w
+            END DO
+#  else
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+               DO ji = 2, jpim1
+                  ! Take the max of N^2 and zero then take the vertical sum 
+                  ! of the square root of the resulting N^2 ( required to compute 
+                  ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 
+                  zn2 = MAX( rn2b(ji,jj,jk), 0._wp )
+                  zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk)
+                  ! Compute elements required for the inverse time scale of baroclinic
+                  ! eddies using the isopycnal slopes calculated in ldfslp.F : 
+                  ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))
+                  ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk)
+                  zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                     &                            + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w
+                  zhw(ji,jj) = zhw(ji,jj) + ze3w
+               END DO
+            END DO
+#  endif
+         END DO
+      END IF
+
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+         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
+            aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)
+         END DO
+      END DO
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA R2
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK 
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m)
+               IF( mbkt(ji,jj) <= 20 )   aeiw(ji,jj) = MIN( aeiw(ji,jj), 1000. )
+            END DO
+         END DO
+      ENDIF
+
+      ! Decrease the coefficient in the tropics (20N-20S) 
+      zf20 = 2._wp * omega * sin( rad * 20._wp )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiw(ji,jj) = MIN( 1., ABS( ff(ji,jj) / zf20 ) ) * aeiw(ji,jj)
+         END DO
+      END DO
+
+      ! ORCA R05: Take the minimum between aeiw  and aeiv0
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               aeiw(ji,jj) = MIN( aeiw(ji,jj), aeiv0 )
+            END DO
+         END DO
+      ENDIF
+      CALL lbc_lnk( aeiw, 'W', 1. )      ! lateral boundary condition on aeiw 
+
+
+      ! Average the diffusive coefficient at u- v- points 
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            aeiu(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) )
+            aeiv(ji,jj) = 0.5_wp * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) )
+         END DO 
+      END DO 
+      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )      ! lateral boundary condition
+
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=aeiu, clinfo1=' eiv  - u: ', ovlap=1)
+         CALL prt_ctl(tab2d_1=aeiv, clinfo1=' eiv  - v: ', ovlap=1)
+      ENDIF
+
+      ! ORCA R05: add a space variation on aht (=aeiv except at the equator and river mouth)
+      IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN
+         zf20     = 2._wp * omega * SIN( rad * 20._wp )
+         zaht_min = 100._wp                           ! minimum value for aht
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zaht      = ( 1._wp -  MIN( 1._wp , ABS( ff(ji,jj) / zf20 ) ) ) * ( aht0 - zaht_min )  &
+                  &      + aht0 * rnfmsk(ji,jj)                          ! enhanced near river mouths
+               ahtu(ji,jj) = MAX( MAX( zaht_min, aeiu(ji,jj) ) + zaht, aht0 )
+               ahtv(ji,jj) = MAX( MAX( zaht_min, aeiv(ji,jj) ) + zaht, aht0 )
+               ahtw(ji,jj) = MAX( MAX( zaht_min, aeiw(ji,jj) ) + zaht, aht0 )
+            END DO
+         END DO
+         IF(ln_ctl) THEN
+            CALL prt_ctl(tab2d_1=ahtu, clinfo1=' aht  - u: ', ovlap=1)
+            CALL prt_ctl(tab2d_1=ahtv, clinfo1=' aht  - v: ', ovlap=1)
+            CALL prt_ctl(tab2d_1=ahtw, clinfo1=' aht  - w: ', ovlap=1)
+         ENDIF
+      ENDIF
+
+      IF( aeiv0 == 0._wp ) THEN
+         aeiu(:,:) = 0._wp
+         aeiv(:,:) = 0._wp
+         aeiw(:,:) = 0._wp
+      ENDIF
+
+      CALL iom_put( "aht2d"    , ahtw )   ! lateral eddy diffusivity
+      CALL iom_put( "aht2d_eiv", aeiw )   ! EIV lateral eddy diffusivity
+      !  
+      CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_eiv')
+      !
+   END SUBROUTINE ldf_eiv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Dummy module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE ldf_eiv( kt )       ! Empty routine
+      INTEGER :: kt
+      WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt
+   END SUBROUTINE ldf_eiv
+#endif
+
+   !!======================================================================
+END MODULE ldfeiv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv_substitute.h90	(revision 3437)
@@ -0,0 +1,39 @@
+#if defined key_traldf_eiv   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!                   ***  ldfeiv_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaei. the eddy induced velocity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+#  if defined key_traldf_c3d
+!   'traldf_c3d' :                           eiv: 3D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j,k)
+#    define   fsaeiv(i,j,k)   aeiv(i,j,k)
+#    define   fsaeiw(i,j,k)   aeiw(i,j,k)
+#  elif defined key_traldf_c2d
+!   'traldf_c2d' :                           eiv: 2D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(i,j)
+#    define   fsaeiv(i,j,k)   aeiv(i,j)
+#    define   fsaeiw(i,j,k)   aeiw(i,j)
+#  elif defined key_traldf_c1d
+!   'traldf_c1d' :                           eiv: 1D coefficient
+#    define   fsaeiu(i,j,k)   aeiu(k)
+#    define   fsaeiv(i,j,k)   aeiv(k)
+#    define   fsaeiw(i,j,k)   aeiw(k)
+#  else
+!   Default option :                          eiv: Constant coefficient
+#    define   fsaeiu(i,j,k)   aeiv0
+#    define   fsaeiv(i,j,k)   aeiv0
+#    define   fsaeiw(i,j,k)   aeiv0
+#  endif
+#else
+!   Default option :                         eiv: dummy variables
+#    define   fsaeiu(i,j,k)   aeiv0
+#    define   fsaeiv(i,j,k)   aeiv0
+#    define   fsaeiw(i,j,k)   aeiv0
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90	(revision 3437)
@@ -0,0 +1,823 @@
+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
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                      Rotation of lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)
+   !!   ldf_slp      : calculates the slopes of neutral surface   (Madec operator)
+   !!   ldf_slp_mxl  : calculates the slopes at the base of the mixed layer (Madec operator)
+   !!   ldf_slp_init : initialization of the slopes computation
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! lateral diffusion: traceur
+   USE ldfdyn_oce      ! lateral diffusion: dynamics
+   USE phycst          ! physical constants
+   USE zdfmxl          ! mixed layer depth
+   USE eosbn2          ! equation of states
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_slp        ! routine called by step.F90
+   PUBLIC   ldf_slp_grif   ! routine called by step.F90
+   PUBLIC   ldf_slp_init   ! routine called by opa.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_ldfslp = .TRUE.     !: slopes flag
+   !                                                                             !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator
+   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
+   !                                                                !! Griffies operator
+   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
+
+   !                                                              !! Madec operator
+   !  Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or 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 "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  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 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, iku   ! temporary integer
+      INTEGER  ::   ij0, ij1, ikv   ! temporary integer
+      REAL(wp) ::   zeps, zm1_g, zm1_2g, z1_16, zcofw ! 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), 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 )
+
+      zeps   =  1.e-20_wp        !==   Local constant initialization   ==!
+      z1_16  =  1.0_wp / 16._wp
+      zm1_g  = -1.0_wp / grav
+      zm1_2g = -0.5_wp / grav
+      !
+      zww(:,:,:) = 0._wp
+      zwz(:,:,:) = 0._wp
+      !
+      DO jk = 1, jpk             !==   i- & j-gradient of density   ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               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
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj)
+               zgrv(ji,jj,mbkv(ji,jj)) = grv(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 )
+      !
+      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) / e1u(ji,jj)
+               zav = zgrv(ji,jj,jk) / e2v(ji,jj)
+               zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj  ,jk) )
+               zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji  ,jj+1,jk) )
+               !                                      ! bound the slopes: abs(zw.)<= 1/100 and zb..<0
+               !                                      ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbu = MIN(  zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau )  )
+               zbv = MIN(  zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav )  )
+               !                                      ! uslp and vslp output in zwz and zww, resp.
+               zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) )
+               zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) )
+               zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps )                                              &
+                  &                   + zfi  * uslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk)
+               zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps )                                              &
+                  &                   + zfj  * vslpml(ji,jj)                                                     &
+                  &                          * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) )   &
+                  &                          / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk)
+!!gm  modif to suppress omlmask.... (as in Griffies case)
+!               !                                         ! jk must be >= ML level for zf=1. otherwise  zf=0.
+!               zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp )
+!               zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp )
+!               zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) )
+!               zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) )
+!               zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      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 * tmask (ji,jj,jk)
+               zaj =    (  zgrv (ji,jj-1,jk  ) + zgrv (ji,jj,jk-1)           &
+                  &      + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk  )   ) / zcj * tmask (ji,jj,jk)
+               !                                        ! bound the slopes: abs(zw.)<= 1/100 and zb..<0.
+               !                                        ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+               zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai )  )
+               zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj )  )
+               !                                        ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.)
+               zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) )   ! zfk=1 in the ML otherwise zfk=0
+               zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )
+               zwz(ji,jj,jk) = (  zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+               zww(ji,jj,jk) = (  zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk  ) * tmask(ji,jj,jk)
+
+!!gm  modif to suppress omlmask....  (as in Griffies operator)
+!               !                                         ! jk must be >= ML level for zfk=1. otherwise  zfk=0.
+!               zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp )
+!               zck = fsdepw(ji,jj,jk)    / MAX( hmlp(ji,jj), 10. )
+!               zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!               zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk)
+!!gm end modif
+            END DO
+         END DO
+      END DO
+      CALL lbc_lnk( zwz, 'T', -1. )   ;    CALL lbc_lnk( zww, 'T', -1. )      ! lateral boundary conditions
+      !
+      !                                           !* horizontal Shapiro filter
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1, MAX(1, jpj-3)                        ! rows jj=2 and =jpjm1 only
+            DO ji = 2, jpim1
+               zcofw = tmask(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 = tmask(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 along coastal boundaries
+         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
+
+      ! III.  Specific grid points
+      ! ===========================
+      !
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN     !  ORCA_R4 configuration: horizontal diffusion in specific area
+         !                                                    ! Gibraltar Strait
+         ij0 =  50   ;   ij1 =  53
+         ii0 =  69   ;   ii1 =  71   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ij0 =  51   ;   ij1 =  53
+         ii0 =  68   ;   ii1 =  71   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  69   ;   ii1 =  71   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         !
+         !                                                    ! Mediterrannean Sea
+         ij0 =  49   ;   ij1 =  56
+         ii0 =  71   ;   ii1 =  90   ;   uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ij0 =  50   ;   ij1 =  56
+         ii0 =  70   ;   ii1 =  90   ;   vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+         ii0 =  71   ;   ii1 =  90   ;   wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp
+      ENDIF
+
+
+      ! 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 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp')
+      !
+   END SUBROUTINE ldf_slp
+
+
+   SUBROUTINE ldf_slp_grif ( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldf_slp_grif  ***
+      !!
+      !! ** Purpose :   Compute the squared slopes of neutral surfaces (slope
+      !!      of iso-pycnal surfaces referenced locally) (ln_traldf_grif=T)
+      !!      at W-points using the Griffies quarter-cells.
+      !!
+      !! ** Method  :   calculates alpha and beta at T-points
+      !!
+      !! ** Action : - triadi_g, triadj_g   T-pts i- and j-slope triads relative to geopot. (used for eiv)
+      !!             - triadi , triadj    T-pts i- and j-slope triads relative to model-coordinate
+      !!             - wslp2              squared slope of neutral surfaces at w-points.
+      !!----------------------------------------------------------------------
+      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, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj
+      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
+      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_grif')
+      !
+      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  !
+      !--------------------------------!
+      !
+      CALL eos_alpbet( tsb, zalbet, zbeta0 )  !==  before local thermal/haline expension ratio at T-points  ==!
+      !
+      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 = ( - zalbet(ji+ip,jj   ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / 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
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi            ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  iku  = mbku(ji,jj)          ;   ikv  = mbkv(ji,jj)             ! 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 = ( - zalbet(ji+ip,jj   ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)
+                  zdyrho_raw = ( - zalbet(ji   ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / 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 ) / fse3w(ji,jj,jk+kp)
+                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )    ! force zdzrho >= repsln
+                 END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jj = 1, jpj                          !==  Reciprocal depth of the w-point below ML base  ==!
+         DO ji = 1, jpi
+            jk = MIN( nmln(ji,jj), mbkt(ji,jj) ) + 1     ! MIN in case ML depth is the ocean depth
+            z1_mlbw(ji,jj) = 1._wp / fsdepw(ji,jj,jk)
+         END DO
+      END DO
+      !
+      !                                       !==  intialisations to zero  ==!
+      !
+      wslp2  (:,:,:)     = 0._wp              ! wslp2 will be cumulated 3D field set to zero
+      triadi_g(:,:,1,:,:) = 0._wp   ;   triadi_g(:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj_g(:,:,1,:,:) = 0._wp   ;   triadj_g(:,:,jpk,:,:) = 0._wp
+      !!gm _iso set to zero missing
+      triadi  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp   ! set surface and bottom slope to zero
+      triadj  (:,:,1,:,:) = 0._wp   ;   triadj  (:,:,jpk,:,:) = 0._wp
+
+      !-------------------------------------!
+      !  Triads just below the Mixed Layer  !
+      !-------------------------------------!
+      !
+      DO jl = 0, 1                            ! calculate slope of the 4 triads immediately ONE level below mixed-layer base
+         DO kp = 0, 1                         ! with only the slope-max limit   and   MASKED
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1
+                  ip = jl   ;   jp = jl
+                  jk = MIN( nmln(ji+ip,jj) , mbkt(ji+ip,jj) ) + 1         ! ML level+1 (MIN in case ML depth is the ocean depth)
+                  ! 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)      &
+                     &      - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) / e1u(ji,jj)  ) * umask(ji,jj,jk)
+                  jk = MIN( nmln(ji,jj+jp) , mbkt(ji,jj+jp) ) + 1
+                  ztj_g_raw = (  zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp)      &
+                     &      - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj)  ) * vmask(ji,jj,jk)
+                  zti_mlb(ji+ip,jj   ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                  ztj_mlb(ji   ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+               END DO
+            END DO
+         END DO
+      END DO
+
+      !-------------------------------------!
+      !  Triads with surface limits         !
+      !-------------------------------------!
+      !
+      DO kp = 0, 1                            ! k-index of triads
+         DO jl = 0, 1
+            ip = jl   ;   jp = jl             ! i- and j-indices of triads (i-k and j-k planes)
+            DO jk = 1, jpkm1
+               ! 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 * ( fsdept(ji+1,jj  ,jk) - fsdept(ji,jj,jk) ) / e1u(ji,jj)
+                     ztj_coord = znot_thru_surface * ( fsdept(ji  ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)                  ! unmasked
+                     zti_g_raw = zti_raw - zti_coord      ! ref to geopot surfaces
+                     ztj_g_raw = ztj_raw - ztj_coord
+                     zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw )
+                     ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw )
+                     !
+                     ! Below  ML use limited zti_g as is & 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)   &
+                        &                           * fsdepw(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)   &
+                        &                           * fsdepw(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**2 / zti_raw
+                        ztj_raw = ztj_lim**2 / 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
+                     triadi(ji+ip,jj   ,jk,1-ip,kp) = zti_lim
+                     triadj(ji   ,jj+jp,jk,1-jp,kp) = ztj_lim
+                    !
+                     zbu = e1u(ji    ,jj) * e2u(ji   ,jj) * fse3u(ji   ,jj,jk   )
+                     zbv = e1v(ji    ,jj) * e2v(ji   ,jj) * fse3v(ji   ,jj,jk   )
+                     zbti = e1t(ji+ip,jj) * e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)
+                     zbtj = e1t(ji,jj+jp) * e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)
+                     !
+                     !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers....  ==> to be checked
+                     wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2      ! masked
+                     wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2
+                  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_grif')
+      !
+   END SUBROUTINE ldf_slp_grif
+
+
+   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            ! 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
+      !
+      uslpml (1,:) = 0._wp      ;      uslpml (jpi,:) = 0._wp
+      vslpml (1,:) = 0._wp      ;      vslpml (jpi,:) = 0._wp
+      wslpiml(1,:) = 0._wp      ;      wslpiml(jpi,:) = 0._wp
+      wslpjml(1,:) = 0._wp      ;      wslpjml(jpi,:) = 0._wp
+      !
+      !                                            !==   surface mixed layer mask   !
+      DO jk = 1, jpk                               ! =1 inside the mixed layer, =0 otherwise
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij                        ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+# endif
+               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.
+      !-----------------------------------------------------------------------
+      !
+# if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+# endif
+            !                        !==   Slope at u- & v-points just below the Mixed Layer   ==!
+            !
+            !                        !- vertical density gradient for u- and v-slopes (from dzr at T-point)
+            iku = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1  )   ! ML (MAX of T-pts, bound by jpkm1)
+            ikv = MIN(  MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1  )   !
+            zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj  ,iku) )
+            zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji  ,jj+1,ikv) )
+            !                        !- horizontal density gradient at u- & v-points
+            zau = p_gru(ji,jj,iku) / e1u(ji,jj)
+            zav = p_grv(ji,jj,ikv) / e2v(ji,jj)
+            !                        !- bound the slopes: abs(zw.)<= 1/100 and zb..<0
+            !                           kxz max= ah slope max =< e1 e3 /(pi**2 2 dt)
+            zbu = MIN(  zbu , -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau )  )
+            zbv = MIN(  zbv , -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(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/fse3w(ji,jj,ik)* ABS( zai )  )
+            zbj = MIN(  zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj )  )
+            !                        !- i- & j-slope at w-points (wslpiml, wslpjml)
+            wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)
+            wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)
+         END DO
+      END DO
+      !!gm this lbc_lnk should be useless....
+      CALL lbc_lnk( uslpml , 'U', -1. )   ;   CALL lbc_lnk( vslpml , 'V', -1. )   ! lateral boundary cond. (sign change)
+      CALL lbc_lnk( wslpiml, 'W', -1. )   ;   CALL lbc_lnk( wslpjml, 'W', -1. )   ! lateral boundary conditions
+      !
+      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  :   read the nammbf namelist and check the parameter
+      !!      values called by tra_dmp at the first timestep (nit000)
+      !!----------------------------------------------------------------------
+      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
+
+      IF( ln_traldf_grif ) THEN        ! Griffies operator : triad of slopes
+         ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr )
+         ALLOCATE( triadi  (jpi,jpj,jpk,0:1,0:1) , triadj  (jpi,jpj,jpk,0:1,0:1)                      , STAT=ierr )
+         IF( ierr > 0             )   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
+         ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) ,                &
+            &   omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj)   , vslpml(jpi,jpj)    , wslpiml(jpi,jpj)   , wslpjml(jpi,jpj) , STAT=ierr )
+         IF( ierr > 0 )   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.....
+         IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .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 fsdep has positive value )
+            DO jk = 1, jpk
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk)
+                     vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk)
+                     wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5
+                     wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5
+                  END DO
+               END DO
+            END DO
+            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. )
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_slp_init')
+      !
+   END SUBROUTINE ldf_slp_init
+
+#else
+   !!------------------------------------------------------------------------
+   !!   Dummy module :                 NO Rotation of lateral mixing tensor
+   !!------------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_ldfslp = .FALSE.    !: slopes flag
+CONTAINS
+   SUBROUTINE ldf_slp( kt, prd, pn2 )   ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2
+      WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)
+   END SUBROUTINE ldf_slp
+   SUBROUTINE ldf_slp_grif( kt )        ! Dummy routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt
+   END SUBROUTINE ldf_slp_grif
+   SUBROUTINE ldf_slp_init              ! Dummy routine
+   END SUBROUTINE ldf_slp_init
+#endif
+
+   !!======================================================================
+END MODULE ldfslp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90	(revision 3437)
@@ -0,0 +1,171 @@
+MODULE ldftra
+   !!======================================================================
+   !!                       ***  MODULE  ldftra  ***
+   !! Ocean physics:  lateral diffusivity coefficient 
+   !!=====================================================================
+   !! 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)  
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   ldf_tra_init : initialization, namelist read, and parameters control
+   !!   ldf_tra_c3d   : 3D eddy viscosity coefficient initialization
+   !!   ldf_tra_c2d   : 2D eddy viscosity coefficient initialization
+   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfslp          ! ???
+   USE in_out_manager  ! I/O manager
+   USE ioipsl
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   ldf_tra_init   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE ldf_tra_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_tra_init  ***
+      !! 
+      !! ** Purpose :   initializations of the tracer lateral mixing coeff.
+      !!
+      !! ** Method  :   the Eddy diffusivity and eddy induced velocity ceoff.
+      !!      are defined as follows:
+      !!         default option   : constant coef. aht0, aeiv0 (namelist)
+      !!        'key_traldf_c1d': depth dependent coef. defined in 
+      !!                            in ldf_tra_c1d routine
+      !!        'key_traldf_c2d': latitude and longitude dependent coef.
+      !!                            defined in ldf_tra_c2d routine
+      !!        'key_traldf_c3d': latitude, longitude, depth dependent coef.
+      !!                            defined in ldf_tra_c3d routine
+      !!
+      !!      N.B. User defined include files.  By default, 3d and 2d coef.
+      !!      are set to a constant value given in the namelist and the 1d
+      !!      coefficients are initialized to a hyperbolic tangent vertical
+      !!      profile.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio               ! temporary integer
+      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout
+      !! 
+      NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  &
+         &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   &
+         &                 ln_traldf_grif , ln_traldf_gdia,                   &
+         &                 ln_triad_iso   , ln_botmix_grif,                   &
+         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0,       &
+         &                 rn_slpmax
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral tracer physics parameters
+      ! =============================================
+    
+      REWIND( numnam )                  ! Read Namelist namtra_ldf : Lateral physics on tracers
+      READ  ( numnam, 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,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap
+         WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap
+         WRITE(numout,*) '      iso-level                     ln_traldf_level = ', ln_traldf_level
+         WRITE(numout,*) '      horizontal (geopotential)     ln_traldf_hor   = ', ln_traldf_hor
+         WRITE(numout,*) '      iso-neutral                   ln_traldf_iso   = ', ln_traldf_iso
+         WRITE(numout,*) '      iso-neutral (Griffies)        ln_traldf_grif  = ', ln_traldf_grif
+         WRITE(numout,*) '      Griffies strmfn diagnostics   ln_traldf_gdia  = ', ln_traldf_gdia
+         WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0
+         WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0
+         WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0
+         WRITE(numout,*) '      maximum isoppycnal slope      rn_slpmax       = ', rn_slpmax
+         WRITE(numout,*) '      pure lateral mixing in ML     ln_triad_iso    = ', ln_triad_iso
+         WRITE(numout,*) '      lateral mixing on bottom      ln_botmix_grif  = ', ln_botmix_grif
+         WRITE(numout,*)
+      ENDIF
+
+      !                                ! convert DOCTOR namelist names into OLD names
+      aht0  = rn_aht_0
+      ahtb0 = rn_ahtb_0
+      aeiv0 = rn_aeiv_0
+
+      !                                ! Parameter control
+
+      ! ... Check consistency for type and direction :
+      !           ==> will be done in traldf module
+
+      ! ... Space variation of eddy coefficients
+      ioptio = 0
+#if defined key_traldf_c3d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude, depth)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c2d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( latitude, longitude)'
+      ioptio = ioptio + 1
+#endif
+#if defined key_traldf_c1d
+      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )'
+      ioptio = ioptio + 1
+      IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' )
+#endif
+      IF( ioptio == 0 ) THEN
+          IF(lwp) WRITE(numout,*) '          tracer mixing coef. = constant (default option)'
+        ELSEIF( ioptio > 1 ) THEN
+           CALL ctl_stop('          use only one of the following keys:',   &
+             &           ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' )
+      ENDIF
+
+      IF( ln_traldf_bilap ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' )
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' )
+      ENDIF
+
+
+      !  Lateral eddy diffusivity and eddy induced velocity coefficients
+      ! ================================================================
+#if defined key_traldf_c3d
+      CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth )
+#elif defined key_traldf_c2d
+      CALL ldf_tra_c2d( ll_print )      ! aht = 2D coef. = F( longitude, latitude )
+#elif defined key_traldf_c1d
+      CALL ldf_tra_c1d( ll_print )      ! aht = 1D coef. = F( depth )
+#else
+                                        ! Constant coefficients
+      IF(lwp)WRITE(numout,*)
+      IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0
+      ENDIF
+#endif
+      !
+   END SUBROUTINE ldf_tra_init
+
+#if defined key_traldf_c3d
+#   include "ldftra_c3d.h90"
+#elif defined key_traldf_c2d
+#   include "ldftra_c2d.h90"
+#elif defined key_traldf_c1d
+#   include "ldftra_c1d.h90"
+#endif
+
+   !!======================================================================
+END MODULE ldftra
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90	(revision 3437)
@@ -0,0 +1,129 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c1d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c1d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c1d  ***
+      !!              
+      !! ** Purpose :   1D eddy diffusivity coefficient
+      !!
+      !! ** Method  :   1D eddy diffusivity coefficients ( depth )
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator      : ahtt never used
+      !!          -1-  iso-model level: ahtu = ahtv defined at T-level
+      !!                                ahtw never used
+      !!          -2-  isopycnal or   : ahtu = ahtv defined at T-level
+      !!               geopotential     ahtw defined at w-level
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic      : aeiu = aeiv defined at T-level
+      !!				  aeiw defined at w-level
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
+      !
+      INTEGER  ::   jk   ! dummy loop indices
+      REAL(wp) ::   zkah, zahr, za00 , za01    ! local scalars
+      REAL(wp) ::   zahf, zahs, zahtf, zahts   !   -      -
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN 
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ldf_tra_c1d : 1D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- ' 
+         IF(lwp) WRITE(numout,*)
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' inildf : 1D eddy diffusivity coefficient '
+         IF(lwp) WRITE(numout,*) ' ~~~~~~   -- '
+         IF(lwp) WRITE(numout,*)
+      ENDIF
+
+      ! initialization of the profile
+
+      ! ahts, ahtf: surface and bottom values
+      zahts = aht0
+      zahtf = aht0/4. 
+      ! zkah, zahr: depth of the inflection pt and width of inflection
+      zkah =  -300.
+      zahr =   300.
+      ! computation coefficients
+      za00 = TANH( ( -fsdept(1,1,1  ) - zkah ) / zahr )
+      za01 = TANH( ( -fsdept(1,1,jpk) - zkah ) / zahr )
+      zahf = ( zahts-zahtf ) / ( za00 - za01 )
+      zahs = zahts - zahf * za00
+
+      ! biharmonic operator : (T-point)
+      ! ==================== 
+
+      ! set ahtt at T-level
+      DO jk = 1, jpk
+         ahtt(jk) = zahs + zahf * TANH( (-fsdept(1,1,jk)-zkah) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '         aht profile at T-level : '
+         WRITE(numout,*)
+         WRITE(numout,*) ' level    aht          depth t-level '
+         DO jk = 1, jpk
+            WRITE(numout,'(i6,2f12.4)') jk, ahtt(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ================== 
+
+      ! set ahtu = ahtv at T-level, and ahtw at w-level
+      DO jk = 1, jpk
+         ahtu(jk) = zahs + zahf * TANH( ( -fsdept(1,1,jk) - zkah ) / zahr )
+         ahtv(jk) = ahtu(jk)
+         ahtw(jk) = zahs + zahf * TANH( ( -fsdepw(1,1,jk) - zkah ) / zahr )
+      END DO
+
+      ! control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' level    aht          depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, ahtu(jk), fsdept(1,1,jk)
+         END DO
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aht profile at W-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aht          depth w-level '
+         DO jk = 1, jpk
+            IF(lwp)WRITE(numout,"(i6,2f12.4)") jk, ahtw(jk), fsdepw(1,1,jk)
+         END DO
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv and set aeiw (here same profile as on aht)
+      aeiu(:) = ahtu(:)
+      aeiv(:) = aeiu(:)
+      aeiw(:) = ahtw(:)
+      
+      ! Control print
+      IF(lwp .AND. ld_print ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '         aeiv profile at T-level : '
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '  jk      aeiv           depth t-level '
+         DO jk = 1, jpk
+            IF(lwp) WRITE(numout,"(i6,2f12.4)") jk, aeiu(jk), fsdept(1,1,jk)
+         END DO
+      ENDIF
+#endif
+      !
+   END SUBROUTINE ldf_tra_c1d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90	(revision 3437)
@@ -0,0 +1,165 @@
+   !!----------------------------------------------------------------------
+   !!                      ***  ldftra_c2d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c2d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldftra_c2d  ***
+      !!              
+      !! ** Purpose :   initializations of horizontally non uniform eddy 
+      !!      diffusivity coefficients
+      !!
+      !! ** Method :
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!       harmonic operator (ahtt never used)
+      !!           iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential   
+      !!       eddy induced velocity
+      !!           always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!----------------------------------------------------------------------
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, print arrays in numout
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+# if defined key_orca_r4
+      INTEGER :: i1, i2, j1, j2
+# endif
+      REAL(wp) ::   za00, zd_max, zeumax, zevmax, zetmax
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  induced velocity coefficients'
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --'
+      ENDIF
+
+      zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+      IF( lk_mpp ) CALL mpp_max( zd_max )   ! max over the global domain
+
+      ! harmonic operator : (U-, V-, W-points)
+      ! ==================
+      IF( ln_traldf_lap ) THEN
+         !
+         za00 = aht0 / zd_max
+         !
+         DO jj = 1, jpj 
+            DO ji = 1, jpi 
+               zeumax = MAX( e1u(ji,jj), e2u(ji,jj) ) 
+               zevmax = MAX( e1v(ji,jj), e2v(ji,jj) ) 
+               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
+               ahtu(ji,jj) = za00 * zeumax ! set ahtu = ahtv at u- and v-points, 
+               ahtv(ji,jj) = za00 * zevmax ! and ahtw at w-point (idem T-point) 
+               ahtw(ji,jj) = za00 * zetmax ! 
+            END DO
+         END DO
+
+         CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+         CALL lbc_lnk( ahtv, 'V', 1. )   ! (no change of sign)
+         CALL lbc_lnk( ahtw, 'W', 1. )
+
+         ! Special case for ORCA R2 and R4 configurations (overwrite the value of ahtu ahtv ahtw)
+         ! ==============================================
+         IF( cp_cfg == "orca" .AND. ( jp_cfg == 2 .OR. jp_cfg == 4 ) )   THEN
+            ahtu(:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
+            ahtv(:,:) = aht0              ! and ahtw at w-point
+            ahtw(:,:) = aht0              ! (here : no space variation)
+            IF(lwp) WRITE(numout,*) '               ORCA R2 or R4 case'
+            IF(lwp) WRITE(numout,*) '               Constant values used for eddy diffusivity coefficients'
+            IF(lwp) WRITE(numout,*) '               Variation lat/lon only for eddy induced velocity coefficients'
+         ENDIF
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtu array'
+            CALL prihre( ahtu, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtv array'
+            CALL prihre( ahtv, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: ahtw array'
+            CALL prihre( ahtw, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+         ENDIF
+      ENDIF
+      
+      ! biharmonic operator : (T-point)
+      ! ====================
+      IF( ln_traldf_bilap ) THEN
+         ! (USER: modify ahtt following your desiderata)
+         ! Here: ahm is proportional to the cube of the maximum of the gridspacing
+         !       in the to horizontal direction
+
+         zd_max = MAX( MAXVAL( e1t(:,:) ), MAXVAL( e2t(:,:) ) )
+         IF( lk_mpp )   CALL mpp_max( zd_max )   ! max over the global domain
+
+         za00 = aht0 / ( zd_max * zd_max * zd_max )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zetmax = MAX( e1t(ji,jj), e2t(ji,jj) )
+               ahtt(ji,jj) = za00 * zetmax * zetmax * zetmax      ! set ahtt at T-point
+            END DO
+         END DO
+
+         CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+         ! Control print
+         IF( lwp .AND. ld_print ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'inildf: 2D ahtt array'
+            CALL prihre( ahtt, jpi, jpj, 1, jpi, 1,   &
+               &                         1, jpj, 1, 1.e-3, numout )
+         ENDIF
+      ENDIF
+
+# if defined key_traldf_eiv
+      ! set aeiu = aeiv at u- and v-points, and aeiw at w-point (idem T-point)
+      ! (here no space variation)
+      aeiu(:,:) = aeiv0
+      aeiv(:,:) = aeiv0
+      aeiw(:,:) = aeiv0
+      
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) ) = 0.e0
+      ENDIF
+
+      ! Lateral boundary conditions on ( aeiu, aeiv, aeiw )
+      CALL lbc_lnk( aeiu, 'U', 1. )
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+
+      ! Control print
+      IF( lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu array'
+         CALL prihre(aeiu,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv array'
+         CALL prihre(aeiv,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw array'
+         CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+# endif
+      !
+   END SUBROUTINE ldf_tra_c2d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90	(revision 3437)
@@ -0,0 +1,124 @@
+   !!----------------------------------------------------------------------
+   !!                        ***  ldftra_c3d.h90  ***
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_tra_c3d( ld_print )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE ldftra_c3d  ***
+      !!                
+      !! ** Purpose :
+      !!     initializations of non uniform horizontal eddy diffusivity coef.
+      !!
+      !! ** Method :
+      !!      3D eddy diffusivity coefficients ( longitude, latitude, depth )
+      !!
+      !!       biharmonic operator    : ahtt = defined at T-level
+      !!                                ahtu,ahtv,ahtw never used
+      !!
+      !!       harmonic operator (ahtt never used)
+      !!         iso-model level   : ahtu, ahtv defined at u-, v-points
+      !!         isopycnal         : ahtu, ahtv, ahtw defined at u-, v-, w-pts
+      !!         or geopotential
+      !!
+      !!       eddy induced velocity
+      !!         always harmonic   : aeiu, aeiv, aeiw defined at u-, v-, w-pts
+      !!----------------------------------------------------------------------
+      USE ioipsl
+      !
+      LOGICAL, INTENT (in) ::   ld_print   ! If true, output arrays on numout
+      !!----------------------------------------------------------------------
+
+      IF( lk_traldf_eiv ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity and eddy induced velocity coefficients'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   --  '
+         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
+      ELSE
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' ldf_tra_c3d : 3D eddy diffusivity coefficient'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~   -- '
+         IF(lwp) WRITE(numout,*) '               Coefficients set to constant'
+      ENDIF
+
+
+      ! biharmonic operator   (T-point)
+      ! -------------------
+
+      ahtt(:,:,:) = aht0              ! set ahtt at T-point (here no space variation)
+
+      CALL lbc_lnk( ahtt, 'T', 1. )   ! Lateral boundary conditions on ( ahtt )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtt at k = 1'
+         CALL prihre( ahtt(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+
+      ! harmonic operator   (U-, V-, W-points)
+      ! ----------------- 
+
+      ahtu(:,:,:) = aht0              ! set ahtu = ahtv at u- and v-points,
+      ahtv(:,:,:) = aht0              ! and ahtw at w-point
+      ahtw(:,:,:) = aht0              ! (here example: no space variation)
+      
+      CALL lbc_lnk( ahtu, 'U', 1. )   ! Lateral boundary conditions
+      CALL lbc_lnk( ahtv, 'V', 1. )
+      CALL lbc_lnk( ahtw, 'W', 1. )
+
+      IF(lwp .AND. ld_print ) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtu at k = 1'
+         CALL prihre( ahtu(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtv at k = 1'
+         CALL prihre( ahtv(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: ahtw at k = 1'
+         CALL prihre( ahtw(:,:,1), jpi, jpj, 1, jpi, 1,   &
+            &                                1, jpj, 1, 1.e-3, numout )
+      ENDIF
+
+# if defined key_traldf_eiv
+      aeiu(:,:,:) = aeiv0            ! set aeiu = aeiv at u- and v-points,
+      aeiv(:,:,:) = aeiv0            ! and aeiw at w-point
+      aeiw(:,:,:) = aeiv0            ! (here example: no space variation)
+
+      IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN
+         !                                 ! Cancel eiv in Gibraltar strait
+         aeiu( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiv( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         aeiw( mi0(68):mi1(71) , mj0(50):mj1(53) , : ) = 0.e0
+         !                                 ! Cancel eiv in Mediterrannean sea
+         aeiu( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiv( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+         aeiw( mi0(70):mi1(90) , mj0(49):mj1(56) , : ) = 0.e0
+      ENDIF
+
+      CALL lbc_lnk( aeiu, 'U', 1. )   ! Lateral boundary conditions 
+      CALL lbc_lnk( aeiv, 'V', 1. )
+      CALL lbc_lnk( aeiw, 'W', 1. )
+# endif
+
+      IF(lwp .AND. ld_print ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiu at k = 1'
+         CALL prihre(aeiu(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiv at k = 1'
+         CALL prihre(aeiv(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+         WRITE(numout,*)
+         WRITE(numout,*) 'inildf: aeiw at k = 1'
+         CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout)
+      ENDIF
+      !
+   END SUBROUTINE ldf_tra_c3d
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90	(revision 3437)
@@ -0,0 +1,120 @@
+MODULE ldftra_oce
+   !!=====================================================================
+   !!                      ***  MODULE  ldftra_oce  ***
+   !! Ocean physics :  lateral tracer mixing coefficient defined in memory 
+   !!=====================================================================
+   !! History :  9.0  !  2002-11  (G. Madec)  Original code
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90
+
+   !!----------------------------------------------------------------------
+   !! Lateral eddy diffusivity coefficients (tracers)
+   !!----------------------------------------------------------------------
+   !                                                !!* Namelist namtra_ldf : lateral mixing *
+   LOGICAL , PUBLIC ::   ln_traldf_lap   = .TRUE.    !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_traldf_bilap = .FALSE.   !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_traldf_level = .FALSE.   !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_traldf_hor   = .FALSE.   !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.    !: iso-neutral direction
+   LOGICAL , PUBLIC ::   ln_traldf_grif  = .FALSE.   !: griffies skew flux
+   LOGICAL , PUBLIC ::   ln_traldf_gdia  = .FALSE.   !: griffies skew flux streamfunction diagnostics
+   REAL(wp), PUBLIC ::   rn_aht_0        = 2000._wp  !: lateral eddy diffusivity (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahtb_0       =    0._wp  !: lateral background eddy diffusivity (m2/s)
+   REAL(wp), PUBLIC ::   rn_aeiv_0       = 2000._wp  !: eddy induced velocity coefficient (m2/s)
+   REAL(wp), PUBLIC ::   rn_slpmax       = 0.01_wp   !: slope limit
+
+   REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names
+   LOGICAL , PUBLIC ::   ln_triad_iso    = .FALSE.   !: calculate triads twice
+   LOGICAL , PUBLIC ::   ln_botmix_grif  = .FALSE.   !: mixing on bottom
+   LOGICAL , PUBLIC ::   l_grad_zps      = .FALSE.   !: special treatment for Horz Tgradients w partial steps 
+
+   REAL(wp), PUBLIC ::   rldf                        !: multiplicative factor of diffusive coefficient
+                                                     !: Needed to define the ratio between passive and active tracer diffusion coef. 
+
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-,U-,V-,W-points
+#else
+   REAL(wp), PUBLIC                                      ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-,U-,V-,W-points
+#endif
+
+#if defined key_traldf_eiv
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'                              eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER               ::   lk_traldf_eiv   = .TRUE.   !: eddy induced velocity flag
+   
+   !                                                                              !!! eddy coefficients at U-, V-, W-points  [m2/s]
+# if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aeiu , aeiv , aeiw   !: ** 3D coefficients **
+# elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   aeiu , aeiv , aeiw   !: ** 2D coefficients **
+# elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   aeiu , aeiv , aeiw   !: ** 1D coefficients **
+# else
+   REAL(wp), PUBLIC                                      ::   aeiu , aeiv , aeiw   !: ** 0D coefficients **
+# endif
+# if defined key_diaeiv
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s]
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                           NO eddy induced velocity
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag
+   REAL(wp), PUBLIC            ::   aeiu, aeiv, aeiw            !: eddy induced coef. (not used)
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION ldftra_oce_alloc()
+     !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION ldftra_oce_alloc  ***
+     !!----------------------------------------------------------------------
+     INTEGER, DIMENSION(3) :: ierr
+     !!----------------------------------------------------------------------
+     ierr(:) = 0
+
+#if defined key_traldf_c3d
+      ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) )
+#elif defined key_traldf_c2d
+      ALLOCATE( ahtt(jpi,jpj    ) , ahtu(jpi,jpj    ) , ahtv(jpi,jpj    ) , ahtw(jpi,jpj    ) , STAT=ierr(1) )
+#elif defined key_traldf_c1d
+      ALLOCATE( ahtt(        jpk) , ahtu(        jpk) , ahtv(        jpk) , ahtw(        jpk) , STAT=ierr(1) )
+#endif
+      !
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+      ALLOCATE( aeiu(jpi,jpj,jpk) , aeiv(jpi,jpj,jpk) , aeiw(jpi,jpj,jpk) , STAT=ierr(2) )
+# elif defined key_traldf_c2d
+      ALLOCATE( aeiu(jpi,jpj    ) , aeiv(jpi,jpj    ) , aeiw(jpi,jpj    ) , STAT=ierr(2) )
+# elif defined key_traldf_c1d
+      ALLOCATE( aeiu(        jpk) , aeiv(        jpk) , aeiw(        jpk) , STAT=ierr(2) )
+# endif
+# if defined key_diaeiv
+      ALLOCATE( u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), STAT=ierr(3))
+# endif
+#endif
+      ldftra_oce_alloc = MAXVAL( ierr )
+      IF( ldftra_oce_alloc /= 0 )   CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION ldftra_oce_alloc
+
+   !!=====================================================================
+END MODULE ldftra_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_substitute.h90	(revision 3437)
@@ -0,0 +1,36 @@
+   !!----------------------------------------------------------------------
+   !!                    *** ldftra_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute fsaht. the eddy diffusivity coeff.
+   !!      with a constant or 1D or 2D or 3D array, using CPP macro.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+#if defined key_traldf_c3d
+!   'key_traldf_c3d' :                 aht: 3D coefficient
+#       define   fsahtt(i,j,k)   rldf * ahtt(i,j,k)
+#       define   fsahtu(i,j,k)   rldf * ahtu(i,j,k)
+#       define   fsahtv(i,j,k)   rldf * ahtv(i,j,k)
+#       define   fsahtw(i,j,k)   rldf * ahtw(i,j,k)
+#elif defined key_traldf_c2d
+!   'key_traldf_c2d' :                 aht: 2D coefficient
+#       define   fsahtt(i,j,k)   rldf * ahtt(i,j)
+#       define   fsahtu(i,j,k)   rldf * ahtu(i,j)
+#       define   fsahtv(i,j,k)   rldf * ahtv(i,j)
+#       define   fsahtw(i,j,k)   rldf * ahtw(i,j)
+#elif defined key_traldf_c1d
+!   'key_traldf_c1d' :                aht: 1D coefficient
+#       define   fsahtt(i,j,k)   rldf * ahtt(k)
+#       define   fsahtu(i,j,k)   rldf * ahtu(k)
+#       define   fsahtv(i,j,k)   rldf * ahtv(k)
+#       define   fsahtw(i,j,k)   rldf * ahtw(k)
+#else
+!   Default option :             aht: Constant coefficient
+#      define   fsahtt(i,j,k)   rldf * aht0
+#      define   fsahtu(i,j,k)   rldf * aht0
+#      define   fsahtv(i,j,k)   rldf * aht0
+#      define   fsahtw(i,j,k)   rldf * aht0
+#endif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_oce.F90	(revision 3437)
@@ -0,0 +1,285 @@
+MODULE obc_oce
+   !!==============================================================================
+   !!                       ***  MODULE obc_oce   ***
+   !! Open Boundary Cond. :   define related variables
+   !!==============================================================================
+   !! history :  OPA  ! 1991-01 (CLIPPER)  Original code 
+   !!   NEMO     1.0  ! 2002-02 (C. Talandier)  modules, F90
+   !!----------------------------------------------------------------------
+#if defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_obc' :                                 Open Boundary Condition
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+   USE obc_par         ! open boundary condition parameters
+
+   IMPLICIT NONE
+   PUBLIC
+   
+   PUBLIC   obc_oce_alloc   ! called by obcini.F90 module
+
+   !!----------------------------------------------------------------------
+   !! open boundary variables
+   !!----------------------------------------------------------------------
+   !
+   !                                            !!* Namelist namobc: open boundary condition *
+   INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data
+   !                                             !   = 1 read obc data in obcxxx.dta files
+   CHARACTER(len=20) ::   cn_obcdta   = 'annual' !: set to annual  if obc datafile hold 1 year of data
+   !                                             !  set to monthly if obc datafile hold 1 month of data
+   LOGICAL           ::   ln_obc_clim = .true.   !:  obc data files are climatological
+   LOGICAL           ::   ln_obc_fla  = .false.  !:  Flather open boundary condition not used
+   LOGICAL           ::   ln_vol_cst  = .true.   !:  Conservation of the whole volume
+   REAL(wp)          ::   rn_dpein    =  1.      !: damping time scale for inflow at East open boundary
+   REAL(wp)          ::   rn_dpwin    =  1.      !:    "                      "   at West open boundary
+   REAL(wp)          ::   rn_dpsin    =  1.      !:    "                      "   at South open boundary
+   REAL(wp)          ::   rn_dpnin    =  1.      !:    "                      "   at North open boundary
+   REAL(wp)          ::   rn_dpeob    = 15.      !: damping time scale for the climatology at East open boundary
+   REAL(wp)          ::   rn_dpwob    = 15.      !:    "                           "       at West open boundary
+   REAL(wp)          ::   rn_dpsob    = 15.      !:    "                           "       at South open boundary
+   REAL(wp)          ::   rn_dpnob    = 15.      !:    "                           "       at North open boundary
+   REAL(wp)          ::   rn_volemp   =  1.      !: = 0 the total volume will have the variability of the 
+   !                                             !      surface Flux E-P else (volemp = 1) the volume will be constant
+   !                                             !  = 1 the volume will be constant during all the integration.
+
+   !                                  !!! OLD non-DOCTOR name of namelist variables
+   INTEGER  ::   nbobc                 !: number of open boundaries ( 1=< nbobc =< 4 ) 
+   INTEGER  ::   nobc_dta              !:  = 0 use the initial state as obc data
+   REAL(wp) ::   rdpein                !: damping time scale for inflow at East open boundary
+   REAL(wp) ::   rdpwin                !:    "                      "   at West open boundary
+   REAL(wp) ::   rdpsin                !:    "                      "   at South open boundary
+   REAL(wp) ::   rdpnin                !:    "                      "   at North open boundary
+   REAL(wp) ::   rdpeob                !: damping time scale for the climatology at East open boundary
+   REAL(wp) ::   rdpwob                !:    "                           "       at West open boundary
+   REAL(wp) ::   rdpsob                !:    "                           "       at South open boundary
+   REAL(wp) ::   rdpnob                !:    "                           "       at North open boundary
+   REAL(wp) ::   volemp                !: = 0 the total volume will have the variability of the 
+   CHARACTER(len=20) :: cffile
+
+
+   !!General variables for open boundaries:
+   !!--------------------------------------
+   LOGICAL ::   lfbceast, lfbcwest      !: logical flag for a fixed East and West open boundaries       
+   LOGICAL ::   lfbcnorth, lfbcsouth    !: logical flag for a fixed North and South open boundaries       
+   !                                    !  These logical flags are set to 'true' if damping time 
+   !                                    !  scale are set to 0 in the namelist, for both inflow and outflow).
+
+   REAL(wp), PUBLIC ::   obcsurftot       !: Total lateral surface of open boundaries
+   
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: &  !:
+      obctmsk,            &  !: mask array identical to tmask, execpt along OBC where it is set to 0
+      !                      !  it used to calculate the cumulate flux E-P in the obcvol.F90 routine
+      obcumask, obcvmask     !: u-, v- Force filtering mask for the open
+      !                      !  boundary condition on grad D
+
+   !!--------------------
+   !! East open boundary:
+   !!--------------------
+   INTEGER ::   nie0  , nie1      !: do loop index in mpp case for jpieob
+   INTEGER ::   nie0p1, nie1p1    !: do loop index in mpp case for jpieob+1
+   INTEGER ::   nie0m1, nie1m1    !: do loop index in mpp case for jpieob-1
+   INTEGER ::   nje0  , nje1      !: do loop index in mpp case for jpjed, jpjef
+   INTEGER ::   nje0p1, nje1m1    !: do loop index in mpp case for jpjedp1,jpjefm1
+   INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   &  !:
+      sshfoe,           & !: now climatology of the east boundary sea surface height
+      ubtfoe,vbtfoe       !: now climatology of the east boundary barotropic transport
+     
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !:
+      ufoe, vfoe,       & !: now climatology of the east boundary velocities 
+      tfoe, sfoe,       & !: now climatology of the east boundary temperature and salinity
+      uclie               !: baroclinic componant of the zonal velocity after radiation 
+      !                   ! in the obcdyn.F90 routine
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfoe_b   !: east boundary ssh correction averaged over the barotropic loop
+      !                                            !  (if Flather's algoritm applied at open boundary)
+
+   !!-------------------------------
+   !! Arrays for radiative East OBC: 
+   !!-------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows 
+      !                                                    !  and 3 time step (now, before, and before before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows 
+      !                                                    !  and 2 time step (now and before)
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with 
+      !                                                    !  radiation of u and v velocity (respectively) at the 
+      !                                                    !  east open boundary (u_cxebnd = cx rdt )
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+
+   !!--------------------
+   !! West open boundary
+   !!--------------------
+   INTEGER ::   niw0  , niw1       !: do loop index in mpp case for jpiwob
+   INTEGER ::   niw0p1, niw1p1     !: do loop index in mpp case for jpiwob+1
+   INTEGER ::   njw0  , njw1       !: do loop index in mpp case for jpjwd, jpjwf
+   INTEGER ::   njw0p1, njw1m1     !: do loop index in mpp case for jpjwdp1,jpjwfm1
+   INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd
+
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !:
+      sshfow,           & !: now climatology of the west boundary sea surface height
+      ubtfow,vbtfow       !: now climatology of the west boundary barotropic transport
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &  !:
+      ufow, vfow,       & !: now climatology of the west velocities 
+      tfow, sfow,       & !: now climatology of the west temperature and salinity
+      ucliw               !: baroclinic componant of the zonal velocity after the radiation 
+      !                   !  in the obcdyn.F90 routine
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop
+      !                                          !  (if Flather's algoritm applied at open boundary)
+
+   !!-------------------------------
+   !! Arrays for radiative West OBC
+   !!-------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows 
+      !                                                   !  and 3 time step (now, before, and before before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and 
+      !                                                   !  2 time step (now and before)
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with 
+      !                                                   !  radiation of zonal and meridional velocity (respectively) 
+      !                                                   !  at the west open boundary (u_cxwbnd = cx rdt )
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+
+   !!---------------------
+   !! North open boundary
+   !!---------------------
+   INTEGER ::   nin0  , nin1       !: do loop index in mpp case for jpind, jpinf
+   INTEGER ::   nin0p1, nin1m1     !: do loop index in mpp case for jpindp1, jpinfm1
+   INTEGER ::   nin1m2, nin0m1     !: do loop index in mpp case for jpinfm1-1,jpind
+   INTEGER ::   njn0  , njn1       !: do loop index in mpp case for jpnob
+   INTEGER ::   njn0p1, njn1p1     !: do loop index in mpp case for jpnob+1
+   INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1
+
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::   &  !:
+      sshfon,           & !: now climatology of the north boundary sea surface height
+      ubtfon,vbtfon       !: now climatology of the north boundary barotropic transport
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &    !:
+      ufon, vfon,       & !: now climatology of the north boundary velocities
+      tfon, sfon,       & !: now climatology of the north boundary temperature and salinity
+      vclin               !: baroclinic componant of the meridian velocity after the radiation
+      !                   !  in yhe obcdyn.F90 routine
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop
+      !                                            !  (if Flather's algoritm applied at open boundary)
+
+   !!--------------------------------
+   !! Arrays for radiative North OBC
+   !!--------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3
+      !                                                    !  rows and 3 time step (now, before, and before before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tnbnd, snbnd      !: north boundary temperature and salinity over
+      !                                                    !  2 rows and 2 time step (now and before)
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu-
+      !                                                    !  ted with radiation of zonal and meridional velocity 
+      !                                                    !  (respectively) at the north OB (u_cynbnd = cx rdt )
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB
+
+   ! Note that those arrays are optimized for mpp case 
+   ! (hence the dimension jpj is the size of one processor subdomain)
+   
+   !!---------------------
+   !! South open boundary
+   !!---------------------
+   INTEGER ::   nis0  , nis1       !: do loop index in mpp case for jpisd, jpisf
+   INTEGER ::   nis0p1, nis1m1     !: do loop index in mpp case for jpisdp1, jpisfm1
+   INTEGER ::   nis1m2, nis0m1     !: do loop index in mpp case for jpisfm1-1,jpisd
+   INTEGER ::   njs0  , njs1       !: do loop index in mpp case for jpsob
+   INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1
+
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:) ::    &   !:
+      sshfos,           & !: now climatology of the south boundary sea surface height
+      ubtfos,vbtfos       !: now climatology of the south boundary barotropic transport
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::    &   !:
+      ufos, vfos,       & !: now climatology of the south boundary velocities 
+      tfos, sfos,       & !: now climatology of the south boundary temperature and salinity
+      vclis               !: baroclinic componant of the meridian velocity after the radiation 
+      !                   !  in the obcdyn.F90 routine
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop
+      !                                           !  (if Flather's algoritm applied at open boundary)
+
+   !!--------------------------------
+   !! Arrays for radiative South OBC   (computed by the forward time step in dynspg)
+   !!--------------------------------
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3 
+      !                                                   !  rows and 3 time step (now, before, and before before)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over
+      !                                                   !  2 rows and 2 time step (now and before)
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio
+      !                                                   !  computed with radiation of zonal and meridional velocity 
+      !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt )
+   REAL(wp), ALLOCATABLE, SAVE,     DIMENSION(:,:) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION obc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!               ***  FUNCTION obc_oce_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE(                                                               &
+              !! East open boundary
+              obctmsk(jpi,jpj), obcumask(jpi,jpj), obcvmask(jpi,jpj),        &
+              sshfoe(jpjed:jpjef), ubtfoe(jpjed:jpjef), vbtfoe(jpjed:jpjef), &
+              ufoe(jpj,jpk), vfoe(jpj,jpk), tfoe(jpj,jpk), sfoe(jpj,jpk),    &
+              uclie(jpj,jpk), sshfoe_b(jpjed:jpjef,jpj),                     &
+              !! Arrays for radiative East OBC
+              uebnd(jpj,jpk,3,3), vebnd(jpj,jpk,3,3) ,                       &
+              tebnd(jpj,jpk,2,2), sebnd(jpj,jpk,2,2),                        &
+              u_cxebnd(jpj,jpk), v_cxebnd(jpj,jpk),                          &
+              uemsk(jpj,jpk), vemsk(jpj,jpk), temsk(jpj,jpk),                &
+              !! West open boundary
+              sshfow(jpjwd:jpjwf), ubtfow(jpjwd:jpjwf), vbtfow(jpjwd:jpjwf), &
+              ufow(jpj,jpk), vfow(jpj,jpk), tfow(jpj,jpk),                   &
+              sfow(jpj,jpk), ucliw(jpj,jpk), sshfow_b(jpjwd:jpjwf,jpj),      &
+              !! Arrays for radiative West OBC
+              uwbnd(jpj,jpk,3,3), vwbnd(jpj,jpk,3,3),                        &
+              twbnd(jpj,jpk,2,2), swbnd(jpj,jpk,2,2),                        &
+              u_cxwbnd(jpj,jpk), v_cxwbnd(jpj,jpk),                          &
+              uwmsk(jpj,jpk), vwmsk(jpj,jpk), twmsk(jpj,jpk),                &
+              !! North open boundary
+              sshfon(jpind:jpinf), ubtfon(jpind:jpinf), vbtfon(jpind:jpinf), &
+              ufon(jpi,jpk), vfon(jpi,jpk), tfon(jpi,jpk),                   &
+              sfon(jpi,jpk), vclin(jpi,jpk), sshfon_b(jpind:jpinf,jpj),      &
+              !! Arrays for radiative North OBC
+              unbnd(jpi,jpk,3,3), vnbnd(jpi,jpk,3,3),                        &
+              tnbnd(jpi,jpk,2,2), snbnd(jpi,jpk,2,2),                        &
+              u_cynbnd(jpi,jpk), v_cynbnd(jpi,jpk),                          &
+              unmsk(jpi,jpk), vnmsk(jpi,jpk), tnmsk (jpi,jpk),               &
+              !! South open boundary
+              sshfos(jpisd:jpisf), ubtfos(jpisd:jpisf), vbtfos(jpisd:jpisf), &
+              ufos(jpi,jpk), vfos(jpi,jpk), tfos(jpi,jpk),                   &
+              sfos(jpi,jpk), vclis(jpi,jpk),                                 &
+              sshfos_b(jpisd:jpisf,jpj),                                     &
+              !! Arrays for radiative South OBC 
+              usbnd(jpi,jpk,3,3), vsbnd(jpi,jpk,3,3),                        &
+              tsbnd(jpi,jpk,2,2), ssbnd(jpi,jpk,2,2),                        &
+              u_cysbnd(jpi,jpk), v_cysbnd(jpi,jpk),                          &
+              usmsk(jpi,jpk), vsmsk(jpi,jpk), tsmsk(jpi,jpk),                &
+              !!
+              STAT=obc_oce_alloc )
+      !
+   END FUNCTION obc_oce_alloc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option         Empty module                          No OBC
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE obc_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par.F90	(revision 3437)
@@ -0,0 +1,115 @@
+MODULE obc_par
+   !!==============================================================================
+   !!                  ***  MODULE obc_par   ***
+   !! Open Boundary Cond. :   define related parameters
+   !!==============================================================================
+   !! history :  OPA  ! 1991-01 (CLIPPER)  Original code 
+   !!   NEMO     1.0  ! 2002-04   (C. Talandier)  modules
+   !!             -   ! 2004/06   (F. Durand) jptobc is defined as a parameter
+   !!----------------------------------------------------------------------
+#if defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_obc' :                                 Open Boundary Condition
+   !!----------------------------------------------------------------------
+   USE par_oce         ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+#if ! defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag
+#else
+   LOGICAL, PUBLIC            ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag
+#endif
+
+# if defined key_eel_r5
+   !!----------------------------------------------------------------------
+   !!   'key_eel_r5' :                                 EEL R5 configuration
+   !!----------------------------------------------------------------------
+#    include "obc_par_EEL_R5.h90"
+
+# elif defined key_pomme_r025
+   !!----------------------------------------------------------------------
+   !!   'key_pomme_r025' :                         POMME R025 configuration
+   !!----------------------------------------------------------------------
+#    include "obc_par_POMME_R025.h90"
+
+# else
+   !!---------------------------------------------------------------------
+   !! open boundary parameter
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER ::   jptobc      =  2        !: time dimension of the BCS fields on input
+   
+   !! * EAST open boundary
+   LOGICAL, PARAMETER ::   lp_obc_east = .FALSE.   !: to active or not the East open boundary
+   INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point)
+      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point)
+      jpjef   = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point)
+      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 "
+      jpjefm1 =  jpjef-1        !: last  ocean point         "                 "
+
+   !! * WEST open boundary
+   LOGICAL, PARAMETER ::   lp_obc_west = .FALSE.   !: to active or not the West open boundary
+   INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      jpiwob  =	       2,    &  !: i-localization of the West open boundary (must be ocean U-point)
+      jpjwd   =	       2,    &  !: j-starting indice of the West open boundary (must be land T-point)
+      jpjwf   = jpjglo-1,    &  !: j-ending   indice of the West open boundary (must be land T-point)
+      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 "
+      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 "
+
+   !! * NORTH open boundary
+   LOGICAL, PARAMETER ::   lp_obc_north = .FALSE.   !: to active or not the North open boundary
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point)
+      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point)
+      jpinf   = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point)
+      jpindp1 =  jpind+1,    &  !: first ocean point         "                 "
+      jpinfm1 =  jpinf-1        !: last  ocean point         "                 "
+
+   !! * SOUTH open boundary
+   LOGICAL, PARAMETER ::   lp_obc_south = .FALSE.   !: to active or not the South open boundary
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point)
+      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point)
+      jpisf   = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point)
+      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 "
+      jpisfm1 =  jpisf-1        !: last  ocean point         "                 "
+   
+   INTEGER, PARAMETER ::   jpnic = 2700   !: maximum number of isolated coastlines points 
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                         NO open boundary condition
+   !!----------------------------------------------------------------------
+#if ! defined key_agrif
+   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .FALSE.     !: Ocean Boundary Condition flag
+#else
+   LOGICAL, PUBLIC            ::   lk_obc = .FALSE.     !: Ocean Boundary Condition flag
+#endif
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE obc_par
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90	(revision 3437)
@@ -0,0 +1,76 @@
+   !!----------------------------------------------------------------------
+   !!                  ***  obc_par_EEL_R5.h90  ***
+   !!----------------------------------------------------------------------
+   !! open boundary parameter : EEL5 configuration
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   INTEGER, PARAMETER ::     &  !: time dimension for the BCS fields on input
+      jptobc  =	      2 
+
+   !! * EAST open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_east = .TRUE.      !: to active or not the East open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   &
+#endif
+    ::     &
+      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point)
+      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point)
+      jpjef   = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point)
+      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 "
+      jpjefm1 =  jpjef-1        !: last  ocean point         "                 "
+
+   !! * WEST open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_west = .TRUE.      !: to active or not the West open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   &
+#endif
+    ::     &
+      jpiwob  =	       2,    &  !: i-localization of the West open boundary (must be ocean U-point)
+      jpjwd   =	       2,    &  !: j-starting indice of the West open boundary (must be land T-point)
+      jpjwf   = jpjglo-1,    &  !: j-ending   indice of the West open boundary (must be land T-point)
+      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 "
+      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 "
+
+   !! * NORTH open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_north = .FALSE.    !: to active or not the North open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   &
+#endif
+    ::     &
+      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point)
+      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point)
+      jpinf   = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point)
+      jpindp1 =  jpind+1,    &  !: first ocean point         "                 "
+      jpinfm1 =  jpinf-1        !: last  ocean point         "                 "
+
+   !! * SOUTH open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_south = .FALSE.    !: to active or not the South open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   &
+#endif
+    ::     &
+      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point)
+      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point)
+      jpisf   = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point)
+      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 "
+      jpisfm1 =  jpisf-1        !: last  ocean point         "                 "
+   
+   INTEGER, PARAMETER ::     &  !:
+      jpnic = 2700              !: maximum number of isolated coastlines points 
+   !!---------------------------------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90	(revision 3437)
@@ -0,0 +1,100 @@
+   !!----------------------------------------------------------------------
+   !!                  ***  obc_par_POMME_R025.h90  ***
+   !!----------------------------------------------------------------------
+   !! open boundary parameter : POMME configuration
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   INTEGER, PARAMETER ::  jptobc  =	      14   
+   !: time dimension of the BCS fields on input
+
+   !! * EAST open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_east = .TRUE.      !:
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      ! * default values *
+      !jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point)
+      !jpjed  =        2,    &  !: j-starting indice of the East open boundary (must be land T-point)
+      !jpjef  = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point)
+      jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point)
+      jpjed  =        1,    &  !: j-starting indice of the East open boundary (must be land T-point)
+      jpjef  =   jpjglo,    &  !: j-ending   indice of the East open boundary (must be land T-point)
+      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 "
+      jpjefm1 =  jpjef-1        !: last  ocean point         "                 "
+
+   !! * WEST open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_west = .TRUE.     !: to active or not the West open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      ! * default values *
+      !jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point)
+      !jpjwd   =        2,   &  !: j-starting indice of the West open boundary (must be land T-point)
+      !jpjwf   = jpjglo-1,   &  !: j-ending   indice of the West open boundary (must be land T-point)
+      jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point)
+      jpjwd   =        1,   &  !: j-starting indice of the West open boundary (must be land T-point)
+      jpjwf   =   jpjglo,   &  !: j-ending   indice of the West open boundary (must be land T-point)
+      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 "
+      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 "
+
+   !! * NORTH open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_north = .TRUE.     !:
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      ! * default values *
+      !jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point)
+      !jpind  =        2,    &  !: i-starting indice of the North open boundary (must be land T-point)
+      !jpinf  = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point)
+      jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point)
+      jpind  =        1,    &  !: i-starting indice of the North open boundary (must be land T-point)
+      jpinf  =   jpiglo,    &  !: i-ending   indice of the North open boundary (must be land T-point)
+      jpindp1 =  jpind+1,    &  !: first ocean point         "                 "
+      jpinfm1 =  jpinf-1        !: last  ocean point         "                 "
+
+   !! * SOUTH open boundary
+   LOGICAL, PARAMETER ::     &  !:
+      lp_obc_south = .TRUE.     !: INDICE to active or not the South open boundary
+
+     INTEGER   &
+#if !defined key_agrif
+     , PARAMETER   & 
+#endif
+    ::     & 
+      ! * default values *
+      !jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point)
+      !jpisd  =        2,    &  !: i-starting indice of the South open boundary (must be land T-point)
+      !jpisf  = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point)
+      jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point)
+      jpisd  =        1,    &  !: i-starting indice of the South open boundary (must be land T-point)
+      jpisf  =   jpiglo,    &  !: i-ending   indice of the South open boundary (must be land T-point)
+      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 "
+      jpisfm1 =  jpisf-1        !: last  ocean point         "                 "
+   
+   !! * CHOSE WHERE YOU WANT TO LOCATE THE BAROTROPIC CORRECTION VELOCITY
+   !chd IND025
+   LOGICAL, PARAMETER ::     &  !:
+        lp_obc_east_barotp_corr  = .TRUE.,   & !:
+        lp_obc_west_barotp_corr  = .TRUE.,   & !:
+        lp_obc_north_barotp_corr = .TRUE.,   & !:
+        lp_obc_south_barotp_corr = .TRUE.      !:
+
+   INTEGER, PARAMETER ::     &  !:
+      jpnic = 2700              !: maximum number of isolated coastlines points 
+   !!---------------------------------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obc_vectopt_loop_substitute.h90	(revision 3437)
@@ -0,0 +1,30 @@
+   !!----------------------------------------------------------------------
+   !!                 ***  obc_vectopt_loop_substitute.h90  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !!      to allow unrolling of do-loop using CPP macro.
+   !!----------------------------------------------------------------------
+#if defined key_vectopt_loop && defined key_obc && ! defined key_mpp_mpi
+#  define fs_niw0  jpiwob 
+#  define fs_niw1  jpiwob
+#  define fs_nie0  jpieob 
+#  define fs_nie1  jpieob
+#  define fs_njn0  jpjnob
+#  define fs_njn1  jpjnob
+#  define fs_njs0  jpjsob
+#  define fs_njs1  jpjsob
+#else
+#  define fs_niw0  niw0 
+#  define fs_niw1  niw1
+#  define fs_nie0  nie0 
+#  define fs_nie1  nie1
+#  define fs_njn0  njn0
+#  define fs_njn1  njn1
+#  define fs_njs0  njs0
+#  define fs_njs1  njs1
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obc_vectopt_loop_substitute.h90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90	(revision 3437)
@@ -0,0 +1,1250 @@
+MODULE obcdta
+   !!==============================================================================
+   !!                            ***  MODULE obcdta  ***
+   !! Open boundary data : read the data for the open boundaries.
+   !!==============================================================================
+   !! History :  OPA  ! 1998-05 (J.M. Molines) Original code
+   !!            8.5  ! 2002-10 (C. Talandier, A-M. Treguier) Free surface, F90
+   !!   NEMO     1.0  ! 2004-06 (F. Durand, A-M. Treguier) Netcdf BC files on input
+   !!            3.0  ! 2007-2008 (C. Langlais, P. Mathiot, J.M. Molines) high frequency boundaries data
+   !!------------------------------------------------------------------------------
+#if defined key_obc
+   !!------------------------------------------------------------------------------
+   !!   'key_obc'         :                                Open Boundary Conditions
+   !!------------------------------------------------------------------------------
+   !!   obc_dta           : read u, v, t, s data along each open boundary
+   !!------------------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_par         ! ocean open boundary conditions
+   USE obc_oce         ! ocean open boundary conditions
+   USE in_out_manager  ! I/O logical units
+   USE lib_mpp         ! distributed memory computing
+   USE dynspg_oce      ! ocean: surface pressure gradient
+   USE ioipsl          ! now only for  ymds2ju function 
+   USE iom             ! 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_dta         ! routine  called by step.F90
+   PUBLIC   obc_dta_bt      ! routine  called by dynspg_ts.F90
+   PUBLIC   obc_dta_alloc   ! function called by obcini.F90
+
+   REAL(wp),  DIMENSION(2)              ::   zjcnes_obc   ! 
+   REAL(wp),  DIMENSION(:), ALLOCATABLE ::   ztcobc
+   REAL(wp) :: rdt_obc
+   REAL(wp) :: zjcnes
+   INTEGER :: imm0, iyy0, idd0, iyy, imm, idd
+   INTEGER :: nt_a=2, nt_b=1, itobc, ndate0_cnes, nday_year0
+   INTEGER ::  itobce, itobcw, itobcs, itobcn, itobc_b  ! number of time steps in OBC files
+
+   INTEGER ::   ntobc        ! where we are in the obc file
+   INTEGER ::   ntobc_b      ! first record used
+   INTEGER ::   ntobc_a      ! second record used
+
+   CHARACTER (len=40) ::   cl_obc_eTS, cl_obc_eU   ! name of data files
+   CHARACTER (len=40) ::   cl_obc_wTS, cl_obc_wU   !   -       -
+   CHARACTER (len=40) ::   cl_obc_nTS, cl_obc_nV   !   -       -
+   CHARACTER (len=40) ::   cl_obc_sTS, cl_obc_sV   !   -       -
+
+   ! bt arrays for interpolating time dependent data on the boundaries
+   INTEGER ::   nt_m=0, ntobc_m
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtedta, vbtedta, sshedta    ! East
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtwdta, vbtwdta, sshwdta	   ! West
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtndta, vbtndta, sshndta	   ! North
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ubtsdta, vbtsdta, sshsdta	   ! South
+   ! arrays used for interpolating time dependent data on the boundaries
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uedta, vedta, tedta, sedta    ! East
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uwdta, vwdta, twdta, swdta    ! West
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: undta, vndta, tndta, sndta    ! North
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: usdta, vsdta, tsdta, ssdta    ! South
+
+   ! Masks set to .TRUE. after successful allocation below
+   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltemsk, luemsk, lvemsk  ! boolean msks
+   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltwmsk, luwmsk, lvwmsk  ! used for outliers
+   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltnmsk, lunmsk, lvnmsk  ! checks
+   LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:)   :: ltsmsk, lusmsk, lvsmsk
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION obc_dta_alloc()
+      !!-------------------------------------------------------------------
+      !!                     ***  ROUTINE obc_dta_alloc  ***
+      !!-------------------------------------------------------------------
+      INTEGER :: ierr(2)
+      !!-------------------------------------------------------------------
+# if defined key_dynspg_ts
+      ALLOCATE(   &     ! time-splitting : 0:jptobc
+         ! bt arrays for interpolating time dependent data on the boundaries
+         &      ubtedta  (jpj,0:jptobc) , vbtedta  (jpj,0:jptobc) , sshedta  (jpj,0:jptobc) ,    &
+         &      ubtwdta  (jpj,0:jptobc) , vbtwdta  (jpj,0:jptobc) , sshwdta  (jpj,0:jptobc) ,    &
+         &      ubtndta  (jpi,0:jptobc) , vbtndta  (jpi,0:jptobc) , sshndta  (jpi,0:jptobc) ,    &
+         &      ubtsdta  (jpi,0:jptobc) , vbtsdta  (jpi,0:jptobc) , sshsdta  (jpi,0:jptobc) ,    &
+         ! arrays used for interpolating time dependent data on the boundaries
+         &      uedta(jpj,jpk,0:jptobc) , vedta(jpj,jpk,0:jptobc)                           ,     &
+         &      tedta(jpj,jpk,0:jptobc) , sedta(jpj,jpk,0:jptobc)                           ,     &
+         &      uwdta(jpj,jpk,0:jptobc) , vwdta(jpj,jpk,0:jptobc)                           ,     &
+         &      twdta(jpj,jpk,0:jptobc) , swdta(jpj,jpk,0:jptobc)                           ,     &
+         &      undta(jpi,jpk,0:jptobc) , vndta(jpi,jpk,0:jptobc)                           ,     &
+         &      tndta(jpi,jpk,0:jptobc) , sndta(jpi,jpk,0:jptobc)                           ,     &
+         &      usdta(jpi,jpk,0:jptobc) , vsdta(jpi,jpk,0:jptobc)                           ,     &
+         &      tsdta(jpi,jpk,0:jptobc) , ssdta(jpi,jpk,0:jptobc)                           , STAT=ierr(1) )
+# else
+      ALLOCATE(   &     ! no time splitting : 1:jptobc
+         ! bt arrays for interpolating time dependent data on the boundaries
+         &      ubtedta  (jpj,jptobc) , vbtedta  (jpj,jptobc) , sshedta  (jpj,jptobc)  ,     &
+         &      ubtwdta  (jpj,jptobc) , vbtwdta  (jpj,jptobc) , sshwdta  (jpj,jptobc)  ,     &
+         &      ubtndta  (jpi,jptobc) , vbtndta  (jpi,jptobc) , sshndta  (jpi,jptobc)  ,     &
+         &      ubtsdta  (jpi,jptobc) , vbtsdta  (jpi,jptobc) , sshsdta  (jpi,jptobc)  ,     &
+         ! arrays used for interpolating time dependent data on the boundaries
+         &      uedta(jpj,jpk,jptobc) , vedta(jpj,jpk,jptobc)                          ,     &
+         &      tedta(jpj,jpk,jptobc) , sedta(jpj,jpk,jptobc)                          ,     &
+         &      uwdta(jpj,jpk,jptobc) , vwdta(jpj,jpk,jptobc)                          ,     &
+         &      twdta(jpj,jpk,jptobc) , swdta(jpj,jpk,jptobc)                          ,     &
+         &      undta(jpi,jpk,jptobc) , vndta(jpi,jpk,jptobc)                          ,     &
+         &      tndta(jpi,jpk,jptobc) , sndta(jpi,jpk,jptobc)                          ,     &
+         &      usdta(jpi,jpk,jptobc) , vsdta(jpi,jpk,jptobc)                          ,     &
+         &      tsdta(jpi,jpk,jptobc) , ssdta(jpi,jpk,jptobc)                          , STAT=ierr(1) )
+# endif
+
+      ALLOCATE( ltemsk(jpj,jpk) , luemsk(jpj,jpk) , lvemsk(jpj,jpk) ,     &
+         &      ltwmsk(jpj,jpk) , luwmsk(jpj,jpk) , lvwmsk(jpj,jpk) ,     &
+         &      ltnmsk(jpj,jpk) , lunmsk(jpj,jpk) , lvnmsk(jpj,jpk) ,     &
+         &      ltsmsk(jpj,jpk) , lusmsk(jpj,jpk) , lvsmsk(jpj,jpk) , STAT=ierr(2) )
+
+      obc_dta_alloc = MAXVAL( ierr )
+      IF( lk_mpp )   CALL mpp_sum( obc_dta_alloc )
+
+      IF( obc_dta_alloc == 0 )  THEN         ! Initialise mask values following successful allocation
+         !      east            !          west            !          north           !          south           !
+         ltemsk(:,:) = .TRUE.   ;   ltwmsk(:,:) = .TRUE.   ;   ltnmsk(:,:) = .TRUE.   ;   ltsmsk(:,:) = .TRUE.
+         luemsk(:,:) = .TRUE.   ;   luwmsk(:,:) = .TRUE.   ;   lunmsk(:,:) = .TRUE.   ;   lusmsk(:,:) = .TRUE.
+         lvemsk(:,:) = .TRUE.   ;   lvwmsk(:,:) = .TRUE.   ;   lvnmsk(:,:) = .TRUE.   ;   lvsmsk(:,:) = .TRUE.
+      END IF
+      !
+   END FUNCTION obc_dta_alloc
+
+
+   SUBROUTINE obc_dta( kt )
+      !!---------------------------------------------------------------------------
+      !!                      ***  SUBROUTINE obc_dta  ***
+      !!                    
+      !! ** Purpose :   Find the climatological  boundary arrays for the specified date, 
+      !!                The boundary arrays are netcdf files. Three possible cases: 
+      !!                - one time frame only in the file (time dimension = 1).
+      !!                in that case the boundary data does not change in time.
+      !!                - many time frames. In that case,  if we have 12 frames
+      !!                we assume monthly fields. 
+      !!                Else, we assume that time_counter is in seconds 
+      !!                since the beginning of either the current year or a reference
+      !!                year given in the namelist.
+      !!                (no check is done so far but one would have to check the "unit"
+      !!                 attribute of variable time_counter).
+      !!
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      !
+      INTEGER, SAVE :: immfile, iyyfile                     !
+      INTEGER :: nt              !  record indices (incrementation)
+      REAL(wp) ::   zsec, zxy, znum, zden ! time interpolation weight
+      !!---------------------------------------------------------------------------
+
+      ! 0.  initialisation :
+      ! --------------------
+      IF ( kt == nit000  )  CALL obc_dta_ini ( kt )
+      IF ( nobc_dta == 0 )  RETURN   ! already done in obc_dta_ini
+      IF ( itobc == 1    )  RETURN   ! case of only one time frame in file done in obc_dta_ini
+
+      ! in the following code, we assume that obc data are read from files, with more than 1 time frame in it
+
+      iyyfile=iyy ; immfile = 00  ! set component of the current file name
+      IF ( cffile /= 'annual') immfile = imm   ! 
+      IF ( ln_obc_clim       ) iyyfile = 0000  ! assume that climatological files are labeled y0000
+
+      ! 1. Synchronize time of run with time of data files
+      !---------------------------------------------------
+      ! nday_year is the day number in the current year ( 1 for 01/01 )
+      zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day
+      IF (ln_obc_clim)  THEN 
+         zjcnes = nday_year - 1  + zsec/rday
+      ELSE
+         zjcnes = zjcnes + rdt/rday
+      ENDIF
+
+      ! look for 'before' record number in the current file
+      ntobc = nrecbef ()  ! this function return the record number for 'before', relative to zjcnes
+
+      IF (MOD(kt-1,10)==0) THEN
+         IF (lwp) WRITE(numout,*) 'kt= ',kt,' zjcnes =', zjcnes,' ndastp =',ndastp, 'mm =',imm 
+      END IF
+
+      ! 2. read a new data if necessary 
+      !--------------------------------
+      IF ( ntobc /= ntobc_b ) THEN
+         ! we need to read the 'after' record
+         ! swap working index:
+# if defined key_dynspg_ts
+         nt=nt_m ; nt_m=nt_b ; nt_b=nt
+# endif
+         nt=nt_b ; nt_b=nt_a ; nt_a=nt
+         ntobc_b = ntobc
+
+         ! new record number :
+         ntobc_a = ntobc_a + 1 
+
+         ! all tricky things related to record number, changing files etc... are managed by obc_read
+
+         CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile )
+
+         ! update zjcnes_obc
+# if defined key_dynspg_ts
+         ntobc_m=mod(ntobc_b-2+itobc,itobc)+1
+         zjcnes_obc(nt_m)= ztcobc(ntobc_m)
+# endif
+         zjcnes_obc(nt_b)= ztcobc(ntobc_b)
+         zjcnes_obc(nt_a)= ztcobc(ntobc_a)
+      ENDIF
+
+      ! 3.   interpolation at each time step
+      ! ------------------------------------
+      IF( ln_obc_clim) THEN
+         znum= MOD(zjcnes           - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) )
+         IF( znum < 0 ) znum = znum + REAL(nyear_len(1),wp)
+         zden= MOD(zjcnes_obc(nt_a) - zjcnes_obc(nt_b), REAL(nyear_len(1),wp) ) 
+         IF( zden < 0 ) zden = zden + REAL(nyear_len(1),wp)
+      ELSE
+         znum= zjcnes           - zjcnes_obc(nt_b)
+         zden= zjcnes_obc(nt_a) - zjcnes_obc(nt_b)
+      ENDIF
+      zxy = znum / zden
+
+      IF( lp_obc_east ) THEN
+         !  fills sfoe, tfoe, ufoe ,vfoe
+         sfoe(:,:) = zxy * sedta (:,:,nt_a) + (1. - zxy)*sedta(:,:,nt_b)
+         tfoe(:,:) = zxy * tedta (:,:,nt_a) + (1. - zxy)*tedta(:,:,nt_b)
+         ufoe(:,:) = zxy * uedta (:,:,nt_a) + (1. - zxy)*uedta(:,:,nt_b)
+         vfoe(:,:) = zxy * vedta (:,:,nt_a) + (1. - zxy)*vedta(:,:,nt_b)
+      ENDIF
+
+      IF( lp_obc_west) THEN
+         !  fills sfow, tfow, ufow ,vfow
+         sfow(:,:) = zxy * swdta (:,:,nt_a) + (1. - zxy)*swdta(:,:,nt_b)
+         tfow(:,:) = zxy * twdta (:,:,nt_a) + (1. - zxy)*twdta(:,:,nt_b)
+         ufow(:,:) = zxy * uwdta (:,:,nt_a) + (1. - zxy)*uwdta(:,:,nt_b)
+         vfow(:,:) = zxy * vwdta (:,:,nt_a) + (1. - zxy)*vwdta(:,:,nt_b)
+      ENDIF
+
+      IF( lp_obc_north) THEN
+         !  fills sfon, tfon, ufon ,vfon
+         sfon(:,:) = zxy * sndta (:,:,nt_a) + (1. - zxy)*sndta(:,:,nt_b)
+         tfon(:,:) = zxy * tndta (:,:,nt_a) + (1. - zxy)*tndta(:,:,nt_b)
+         ufon(:,:) = zxy * undta (:,:,nt_a) + (1. - zxy)*undta(:,:,nt_b)
+         vfon(:,:) = zxy * vndta (:,:,nt_a) + (1. - zxy)*vndta(:,:,nt_b)
+      ENDIF
+
+      IF( lp_obc_south) THEN
+         !  fills sfos, tfos, ufos ,vfos
+         sfos(:,:) = zxy * ssdta (:,:,nt_a) + (1. - zxy)*ssdta(:,:,nt_b)
+         tfos(:,:) = zxy * tsdta (:,:,nt_a) + (1. - zxy)*tsdta(:,:,nt_b)
+         ufos(:,:) = zxy * usdta (:,:,nt_a) + (1. - zxy)*usdta(:,:,nt_b)
+         vfos(:,:) = zxy * vsdta (:,:,nt_a) + (1. - zxy)*vsdta(:,:,nt_b)
+      ENDIF
+   END SUBROUTINE obc_dta
+
+
+   SUBROUTINE obc_dta_ini( kt )
+      !!-----------------------------------------------------------------------------
+      !!                       ***  SUBROUTINE obc_dta_ini  ***
+      !!
+      !! ** Purpose :   When obc_dta first call, realize some data initialization
+      !!----------------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! ocean time-step index
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER, SAVE :: immfile, iyyfile                     !
+
+      ! variables for the julian day calculation
+      INTEGER :: iyear, imonth, iday
+      REAL(wp) :: zsec , zjulian, zjuliancnes   
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*)  'obc_dta : find boundary data'
+      IF(lwp) WRITE(numout,*)  '~~~~~~~'
+      IF (lwp) THEN
+         IF ( nobc_dta == 0 ) THEN 
+            WRITE(numout,*)  '          OBC data taken from initial conditions.'
+         ELSE      
+            WRITE(numout,*)  '          OBC data taken from netcdf files.'
+         ENDIF
+      ENDIF
+      nday_year0 = nday_year  ! to remember the day when kt=nit000
+
+      sedta(:,:,:) = 0.e0 ; tedta(:,:,:) = 0.e0 ; uedta(:,:,:) = 0.e0 ; vedta(:,:,:) = 0.e0 ! East
+      swdta(:,:,:) = 0.e0 ; twdta(:,:,:) = 0.e0 ; uwdta(:,:,:) = 0.e0 ; vwdta(:,:,:) = 0.e0 ! West
+      sndta(:,:,:) = 0.e0 ; tndta(:,:,:) = 0.e0 ; undta(:,:,:) = 0.e0 ; vndta(:,:,:) = 0.e0 ! North
+      ssdta(:,:,:) = 0.e0 ; tsdta(:,:,:) = 0.e0 ; usdta(:,:,:) = 0.e0 ; vsdta(:,:,:) = 0.e0 ! South
+
+      sfoe(:,:) = 0.e0  ; tfoe(:,:) = 0.e0 ; ufoe(:,:) = 0.e0 ; vfoe(:,:) = 0.e0   ! East
+      sfow(:,:) = 0.e0  ; tfow(:,:) = 0.e0 ; ufow(:,:) = 0.e0 ; vfow(:,:) = 0.e0   ! West
+      sfon(:,:) = 0.e0  ; tfon(:,:) = 0.e0 ; ufon(:,:) = 0.e0 ; vfon(:,:) = 0.e0   ! North
+      sfos(:,:) = 0.e0  ; tfos(:,:) = 0.e0 ; ufos(:,:) = 0.e0 ; vfos(:,:) = 0.e0   ! South
+
+      IF (nobc_dta == 0 ) THEN   ! boundary data are the initial data of this run (set only at nit000)
+         IF (lp_obc_east) THEN  ! East
+            DO ji = nie0 , nie1    
+               sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_sal) * tmask(ji+1,nje0:nje1 , :)
+               tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_tem) * tmask(ji+1,nje0:nje1 , :)
+               ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :)        * umask(ji,  nje0:nje1 , :)
+               vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :)        * vmask(ji+1,nje0:nje1 , :)
+            END DO
+         ENDIF
+
+         IF (lp_obc_west) THEN  ! West
+            DO ji = niw0 , niw1    
+               sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_sal) * tmask(ji , njw0:njw1 , :)
+               tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_tem) * tmask(ji , njw0:njw1 , :)
+               ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :)        * umask(ji , njw0:njw1 , :)
+               vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :)        * vmask(ji , njw0:njw1 , :)
+            END DO
+         ENDIF
+
+         IF (lp_obc_north) THEN ! North
+            DO jj = njn0 , njn1
+               sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_sal) * tmask(nin0:nin1 , jj+1 , :)
+               tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_tem) * tmask(nin0:nin1 , jj+1 , :)
+               ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :)        * umask(nin0:nin1 , jj+1 , :)
+               vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :)        * vmask(nin0:nin1 , jj   , :)
+            END DO
+         ENDIF
+
+         IF (lp_obc_south) THEN ! South
+            DO jj = njs0 , njs1
+               sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_sal) * tmask(nis0:nis1 , jj , :)
+               tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_tem) * tmask(nis0:nis1 , jj , :)
+               ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :)        * umask(nis0:nis1 , jj , :)
+               vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :)        * vmask(nis0:nis1 , jj , :)
+            END DO
+         ENDIF
+         RETURN  ! exit the routine all is done
+      ENDIF  ! nobc_dta = 0 
+
+!!!! In the following OBC data are read from files.
+      ! all logical-mask are initialzed to true when declared
+      WHERE ( temsk == 0 ) ltemsk=.FALSE. 
+      WHERE ( uemsk == 0 ) luemsk=.FALSE. 
+      WHERE ( vemsk == 0 ) lvemsk=.FALSE. 
+
+      WHERE ( twmsk == 0 ) ltwmsk=.FALSE. 
+      WHERE ( uwmsk == 0 ) luwmsk=.FALSE. 
+      WHERE ( vwmsk == 0 ) lvwmsk=.FALSE. 
+
+      WHERE ( tnmsk == 0 ) ltnmsk=.FALSE. 
+      WHERE ( unmsk == 0 ) lunmsk=.FALSE. 
+      WHERE ( vnmsk == 0 ) lvnmsk=.FALSE. 
+
+      WHERE ( tsmsk == 0 ) ltsmsk=.FALSE. 
+      WHERE ( usmsk == 0 ) lusmsk=.FALSE. 
+      WHERE ( vsmsk == 0 ) lvsmsk=.FALSE. 
+
+      iyear=1950;  imonth=01; iday=01;  zsec=0. 
+      ! zjuliancnes : julian day corresonding  to  01/01/1950
+      CALL ymds2ju(iyear, imonth, iday,zsec , zjuliancnes)
+
+      !current year and curent month 
+      iyy=INT(ndastp/10000) ; imm=INT((ndastp -iyy*10000)/100) ; idd=(ndastp-iyy*10000-imm*100)
+      IF (iyy <  1900)  iyy = iyy+1900  ! always assume that years are on 4 digits.
+      CALL ymds2ju(iyy, imm, idd ,zsec , zjulian)
+      ndate0_cnes = zjulian - zjuliancnes   ! jcnes day when call to obc_dta_ini
+
+      iyyfile=iyy ; immfile=0  ! set component of the current file name
+      IF ( cffile /= 'annual') immfile=imm
+      IF ( ln_obc_clim) iyyfile = 0  ! assume that climatological files are labeled y0000
+
+      CALL obc_dta_chktime ( iyyfile, immfile )
+
+      IF ( itobc == 1 ) THEN 
+         ! in this case we will provide boundary data only once.
+         nt_a=1 ; ntobc_a=1
+         CALL obc_read (nit000, nt_a, ntobc_a, iyyfile, immfile) 
+         IF( lp_obc_east ) THEN
+            !  fills sfoe, tfoe, ufoe ,vfoe
+            sfoe(:,:) =  sedta (:,:,1) ; tfoe(:,:) =  tedta (:,:,1)
+            ufoe(:,:) =  uedta (:,:,1) ; vfoe(:,:) =  vedta (:,:,1)
+         ENDIF
+
+         IF( lp_obc_west) THEN
+            !  fills sfow, tfow, ufow ,vfow
+            sfow(:,:) =  swdta (:,:,1) ; tfow(:,:) =  twdta (:,:,1)
+            ufow(:,:) =  uwdta (:,:,1) ; vfow(:,:) =  vwdta (:,:,1)
+         ENDIF
+
+         IF( lp_obc_north) THEN
+            !  fills sfon, tfon, ufon ,vfon
+            sfon(:,:) =  sndta (:,:,1) ; tfon(:,:) =  tndta (:,:,1)
+            ufon(:,:) =  undta (:,:,1) ; vfon(:,:) =  vndta (:,:,1)
+         ENDIF
+
+         IF( lp_obc_south) THEN
+            !  fills sfos, tfos, ufos ,vfos
+            sfos(:,:) =  ssdta (:,:,1) ; tfos(:,:) =  tsdta (:,:,1)
+            ufos(:,:) =  usdta (:,:,1) ; vfos(:,:) =  vsdta (:,:,1)
+         ENDIF
+         RETURN  ! we go out of obc_dta_ini -------------------------------------->>>>>
+      ENDIF
+
+      ! nday_year is the day number in the current year ( 1 for 01/01 )
+      ! we suppose that we always start from the begining of a day
+      !    zsec=MOD( (kt-nit000)*rdt - (nday_year - nday_year0 )*rday, rday ) ! number of seconds in the current day
+      zsec=0.e0  ! here, kt=nit000, nday_year = ndat_year0 
+
+      IF (ln_obc_clim)  THEN 
+         zjcnes = nday_year - 1  + zsec/rday  ! for clim file time is in days in a year
+      ELSE
+         zjcnes = ndate0_cnes + (nday_year - nday_year0 ) + zsec/rday
+      ENDIF
+
+      ! look for 'before' record number in the current file
+      ntobc = nrecbef ()
+
+      IF (lwp) WRITE(numout,*) 'obc files frequency :',cffile
+      IF (lwp) WRITE(numout,*) ' zjcnes0 =',zjcnes,' ndastp0 =',ndastp
+      IF (lwp) WRITE(numout,*) ' annee0 ',iyy,' month0 ', imm,' day0 ', idd
+      IF (lwp) WRITE(numout,*) 'first file open :',cl_obc_nTS
+
+      ! record initialisation
+      !--------------------
+      nt_b = 1 ; nt_a = 2
+
+      ntobc_a = ntobc + 1
+      ntobc_b = ntobc
+
+      CALL obc_read (kt, nt_b, ntobc_b, iyyfile, immfile)  ! read 'before' fields
+      CALL obc_read (kt, nt_a, ntobc_a, iyyfile, immfile)  ! read 'after' fields
+
+      ! additional frame in case of time-splitting
+# if defined key_dynspg_ts
+      nt_m = 0
+      ntobc_m=mod(ntobc_b-2+itobc,itobc)+1
+      zjcnes_obc(nt_m)= ztcobc(ntobc_m) ! FDbug has not checked that this is correct!!
+      IF (ln_rstart) THEN
+         CALL obc_read (kt, nt_m, ntobc_m, iyyfile, immfile)  ! read 'after' fields
+      ENDIF
+# endif
+
+      zjcnes_obc(nt_b)= ztcobc(ntobc_b)
+      zjcnes_obc(nt_a)= ztcobc(ntobc_a)
+      ! 
+   END SUBROUTINE obc_dta_ini
+
+
+   SUBROUTINE obc_dta_chktime (kyyfile, kmmfile)
+      !
+      ! check the number of time steps in the files and read ztcobc 
+      !
+      ! * Arguments
+      INTEGER, INTENT(in) :: kyyfile, kmmfile
+      ! * local variables
+      INTEGER :: istop       ! error control
+      INTEGER :: ji          ! dummy loop index
+
+      INTEGER ::  idvar, id_e, id_w, id_n, id_s       ! file identifiers
+      INTEGER, DIMENSION(1)  :: itmp
+      CHARACTER(LEN=25) :: cl_vname
+
+      ntobc_a = 0; itobce =0 ; itobcw = 0; itobcn = 0; itobcs = 0
+      ! build file name
+      IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing
+         cl_obc_eTS='obceast_TS.nc'
+         cl_obc_wTS='obcwest_TS.nc'
+         cl_obc_nTS='obcnorth_TS.nc'
+         cl_obc_sTS='obcsouth_TS.nc'
+      ELSE                   ! convention for climatological OBC
+         WRITE(cl_obc_eTS ,'("obc_east_TS_y",i4.4,"m",i2.2,".nc")'  ) kyyfile,kmmfile
+         WRITE(cl_obc_wTS ,'("obc_west_TS_y",i4.4,"m",i2.2,".nc")'  ) kyyfile,kmmfile
+         WRITE(cl_obc_nTS ,'("obc_north_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
+         WRITE(cl_obc_sTS ,'("obc_south_TS_y",i4.4,"m",i2.2,".nc")' ) kyyfile,kmmfile
+      ENDIF
+
+      cl_vname = 'time_counter'
+      IF ( lp_obc_east ) THEN
+         CALL iom_open ( cl_obc_eTS , id_e )
+         idvar = iom_varid( id_e, cl_vname, kdimsz = itmp ); itobce=itmp(1)
+      ENDIF
+      IF ( lp_obc_west ) THEN
+         CALL iom_open ( cl_obc_wTS , id_w )
+         idvar = iom_varid( id_w, cl_vname, kdimsz = itmp ) ; itobcw=itmp(1)
+      ENDIF
+      IF ( lp_obc_north ) THEN
+         CALL iom_open ( cl_obc_nTS , id_n )
+         idvar = iom_varid( id_n, cl_vname, kdimsz = itmp ) ; itobcn=itmp(1)
+      ENDIF
+      IF ( lp_obc_south ) THEN
+         CALL iom_open ( cl_obc_sTS , id_s )
+         idvar = iom_varid( id_s, cl_vname, kdimsz = itmp ) ; itobcs=itmp(1)
+      ENDIF
+
+      itobc = MAX( itobce, itobcw, itobcn, itobcs )
+      istop = 0
+      IF ( lp_obc_east  .AND. itobce /= itobc ) istop = istop+1 
+      IF ( lp_obc_west  .AND. itobcw /= itobc ) istop = istop+1      
+      IF ( lp_obc_north .AND. itobcn /= itobc ) istop = istop+1
+      IF ( lp_obc_south .AND. itobcs /= itobc ) istop = istop+1 
+      nstop = nstop + istop
+
+      IF ( istop /=  0 )  THEN
+         WRITE(ctmp1,*) ' east, west, north, south: ', itobce, itobcw, itobcn, itobcs
+         CALL ctl_stop( 'obcdta : all files must have the same number of time steps', ctmp1 )
+      ENDIF
+
+      IF ( itobc == 1 ) THEN 
+         IF (lwp) THEN
+            WRITE(numout,*) ' obcdta found one time step only in the OBC files'
+            IF (ln_obc_clim) THEN
+               ! OK no problem
+            ELSE
+               ln_obc_clim=.true.
+               WRITE(numout,*) ' we force ln_obc_clim to T'
+            ENDIF
+         ENDIF
+      ELSE
+         IF ( ALLOCATED(ztcobc) ) DEALLOCATE ( ztcobc )
+         ALLOCATE (ztcobc(itobc))
+         DO ji=1,1   ! use a dummy loop to read ztcobc only once
+            IF ( lp_obc_east ) THEN
+               CALL iom_gettime ( id_e, ztcobc, cl_vname ) ; CALL iom_close (id_e) ; EXIT
+            ENDIF
+            IF ( lp_obc_west ) THEN
+               CALL iom_gettime ( id_w, ztcobc, cl_vname ) ; CALL iom_close (id_w) ; EXIT
+            ENDIF
+            IF ( lp_obc_north ) THEN
+               CALL iom_gettime ( id_n, ztcobc, cl_vname ) ; CALL iom_close (id_n) ; EXIT
+            ENDIF
+            IF ( lp_obc_south ) THEN
+               CALL iom_gettime ( id_s, ztcobc, cl_vname ) ; CALL iom_close (id_s) ; EXIT
+            ENDIF
+         END DO
+         rdt_obc = ztcobc(2)-ztcobc(1)  !  just an information, not used for any computation
+         IF (lwp) WRITE(numout,*) ' obcdta found', itobc,' time steps in the OBC files'
+         IF (lwp) WRITE(numout,*) ' time step of obc data :', rdt_obc,' days'            
+      ENDIF
+      zjcnes = zjcnes - rdt/rday  ! trick : zcnes is always incremented by rdt/rday in obc_dta!
+   END SUBROUTINE obc_dta_chktime
+
+# if defined key_dynspg_ts || defined key_dynspg_exp
+   SUBROUTINE obc_dta_bt( kt, kbt )
+      !!---------------------------------------------------------------------------
+      !!                      ***  SUBROUTINE obc_dta  ***
+      !!
+      !! ** Purpose :   time interpolation of barotropic data for time-splitting scheme
+      !!                Data at the boundary must be in m2/s 
+      !!
+      !! History :  9.0  !  05-11 (V. garnier) Original code
+      !!---------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index
+      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index
+      !
+      INTEGER ::   ji, jj  ! dummy loop indices
+      INTEGER ::   i15
+      INTEGER ::   itobcm, itobcp
+      REAL(wp) ::  zxy
+      INTEGER ::   isrel           ! number of seconds since 1/1/1992
+      !!---------------------------------------------------------------------------
+
+      ! 1.   First call: check time frames available in files.
+      ! -------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+
+         ! 1.1  Barotropic tangential velocities set to zero
+         ! -------------------------------------------------
+         IF( lp_obc_east  ) vbtfoe(:) = 0.e0
+         IF( lp_obc_west  ) vbtfow(:) = 0.e0
+         IF( lp_obc_south ) ubtfos(:) = 0.e0
+         IF( lp_obc_north ) ubtfon(:) = 0.e0
+
+         ! 1.2  Sea surface height and normal barotropic velocities set to zero
+         !                               or initial conditions if nobc_dta == 0
+         ! --------------------------------------------------------------------
+
+         IF( lp_obc_east ) THEN
+            ! initialisation to zero
+            sshedta(:,:) = 0.e0
+            ubtedta(:,:) = 0.e0
+            vbtedta(:,:) = 0.e0 ! tangential component
+            !                                        ! ================== !
+            IF( nobc_dta == 0 )   THEN               ! initial state used !
+               !                                     ! ================== !
+               !  Fills sedta, tedta, uedta (global arrays)
+               !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
+               DO ji = nie0, nie1
+                  DO jj = 1, jpj
+                     sshedta(jj,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         IF( lp_obc_west) THEN
+            ! initialisation to zero
+            sshwdta(:,:) = 0.e0
+            ubtwdta(:,:) = 0.e0
+            vbtwdta(:,:) = 0.e0 ! tangential component
+            !                                        ! ================== !
+            IF( nobc_dta == 0 )   THEN               ! initial state used !
+               !                                     ! ================== !
+               !  Fills swdta, twdta, uwdta (global arrays)
+               !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
+               DO ji = niw0, niw1
+                  DO jj = 1, jpj
+                     sshwdta(jj,1) = sshn(ji,jj) * tmask(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         IF( lp_obc_north) THEN
+            ! initialisation to zero
+            sshndta(:,:) = 0.e0
+            ubtndta(:,:) = 0.e0 ! tangential component
+            vbtndta(:,:) = 0.e0
+            !                                        ! ================== !
+            IF( nobc_dta == 0 ) THEN                 ! initial state used !
+               !                                     ! ================== !
+               !  Fills sndta, tndta, vndta (global arrays)
+               !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
+               DO jj = njn0, njn1
+                  DO ji = 1, jpi
+                     sshndta(ji,1) = sshn(ji,jj+1) * tmask(ji,jj+1,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         IF( lp_obc_south) THEN
+            ! initialisation to zero
+            sshsdta(:,:) = 0.e0
+            ubtsdta(:,:) = 0.e0 ! tangential component
+            vbtsdta(:,:) = 0.e0
+            !                                        ! ================== !
+            IF( nobc_dta == 0 )   THEN               ! initial state used !
+               !                                     ! ================== !
+               !  Fills ssdta, tsdta, vsdta (global arrays)
+               !  Remark: this works for njzoom = 1. Should the definition of ij include njzoom?
+               DO jj = njs0, njs1
+                  DO ji = 1, jpi
+                     sshsdta(ji,1) = sshn(ji,jj) * tmask(ji,jj,1)
+                  END DO
+               END DO
+            ENDIF
+         ENDIF
+
+         IF( nobc_dta == 0 ) CALL obc_depth_average(1)   ! depth averaged velocity from the OBC depth-dependent frames
+
+      ENDIF        !       END kt == nit000
+
+      !!------------------------------------------------------------------------------------
+      ! 2.      Initialize the time we are at. Does this every time the routine is called,
+      !         excepted when nobc_dta = 0
+      !
+
+      ! 3.  Call at every time step : Linear interpolation of BCs to current time step
+      ! ----------------------------------------------------------------------
+
+      IF( lk_dynspg_ts ) THEN
+         isrel = (kt-1)*rdt + kbt*(rdt/REAL(nn_baro,wp))
+      ELSE IF( lk_dynspg_exp ) THEN
+         isrel=kt*rdt
+      ENDIF
+
+      itobcm = nt_b
+      itobcp = nt_a
+      IF( itobc == 1 .OR. nobc_dta == 0 ) THEN
+         zxy = 0.e0
+         itobcm = 1
+         itobcp = 1
+      ELSE IF( itobc == 12 ) THEN
+         i15   = nday / 16
+         zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.
+      ELSE
+         zxy = (zjcnes_obc(nt_a)-FLOAT(isrel)) / (zjcnes_obc(nt_a)-zjcnes_obc(nt_b))
+         IF( zxy < 0. ) THEN   ! case of extrapolation, switch to old time frames
+            itobcm = nt_m
+            itobcp = nt_b
+            zxy = (zjcnes_obc(nt_b)-FLOAT(isrel)) / (zjcnes_obc(nt_b)-zjcnes_obc(nt_m))
+         ENDIF
+      ENDIF
+
+      IF( lp_obc_east ) THEN           !  fills sshfoe, ubtfoe (local to each processor)
+         DO jj = 1, jpj
+            sshfoe(jj) = zxy * sshedta(jj,itobcp) + (1.-zxy) * sshedta(jj,itobcm)
+            ubtfoe(jj) = zxy * ubtedta(jj,itobcp) + (1.-zxy) * ubtedta(jj,itobcm)
+            vbtfoe(jj) = zxy * vbtedta(jj,itobcp) + (1.-zxy) * vbtedta(jj,itobcm)
+         END DO
+      ENDIF
+
+      IF( lp_obc_west) THEN            !  fills sshfow, ubtfow (local to each processor)
+         DO jj = 1, jpj
+            sshfow(jj) = zxy * sshwdta(jj,itobcp) + (1.-zxy) * sshwdta(jj,itobcm)
+            ubtfow(jj) = zxy * ubtwdta(jj,itobcp) + (1.-zxy) * ubtwdta(jj,itobcm)
+            vbtfow(jj) = zxy * vbtwdta(jj,itobcp) + (1.-zxy) * vbtwdta(jj,itobcm)
+         END DO
+      ENDIF
+
+      IF( lp_obc_north) THEN           !  fills sshfon, vbtfon (local to each processor)
+         DO ji = 1, jpi
+            sshfon(ji) = zxy * sshndta(ji,itobcp) + (1.-zxy) * sshndta(ji,itobcm)
+            ubtfon(ji) = zxy * ubtndta(ji,itobcp) + (1.-zxy) * ubtndta(ji,itobcm)
+            vbtfon(ji) = zxy * vbtndta(ji,itobcp) + (1.-zxy) * vbtndta(ji,itobcm)
+         END DO
+      ENDIF
+
+      IF( lp_obc_south) THEN           !  fills sshfos, vbtfos (local to each processor)
+         DO ji = 1, jpi
+            sshfos(ji) = zxy * sshsdta(ji,itobcp) + (1.-zxy) * sshsdta(ji,itobcm)
+            ubtfos(ji) = zxy * ubtsdta(ji,itobcp) + (1.-zxy) * ubtsdta(ji,itobcm)
+            vbtfos(ji) = zxy * vbtsdta(ji,itobcp) + (1.-zxy) * vbtsdta(ji,itobcm)
+         END DO
+      ENDIF
+
+   END SUBROUTINE obc_dta_bt
+
+# else
+   !!-----------------------------------------------------------------------------
+   !!   Default option
+   !!-----------------------------------------------------------------------------
+   SUBROUTINE obc_dta_bt ( kt, kbt )       ! Empty routine
+      !! * Arguments
+      INTEGER,INTENT(in) :: kt
+      INTEGER, INTENT( in ) ::   kbt         ! barotropic ocean time-step index
+      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt
+      WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt
+   END SUBROUTINE obc_dta_bt
+# endif
+
+   SUBROUTINE obc_read (kt, nt_x, ntobc_x, iyy, imm)
+      !!-------------------------------------------------------------------------
+      !!                      ***  ROUTINE obc_read  ***
+      !!
+      !! ** Purpose :  Read the boundary data in files identified by iyy and imm
+      !!               According to the validated open boundaries, return the 
+      !!               following arrays :
+      !!                sedta, tedta : East OBC salinity and temperature
+      !!                uedta, vedta :   "   "  u and v velocity component      
+      !!
+      !!                swdta, twdta : West OBC salinity and temperature
+      !!                uwdta, vwdta :   "   "  u and v velocity component      
+      !!
+      !!                sndta, tndta : North OBC salinity and temperature
+      !!                undta, vndta :   "   "  u and v velocity component      
+      !!
+      !!                ssdta, tsdta : South OBC salinity and temperature
+      !!                usdta, vsdta :   "   "  u and v velocity component      
+      !!
+      !! ** Method  :  These fields are read in the record ntobc_x of the files.
+      !!               The number of records is already known. If  ntobc_x is greater
+      !!               than the number of record, this routine will look for next file,
+      !!               updating the indices (case of inter-annual obcs) or loop at the
+      !!               begining in case of climatological file (ln_obc_clim = true ).
+      !! -------------------------------------------------------------------------
+      !! History:     !  2005  ( P. Mathiot, C. Langlais ) Original code
+      !!              !  2008  ( J,M, Molines ) Use IOM and cleaning
+      !!--------------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT( in ) :: kt, nt_x
+      INTEGER, INTENT( inout ) :: ntobc_x , iyy, imm      ! yes ! inout !
+
+      ! * Local variables
+      CHARACTER (len=40) :: &    ! file names
+         cl_obc_eTS   , cl_obc_eU,  cl_obc_eV,&
+         cl_obc_wTS   , cl_obc_wU,  cl_obc_wV,&
+         cl_obc_nTS   , cl_obc_nU,  cl_obc_nV,&
+         cl_obc_sTS   , cl_obc_sU,  cl_obc_sV
+
+      INTEGER :: ikprint
+      REAL(wp) :: zmin, zmax   ! control of boundary values
+
+      !IOM stuff
+      INTEGER :: id_e, id_w, id_n, id_s
+      INTEGER, DIMENSION(2) :: istart, icount
+
+      !--------------------------------------------------------------------------
+      IF ( ntobc_x > itobc ) THEN
+         IF (ln_obc_clim) THEN  ! just loop on the same file
+            ntobc_x = 1 
+         ELSE
+            ! need to change file : it is always for an 'after' data
+            IF ( cffile == 'annual' ) THEN ! go to next year file
+               iyy = iyy + 1
+            ELSE IF ( cffile =='monthly' ) THEN  ! go to next month file
+               imm = imm + 1 
+               IF ( imm == 13 ) THEN 
+                  imm = 1 ; iyy = iyy + 1
+               ENDIF
+            ELSE
+               ctmp1='obcread : this type of obc file is not supported :( '
+               ctmp2=TRIM(cffile)
+               CALL ctl_stop (ctmp1, ctmp2)
+               ! cffile should be either annual or monthly ...
+            ENDIF
+            ! as the file is changed, need to update itobc etc ...
+            CALL obc_dta_chktime (iyy,imm)
+            ntobc_x = nrecbef() + 1 ! remember : this case occur for an after data
+         ENDIF
+      ENDIF
+
+      IF( lp_obc_east ) THEN 
+         ! ... Read datafile and set temperature, salinity and normal velocity
+         ! ... initialise the sedta, tedta, uedta arrays
+         IF(ln_obc_clim) THEN  ! revert to old convention for climatological OBC forcing
+            cl_obc_eTS='obceast_TS.nc'
+            cl_obc_eU ='obceast_U.nc'
+            cl_obc_eV ='obceast_V.nc'
+         ELSE                  ! convention for climatological OBC
+            WRITE(cl_obc_eTS ,'("obc_east_TS_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_eU  ,'("obc_east_U_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_eV  ,'("obc_east_V_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+         ENDIF
+         ! JMM this may change depending on the obc data format ...
+         istart(:)=(/nje0+njmpp-1,1/) ; icount(:)=(/nje1-nje0 +1,jpk/)
+         IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_eTS)
+         IF (nje1 >= nje0 ) THEN
+            CALL iom_open ( cl_obc_eTS , id_e )
+            CALL iom_get ( id_e, jpdom_unknown, 'votemper', tedta(nje0:nje1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_get ( id_e, jpdom_unknown, 'vosaline', sedta(nje0:nje1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# if defined key_dynspg_ts || defined key_dynspg_exp
+            CALL iom_get ( id_e, jpdom_unknown, 'vossurfh', sshedta(nje0:nje1,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# endif
+            CALL iom_close (id_e)
+            !
+            CALL iom_open ( cl_obc_eU , id_e )
+            CALL iom_get  ( id_e, jpdom_unknown, 'vozocrtx', uedta(nje0:nje1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_e )
+            !
+            CALL iom_open ( cl_obc_eV , id_e )
+            CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_e )
+
+            ! mask the boundary values
+            tedta(:,:,nt_x) = tedta(:,:,nt_x)*temsk(:,:) ;  sedta(:,:,nt_x) = sedta(:,:,nt_x)*temsk(:,:)
+            uedta(:,:,nt_x) = uedta(:,:,nt_x)*uemsk(:,:) ;  vedta(:,:,nt_x) = vedta(:,:,nt_x)*vemsk(:,:)
+
+            ! check any outliers 
+            zmin=MINVAL( sedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(sedta(:,:,nt_x), mask=ltemsk)
+            IF (  zmin < 5 .OR. zmax > 50)   THEN
+               CALL ctl_stop('Error in sedta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( tedta(:,:,nt_x), mask=ltemsk ) ; zmax=MAXVAL(tedta(:,:,nt_x), mask=ltemsk)
+            IF (  zmin < -10. .OR. zmax > 40)   THEN
+               CALL ctl_stop('Error in tedta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( uedta(:,:,nt_x), mask=luemsk ) ; zmax=MAXVAL(uedta(:,:,nt_x), mask=luemsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in uedta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( vedta(:,:,nt_x), mask=lvemsk ) ; zmax=MAXVAL(vedta(:,:,nt_x), mask=lvemsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in vedta',' routine obcdta')
+            ENDIF
+
+            !               Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1      
+            IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' Read East OBC data records ', ntobc_x
+               ikprint = jpj/20 +1
+               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level'
+               CALL prihre( tedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level'
+               CALL prihre( sedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level'
+               CALL prihre( uedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Tangential velocity V  record 1  - printout every 3 level'
+               CALL prihre( vedta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+            ENDIF
+         ENDIF
+      ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      IF ( lp_obc_west ) THEN
+         ! ... Read datafile and set temperature, salinity and normal velocity
+         ! ... initialise the swdta, twdta, uwdta arrays
+         IF (ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing
+            cl_obc_wTS='obcwest_TS.nc'
+            cl_obc_wU ='obcwest_U.nc'
+            cl_obc_wV ='obcwest_V.nc'
+         ELSE                    ! convention for climatological OBC
+            WRITE(cl_obc_wTS ,'("obc_west_TS_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_wU  ,'("obc_west_U_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_wV  ,'("obc_west_V_y"   ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+         ENDIF
+         istart(:)=(/njw0+njmpp-1,1/) ; icount(:)=(/njw1-njw0 +1,jpk/)
+         IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_wTS)
+
+         IF ( njw1 >= njw0 ) THEN
+            CALL iom_open ( cl_obc_wTS , id_w )
+            CALL iom_get ( id_w, jpdom_unknown, 'votemper', twdta(njw0:njw1,:,nt_x), & 
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+
+            CALL iom_get ( id_w, jpdom_unknown, 'vosaline', swdta(njw0:njw1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount)
+# if defined key_dynspg_ts || defined key_dynspg_exp
+            CALL iom_get ( id_w, jpdom_unknown, 'vossurfh', sshwdta(njw0:njw1,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# endif
+            CALL iom_close (id_w)
+            !
+            CALL iom_open ( cl_obc_wU , id_w )
+            CALL iom_get  ( id_w, jpdom_unknown, 'vozocrtx', uwdta(njw0:njw1,:,nt_x),&
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_w )
+            !
+            CALL iom_open ( cl_obc_wV , id_w )
+            CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_w )
+
+            ! mask the boundary values
+            twdta(:,:,nt_x) = twdta(:,:,nt_x)*twmsk(:,:) ;  swdta(:,:,nt_x) = swdta(:,:,nt_x)*twmsk(:,:)
+            uwdta(:,:,nt_x) = uwdta(:,:,nt_x)*uwmsk(:,:) ;  vwdta(:,:,nt_x) = vwdta(:,:,nt_x)*vwmsk(:,:)
+
+            ! check any outliers
+            zmin=MINVAL( swdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(swdta(:,:,nt_x), mask=ltwmsk)
+            IF (  zmin < 5 .OR. zmax > 50)   THEN
+               CALL ctl_stop('Error in swdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( twdta(:,:,nt_x), mask=ltwmsk ) ; zmax=MAXVAL(twdta(:,:,nt_x), mask=ltwmsk)
+            IF (  zmin < -10. .OR. zmax > 40)   THEN
+               CALL ctl_stop('Error in twdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( uwdta(:,:,nt_x), mask=luwmsk ) ; zmax=MAXVAL(uwdta(:,:,nt_x), mask=luwmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in uwdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( vwdta(:,:,nt_x), mask=lvwmsk ) ; zmax=MAXVAL(vwdta(:,:,nt_x), mask=lvwmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in vwdta',' routine obcdta')
+            ENDIF
+
+
+            IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' Read West OBC data records ', ntobc_x
+               ikprint = jpj/20 +1
+               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level'
+               CALL prihre( twdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level'
+               CALL prihre( swdta(:,:,nt_x),jpj,jpk, 1, jpj, ikprint,   jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Normal velocity U  record 1  - printout every 3 level'
+               CALL prihre( uwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Tangential velocity V  record 1  - printout every 3 level'
+               CALL prihre( vwdta(:,:,nt_x), jpj, jpk, 1, jpj, ikprint, jpk, 1, -3, 1., numout )
+            ENDIF
+         END IF
+      ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      IF( lp_obc_north) THEN
+         IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing
+            cl_obc_nTS='obcnorth_TS.nc'
+            cl_obc_nU ='obcnorth_U.nc'
+            cl_obc_nV ='obcnorth_V.nc'
+         ELSE                   ! convention for climatological OBC
+            WRITE(cl_obc_nTS ,'("obc_north_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_nV  ,'("obc_north_V_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_nU  ,'("obc_north_U_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+         ENDIF
+         istart(:)=(/nin0+nimpp-1,1/) ; icount(:)=(/nin1-nin0 +1,jpk/)
+         IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_nTS)
+         IF ( nin1 >= nin0 ) THEN
+            CALL iom_open ( cl_obc_nTS , id_n )
+            CALL iom_get ( id_n, jpdom_unknown, 'votemper', tndta(nin0:nin1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_get ( id_n, jpdom_unknown, 'vosaline', sndta(nin0:nin1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# if defined key_dynspg_ts || defined key_dynspg_exp
+            CALL iom_get ( id_n, jpdom_unknown, 'vossurfh', sshndta(nin0:nin1,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# endif
+            CALL iom_close (id_n)
+            !
+            CALL iom_open ( cl_obc_nU , id_n )
+            CALL iom_get  ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_n )
+            !
+            CALL iom_open ( cl_obc_nV , id_n )
+            CALL iom_get  ( id_n, jpdom_unknown, 'vomecrty', vndta(nin0:nin1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_n )
+
+            ! mask the boundary values
+            tndta(:,:,nt_x) = tndta(:,:,nt_x)*tnmsk(:,:) ;  sndta(:,:,nt_x) = sndta(:,:,nt_x)*tnmsk(:,:)
+            undta(:,:,nt_x) = undta(:,:,nt_x)*unmsk(:,:) ;  vndta(:,:,nt_x) = vndta(:,:,nt_x)*vnmsk(:,:)
+
+            ! check any outliers
+            zmin=MINVAL( sndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(sndta(:,:,nt_x), mask=ltnmsk)
+            IF (  zmin < 5 .OR. zmax > 50)   THEN
+               CALL ctl_stop('Error in sndta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( tndta(:,:,nt_x), mask=ltnmsk ) ; zmax=MAXVAL(tndta(:,:,nt_x), mask=ltnmsk)
+            IF (  zmin < -10. .OR. zmax > 40)   THEN
+               CALL ctl_stop('Error in tndta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( undta(:,:,nt_x), mask=lunmsk ) ; zmax=MAXVAL(undta(:,:,nt_x), mask=lunmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in undta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( vndta(:,:,nt_x), mask=lvnmsk ) ; zmax=MAXVAL(vndta(:,:,nt_x), mask=lvnmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in vndta',' routine obcdta')
+            ENDIF
+
+            IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' Read North OBC data records ', ntobc_x
+               ikprint = jpi/20 +1
+               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level'
+               CALL prihre( tndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level'
+               CALL prihre( sndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level'
+               CALL prihre( vndta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Tangential  velocity U  record 1  - printout every 3 level'
+               CALL prihre( undta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+            ENDIF
+         ENDIF
+      ENDIF
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      IF( lp_obc_south) THEN 
+         IF(ln_obc_clim) THEN   ! revert to old convention for climatological OBC forcing
+            cl_obc_sTS='obcsouth_TS.nc'
+            cl_obc_sU ='obcsouth_U.nc'
+            cl_obc_sV ='obcsouth_V.nc'
+         ELSE                    ! convention for climatological OBC
+            WRITE(cl_obc_sTS ,'("obc_south_TS_y" ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_sV  ,'("obc_south_V_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+            WRITE(cl_obc_sU  ,'("obc_south_U_y"  ,i4.4,"m",i2.2,".nc")' ) iyy,imm
+         ENDIF
+         istart(:)=(/nis0+nimpp-1,1/) ; icount(:)=(/nis1-nis0 +1,jpk/)
+         IF (lwp) WRITE(numout,*) 'read data in :', TRIM(cl_obc_sTS)
+         IF ( nis1 >= nis0 ) THEN 
+            CALL iom_open ( cl_obc_sTS , id_s )
+            CALL iom_get ( id_s, jpdom_unknown, 'votemper', tsdta(nis0:nis1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_get ( id_s, jpdom_unknown, 'vosaline', ssdta(nis0:nis1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# if defined key_dynspg_ts || defined key_dynspg_exp
+            CALL iom_get ( id_s, jpdom_unknown, 'vossurfh', sshsdta(nis0:nis1,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+# endif
+            CALL iom_close (id_s)
+            !
+            CALL iom_open ( cl_obc_sU , id_s )
+            CALL iom_get  ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_s )
+            !
+            CALL iom_open ( cl_obc_sV , id_s )
+            CALL iom_get  ( id_s, jpdom_unknown, 'vomecrty', vsdta(nis0:nis1,:,nt_x), &
+               &               ktime=ntobc_x , kstart=istart, kcount= icount )
+            CALL iom_close ( id_s )
+
+            ! mask the boundary values
+            tsdta(:,:,nt_x) = tsdta(:,:,nt_x)*tsmsk(:,:) ;  ssdta(:,:,nt_x) = ssdta(:,:,nt_x)*tsmsk(:,:)
+            usdta(:,:,nt_x) = usdta(:,:,nt_x)*usmsk(:,:) ;  vsdta(:,:,nt_x) = vsdta(:,:,nt_x)*vsmsk(:,:)
+
+            ! check any outliers
+            zmin=MINVAL( ssdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(ssdta(:,:,nt_x), mask=ltsmsk)
+            IF (  zmin < 5 .OR. zmax > 50)   THEN
+               CALL ctl_stop('Error in ssdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( tsdta(:,:,nt_x), mask=ltsmsk ) ; zmax=MAXVAL(tsdta(:,:,nt_x), mask=ltsmsk)
+            IF (  zmin < -10. .OR. zmax > 40)   THEN
+               CALL ctl_stop('Error in tsdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( usdta(:,:,nt_x), mask=lusmsk ) ; zmax=MAXVAL(usdta(:,:,nt_x), mask=lusmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in usdta',' routine obcdta')
+            ENDIF
+            zmin=MINVAL( vsdta(:,:,nt_x), mask=lvsmsk ) ; zmax=MAXVAL(vsdta(:,:,nt_x), mask=lvsmsk)
+            IF (  zmin < -5. .OR. zmax > 5.)   THEN
+               CALL ctl_stop('Error in vsdta',' routine obcdta')
+            ENDIF
+
+            IF ( lwp .AND.  ( kt == nit000 .OR. nprint /= 0 )  ) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' Read South OBC data records ', ntobc_x
+               ikprint = jpi/20 +1
+               WRITE(numout,*) ' Temperature  record 1 - printout every 3 level'
+               CALL prihre( tsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Salinity  record 1 - printout every 3 level'
+               CALL prihre( ssdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Normal velocity V  record 1  - printout every 3 level'
+               CALL prihre( vsdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+               WRITE(numout,*)
+               WRITE(numout,*) ' Tangential velocity U  record 1  - printout every 3 level'
+               CALL prihre( usdta(:,:,nt_x), jpi, jpk, 1, jpi, ikprint, jpk, 1, -3, 1., numout )
+            ENDIF
+         ENDIF
+      ENDIF
+
+# if defined key_dynspg_ts || defined key_dynspg_exp
+      CALL obc_depth_average(nt_x)   ! computation of depth-averaged velocity
+# endif
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   END SUBROUTINE obc_read
+
+
+   INTEGER FUNCTION nrecbef()
+      !!-----------------------------------------------------------------------
+      !!                     ***    FUNCTION nrecbef   ***
+      !!
+      !!  Purpose : - provide the before record number in files, with respect to zjcnes
+      !!
+      !!    History : 2008-04 : ( J.M. Molines ) Original code
+      !!-----------------------------------------------------------------------
+
+      INTEGER :: it , idum
+
+      idum = itobc
+      DO it =1, itobc
+         IF ( ztcobc(it) > zjcnes ) THEN ;  idum = it - 1 ; EXIT ;  ENDIF
+         ENDDO
+         ! idum can be 0 (climato, before first record)
+         IF ( idum == 0 ) THEN
+            IF ( ln_obc_clim ) THEN
+               idum = itobc
+            ELSE
+               ctmp1='obc_dta: find ntobc == 0 for  non climatological file '
+               ctmp2='consider adding a first record in your data file '
+               CALL ctl_stop(ctmp1, ctmp2)
+            ENDIF
+         ENDIF
+         ! idum can be itobc ( zjcnes > ztcobc (itobc) )
+         !  This is not a problem ...
+         nrecbef = idum
+
+      END FUNCTION nrecbef
+
+
+      SUBROUTINE obc_depth_average(nt_x)
+         !!-----------------------------------------------------------------------
+         !!                     ***    ROUTINE obc_depth_average   ***
+         !!
+         !!  Purpose : - compute the depth-averaged velocity from depth-dependent OBC frames
+         !!
+         !!    History : 2009-01 : ( Fred Dupont ) Original code
+         !!-----------------------------------------------------------------------
+
+         ! * Arguments
+         INTEGER, INTENT( in ) :: nt_x
+
+         ! * Local variables
+         INTEGER :: ji, jj, jk
+
+
+         IF( lp_obc_east ) THEN
+            ! initialisation to zero
+            ubtedta(:,nt_x) = 0.e0
+            vbtedta(:,nt_x) = 0.e0
+            DO ji = nie0, nie1
+               DO jj = 1, jpj
+                  DO jk = 1, jpkm1
+                     ubtedta(jj,nt_x) = ubtedta(jj,nt_x) + uedta(jj,jk,nt_x)*fse3u(ji,jj,jk)
+                     vbtedta(jj,nt_x) = vbtedta(jj,nt_x) + vedta(jj,jk,nt_x)*fse3v(ji+1,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         IF( lp_obc_west) THEN
+            ! initialisation to zero
+            ubtwdta(:,nt_x) = 0.e0
+            vbtwdta(:,nt_x) = 0.e0
+            DO ji = niw0, niw1
+               DO jj = 1, jpj
+                  DO jk = 1, jpkm1
+                     ubtwdta(jj,nt_x) = ubtwdta(jj,nt_x) + uwdta(jj,jk,nt_x)*fse3u(ji,jj,jk)
+                     vbtwdta(jj,nt_x) = vbtwdta(jj,nt_x) + vwdta(jj,jk,nt_x)*fse3v(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         IF( lp_obc_north) THEN
+            ! initialisation to zero
+            ubtndta(:,nt_x) = 0.e0
+            vbtndta(:,nt_x) = 0.e0
+            DO jj = njn0, njn1
+               DO ji = 1, jpi
+                  DO jk = 1, jpkm1
+                     ubtndta(ji,nt_x) = ubtndta(ji,nt_x) + undta(ji,jk,nt_x)*fse3u(ji,jj+1,jk)
+                     vbtndta(ji,nt_x) = vbtndta(ji,nt_x) + vndta(ji,jk,nt_x)*fse3v(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+         IF( lp_obc_south) THEN
+            ! initialisation to zero
+            ubtsdta(:,nt_x) = 0.e0
+            vbtsdta(:,nt_x) = 0.e0
+            DO jj = njs0, njs1
+               DO ji = nis0, nis1
+                  DO jk = 1, jpkm1
+                     ubtsdta(ji,nt_x) = ubtsdta(ji,nt_x) + usdta(ji,jk,nt_x)*fse3u(ji,jj,jk)
+                     vbtsdta(ji,nt_x) = vbtsdta(ji,nt_x) + vsdta(ji,jk,nt_x)*fse3v(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+
+      END SUBROUTINE obc_depth_average
+
+#else
+      !!------------------------------------------------------------------------------
+      !!   default option:           Dummy module          NO Open Boundary Conditions
+      !!------------------------------------------------------------------------------
+   CONTAINS
+      SUBROUTINE obc_dta( kt )             ! Dummy routine
+         INTEGER, INTENT (in) :: kt
+         WRITE(*,*) 'obc_dta: You should not have seen this print! error?', kt
+      END SUBROUTINE obc_dta
+      !!-----------------------------------------------------------------------------
+      !!   Default option
+      !!-----------------------------------------------------------------------------
+      SUBROUTINE obc_dta_bt ( kt, kbt )     ! Empty routine
+         INTEGER,INTENT(in) :: kt
+         INTEGER, INTENT( in ) ::   kbt     ! barotropic ocean time-step index
+         WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt
+         WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kbt
+      END SUBROUTINE obc_dta_bt
+#endif
+   !!==============================================================================
+   END MODULE obcdta
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn.F90	(revision 3437)
@@ -0,0 +1,702 @@
+MODULE obcdyn
+#if defined key_obc
+   !!=================================================================================
+   !!                       ***  MODULE  obcdyn  ***
+   !! Ocean dynamics:   Radiation of velocities on each open boundary
+   !!=================================================================================
+
+   !!---------------------------------------------------------------------------------
+   !!   obc_dyn        : call the subroutine for each open boundary
+   !!   obc_dyn_east   : radiation of the east open boundary velocities
+   !!   obc_dyn_west   : radiation of the west open boundary velocities
+   !!   obc_dyn_north  : radiation of the north open boundary velocities
+   !!   obc_dyn_south  : radiation of the south open boundary velocities
+   !!----------------------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ???
+   USE lib_mpp         ! ???
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_dyn     ! routine called in dynspg_flt (free surface case)
+
+   !! * Module variables
+   INTEGER ::   ji, jj, jk     ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   REAL(wp) ::   rtaue  , rtauw  , rtaun  , rtaus  ,  &
+                 rtauein, rtauwin, rtaunin, rtausin
+
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_dyn ( kt )
+      !!------------------------------------------------------------------------------
+      !!                      SUBROUTINE obc_dyn
+      !!                     ********************
+      !! ** Purpose :
+      !!      Compute  dynamics (u,v) at the open boundaries.
+      !!      if defined key_dynspg_flt: 
+      !!                 this routine is called by dynspg_flt and updates
+      !!                 ua, va which are the actual velocities (not trends)
+      !!
+      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 
+      !!      and/or lp_obc_south allow the user to determine which boundary is an
+      !!      open one (must be done in the param_obc.h90 file).
+      !!
+      !! ** Reference : 
+      !!      Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !! History :
+      !!        !  95-03 (J.-M. Molines) Original, SPEM
+      !!        !  97-07 (G. Madec, J.-M. Molines) addition
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !!----------------------------------------------------------------------
+      !!  OPA 9.0 , LOCEAN-IPSL (2005) 
+      !! $Id: obcdyn.F90 1528 2009-07-23 14:38:47Z rblod $ 
+      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
+      !!----------------------------------------------------------------------
+
+      ! 0. Local constant initialization
+      ! --------------------------------
+
+      IF( kt == nit000 .OR. ln_rstart) THEN
+         ! ... Boundary restoring coefficient
+         rtaue = 2. * rdt / rdpeob
+         rtauw = 2. * rdt / rdpwob
+         rtaun = 2. * rdt / rdpnob
+         rtaus = 2. * rdt / rdpsob
+         ! ... Boundary restoring coefficient for inflow ( all boundaries)
+         rtauein = 2. * rdt / rdpein 
+         rtauwin = 2. * rdt / rdpwin
+         rtaunin = 2. * rdt / rdpnin
+         rtausin = 2. * rdt / rdpsin 
+      END IF
+
+      IF( lp_obc_east  )   CALL obc_dyn_east ( kt )
+      IF( lp_obc_west  )   CALL obc_dyn_west ( kt )
+      IF( lp_obc_north )   CALL obc_dyn_north( kt )
+      IF( lp_obc_south )   CALL obc_dyn_south( kt )
+
+      IF( lk_mpp ) THEN
+         IF( kt >= nit000+3 .AND. ln_rstart ) THEN
+            CALL lbc_lnk( ub, 'U', -1. )
+            CALL lbc_lnk( vb, 'V', -1. )
+         END IF
+         CALL lbc_lnk( ua, 'U', -1. )
+         CALL lbc_lnk( va, 'V', -1. )
+      ENDIF
+
+   END SUBROUTINE obc_dyn
+
+
+   SUBROUTINE obc_dyn_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_east  ***
+      !!              
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on east OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
+      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!    9.0  ! 05-11  (V. Garnier) Surface pressure gradient organization
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbceast is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp ) THEN
+
+         ! 1.1 U zonal velocity    
+         ! --------------------
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + &
+                                 uemsk(jj,jk)*ufoe(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO ji = nie0+1, nie1+1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vemsk(jj,jk)) + &
+                                 vfoe(jj,jk)*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
+      ! -----------------------------------------------------
+ 
+         ! 2.1. u-component of the velocity
+         ! ---------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |   nibm  |   nib   |///
+         !            |    |    |    |    |///
+         !  jj-line --f----v----f----v----f---
+         !            |    |    |    |    |///
+         !            |         |         |///
+         !  jj-line   u    T    u    T    u///
+         !            |         |         |///
+         !            |    |    |    |    |///
+         !          jpieob-2   jpieob-1   jpieob
+         !                 |         |        
+         !              jpieob-1    jpieob    
+         !  
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjedp1, jpjefm1),jpieob
+         DO ji = nie0, nie1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = u_cxebnd(jj,jk)
+                  z05cx = z05cx / e1t(ji,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update ua with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uemsk(jj,jk) ) +          &
+                                 uemsk(jj,jk) * (  ( 1. - z05cx - ztau )         &
+                                 * uebnd(jj,jk,nib ,nitm) + 2.*z05cx               &
+                                 * uebnd(jj,jk,nibm,nit ) + ztau * ufoe (jj,jk) )  &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !          nibm2       nibm     nib
+         !            |   nibm  |   nib///|///
+         !            |    |    |    |////|///
+         !  jj-line --v----f----v----f----v---
+         !            |    |    |    |////|///
+         !            |    |    |    |////|///
+         !            | jpieob-1 |  jpieob /|///
+         !            |         |         |   
+         !         jpieob-1    jpieob     jpieob+1
+         !
+         ! ... radiative condition
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = nie0+1, nie1+1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = v_cxebnd(jj,jk) 
+                  z05cx = z05cx / e1f(ji-1,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1. - vemsk(jj,jk) ) +          &
+                                 vemsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * vebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * vebnd(jj,jk,nibm,nit ) + ztau * vfoe(jj,jk) )  &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_dyn_east
+
+
+   SUBROUTINE obc_dyn_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_west  ***
+      !!                  
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on west OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
+      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!    9.0  ! 05-11  (V. Garnier) Surface pressure gradient organization
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcwest is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp ) THEN
+
+         ! 1.1 U zonal velocity
+         ! ---------------------
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + &
+                                 uwmsk(jj,jk)*ufow(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vwmsk(jj,jk)) + &
+                                 vfow(jj,jk)*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
+      ! -----------------------------------------------------
+ 
+         ! 2.1. u-component of the velocity
+         ! ---------------------------------
+         !
+         !        nib       nibm     nibm2
+         !      ///|   nib   |   nibm  |
+         !      ///|    |    |    |    |
+         !      ---f----v----f----v----f-- jj-line
+         !      ///|    |    |    |    |
+         !      ///|         |         |
+         !      ///u    T    u    T    u   jj-line
+         !      ///|         |         |
+         !      ///|    |    |    |    |
+         !       jpiwob    jpiwob+1    jpiwob+2
+         !              |         |        
+         !            jpiwob+1    jpiwob+2     
+         !
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjwdp1, jpjwfm1), jpiwob
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = u_cxwbnd(jj,jk)
+                  z05cx = z05cx / e1t(ji+1,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05c  > 0, inflow  zin=0, ztau=1    
+         !          =< 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )* rtauwin + zin * rtauw
+                  z05cx = z05cx * zin
+         ! ... update un with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * ( 1. - uwmsk(jj,jk) ) +          &
+                                 uwmsk(jj,jk) * ( ( 1. + z05cx - ztau )          &
+                                 * uwbnd(jj,jk,nib ,nitm) - 2.*z05cx               &
+                                 * uwbnd(jj,jk,nibm,nit ) + ztau  * ufow (jj,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !    nib       nibm     nibm2
+         !  ///|///nib   |   nibm  |  nibm2
+         !  ///|////|    |    |    |    |    |
+         !  ---v----f----v----f----v----f----v-- jj-line
+         !  ///|////|    |    |    |    |    |
+         !  ///|////|    |    |    |    |    |
+         ! jpiwob     jpiwob+1    jpiwob+2
+         !          |         |         |   
+         !        jpiwob   jpiwob+1   jpiwob+2    
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... (jpjwdp1, jpjwfm1),jpiwob
+         DO ji = niw0, niw1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  z05cx = v_cxwbnd(jj,jk)  
+                  z05cx = z05cx / e1f(ji,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1    
+         !          =< 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtauwin + zin * rtauw
+                  z05cx = z05cx * zin 
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1. - vwmsk(jj,jk) ) +          &
+                                 vwmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * vwbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * vwbnd(jj,jk,nibm,nit ) + ztau * vfow (jj,jk) ) &
+                                 / (1. - z05cx)
+                END DO
+             END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_dyn_west
+
+   SUBROUTINE obc_dyn_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_north
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on north OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
+      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!    9.0  ! 05-11  (V. Garnier) Surface pressure gradient organization
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcnorth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! ---------------------------------------------------------
+ 
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth  .OR. lk_dynspg_exp ) THEN
+
+         ! 1.1 U zonal velocity
+         ! --------------------
+         DO jj = njn0+1, njn1+1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-unmsk(ji,jk)) + &
+                                ufon(ji,jk)*unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO jj = njn0, njn1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + &
+                                vfon(ji,jk)*vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
+      ! ------------------------------------------------------
+
+         ! 2.1. u-component of the velocity
+         ! --------------------------------
+         !
+         !            ji-row
+         !              |
+         !       nib ///u//////  jpjnob + 1
+         !         /////|//////
+         !     nib -----f-----   jpjnob
+         !              |    
+         !      nibm--  u   ---- jpjnob
+         !              |        
+         !    nibm -----f-----   jpjnob-1
+         !              |        
+         !     nibm2--  u   ---- jpjnob-1
+         !              |        
+         !   nibm2 -----f-----   jpjnob-2
+         !              |
+         !
+         ! ... radiative condition
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = njn0+1, njn1+1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx= u_cynbnd(ji,jk) 
+                  z05cx = z05cx / e2f(ji, jj-1)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin  + zin * rtaun
+         ! ... for u, when inflow, ufon is prescribed
+                  z05cx = z05cx * zin
+         ! ... update un with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-unmsk(ji,jk)) +             &
+                                 unmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * unbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * unbnd(ji,jk,nibm,nit ) + ztau * ufon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !                ji-row    ji-row
+         !              |         |
+         !         /////|/////////////////
+         !    nib  -----f----v----f----  jpjnob
+         !              |         |
+         !      nib  -  u -- T -- u ---- jpjnob
+         !              |         |
+         !   nibm  -----f----v----f----  jpjnob-1
+         !              |         |
+         !     nibm --  u -- T -- u ---  jpjnob-1
+         !              |         |
+         !   nibm2 -----f----v----f----  jpjnob-2
+         !              |         |
+         !
+         ! ... Free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjnob,(jpindp1, jpinfm1)
+         DO jj = njn0, njn1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  z05cx = v_cynbnd(ji,jk)
+                  z05cx = z05cx / e2t(ji,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin + zin * rtaun
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vnmsk(ji,jk)) +             &
+                                 vnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * vnbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * vnbnd(ji,jk,nibm,nit ) + ztau * vfon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+      END IF
+
+   END SUBROUTINE obc_dyn_north
+
+   SUBROUTINE obc_dyn_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_dyn_south
+      !!                    *************************
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on south OBC velocities ua, va using the 
+      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
+      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!    9.0  ! 05-11  (V. Garnier) Surface pressure gradient organization
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      REAL(wp) ::   z05cx, ztau, zin
+
+      !!------------------------------------------------------------------------------
+      !!  OPA 8.5, LODYC-IPSL (2002)
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcsouth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! ---------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth  .OR. lk_dynspg_exp ) THEN
+
+         ! 1.1 U zonal velocity
+         ! --------------------
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  ua(ji,jj,jk)= ua(ji,jj,jk) * (1.-usmsk(ji,jk)) + &
+                                usmsk(ji,jk) * ufos(ji,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 1.2 V meridional velocity
+         ! -------------------------
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + &
+                                vsmsk(ji,jk) * vfos(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
+      ! ------------------------------------------------------
+
+         ! 2.1. u-component of the velocity
+         ! --------------------------------
+         !
+         !            ji-row
+         !              |
+         !   nibm2 -----f-----   jpjsob +2
+         !              |    
+         !    nibm2 --  u   ---- jpjsob +2 
+         !              |        
+         !    nibm -----f-----   jpjsob +1
+         !              |        
+         !    nibm  --  u   ---- jpjsob +1
+         !              |        
+         !    nib  -----f-----   jpjsob
+         !         /////|//////
+         !    nib   ////u/////   jpjsob 
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx= u_cysbnd(ji,jk) 
+                  z05cx = z05cx / e2f(ji, jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1 
+         !          =< 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin ) * rtausin + zin * rtaus
+                  z05cx = z05cx * zin 
+         ! ... update ua with radiative or climatological velocity
+                  ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-usmsk(ji,jk)) +              &
+                                 usmsk(ji,jk) * (  ( 1. + z05cx - ztau )         &
+                                 * usbnd(ji,jk,nib ,nitm) - 2.*z05cx               &
+                                 * usbnd(ji,jk,nibm,nit ) + ztau * ufos (ji,jk) )  &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2 v-component of the velocity
+         ! -------------------------------
+         !
+         !                ji-row    ji-row
+         !              |         |
+         !  nibm2  -----f----v----f----  jpjsob+2
+         !              |         |
+         !    nibm   -  u -- T -- u ---- jpjsob+2
+         !              |         |
+         !   nibm  -----f----v----f----  jpjsob+1 
+         !              |         |
+         !   nib    --  u -- T -- u ---  jpjsob+1
+         !              |         |
+         !   nib   -----f----v----f----  jpjsob
+         !         /////////////////////
+         !
+         ! ... Free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjsob,(jpisdp1,jpisfm1)
+         DO jj = njs0, njs1
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  z05cx = v_cysbnd(ji,jk)
+                  z05cx = z05cx / e2t(ji,jj+1)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05c > 0, inflow  zin=0, ztau=1 
+         !         =< 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1. * z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtausin + zin * rtaus
+                  z05cx = z05cx * zin
+         ! ... update va with radiative or climatological velocity
+                  va(ji,jj,jk) = va(ji,jj,jk) * (1.-vsmsk(ji,jk)) +             &
+                                 vsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * vsbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * vsbnd(ji,jk,nibm,nit ) + ztau * vfos (ji,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+      END IF
+
+   END SUBROUTINE obc_dyn_south
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcdyn  ***
+   !! Ocean dynamics:   Radiation of velocities on each open boundary
+   !!=================================================================================
+CONTAINS
+
+   SUBROUTINE obc_dyn
+                              ! No open boundaries ==> empty routine
+   END SUBROUTINE obc_dyn
+#endif
+
+END MODULE obcdyn
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn_bt.F90	(revision 3437)
@@ -0,0 +1,317 @@
+MODULE obcdyn_bt
+   !!======================================================================
+   !!                       ***  MODULE  obcdyn_bt  ***
+   !! Ocean dynamics:   Radiation/prescription of sea surface heights on each open boundary
+   !!======================================================================
+   !! History :  1.0  ! 2005-12  (V. Garnier) original code
+   !!----------------------------------------------------------------------
+#if ( defined key_dynspg_ts || defined key_dynspg_exp ) && defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_ts'     OR                   time spliting free surface
+   !!   'key_dynspg_exp'    AND                       explicit free surface
+   !!   'key_obc'                                   Open Boundary Condition
+   !!----------------------------------------------------------------------
+   !!   obc_dyn_bt        : call the subroutine for each open boundary
+   !!   obc_dyn_bt_east   : Flather's algorithm at the east open boundary
+   !!   obc_dyn_bt_west   : Flather's algorithm at the west open boundary
+   !!   obc_dyn_bt_north  : Flather's algorithm at the north open boundary
+   !!   obc_dyn_bt_south  : Flather's algorithm at the south open boundary
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! distributed memory computing
+   USE obcdta          ! ocean open boundary conditions
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! surface pressure gradient     (free surface with time-splitting)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_dyn_bt  ! routine called in dynnxt (explicit free surface case)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obcdyn_bt.F90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obc_dyn_bt( kt )
+      !!----------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_dyn_bt  ***
+      !!
+      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the explicit
+      !!              free surface case and free surface case with time-splitting
+      !!
+      !!      This routine is called in dynnxt.F routine and updates ua, va and sshn. 
+      !!
+      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 
+      !!      and/or lp_obc_south allow the user to determine which boundary is an
+      !!      open one (must be done in the param_obc.h90 file).
+      !!
+      !! Reference :   Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !!----------------------------------------------------------------------
+
+      IF( lp_obc_east  )   CALL obc_dyn_bt_east 
+      IF( lp_obc_west  )   CALL obc_dyn_bt_west 
+      IF( lp_obc_north )   CALL obc_dyn_bt_north
+      IF( lp_obc_south )   CALL obc_dyn_bt_south
+
+      IF( lk_mpp ) THEN
+         IF( kt >= nit000+3 .AND. ln_rstart ) THEN
+            CALL lbc_lnk( sshb, 'T',  1. )
+            CALL lbc_lnk( ub  , 'U', -1. )
+            CALL lbc_lnk( vb  , 'V', -1. )
+         END IF
+         CALL lbc_lnk( sshn, 'T',  1. )
+         CALL lbc_lnk( ua  , 'U', -1. )
+         CALL lbc_lnk( va  , 'V', -1. )
+      ENDIF
+
+   END SUBROUTINE obc_dyn_bt
+
+# if defined key_dynspg_exp
+
+   SUBROUTINE obc_dyn_bt_east 
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
+      !!              
+      !! ** Purpose :
+      !!      Apply Flather's algorithm on east OBC velocities ua, va 
+      !!      Fix sea surface height (sshn) on east open boundary
+      !!      The logical lfbceast must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      DO ji = nie0, nie1
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(ji,jj,jk) = ua(ji,jj,jk) + sqrt( grav*hur (ji,jj) )               &
+                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
+                  &                          - sshfoe(jj) ) * uemsk(jj,jk)
+            END DO
+         END DO
+      END DO
+      DO ji = nie0p1, nie1p1
+         DO jj = 1, jpj
+            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshfoe(jj)
+         END DO
+      END DO
+
+   END SUBROUTINE obc_dyn_bt_east
+
+
+   SUBROUTINE obc_dyn_bt_west 
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
+      !!                  
+      !! ** Purpose :
+      !!      Apply Flather algorithm on west OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on west open boundary
+      !!      The logical lfbcwest must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO ji = niw0, niw1
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(ji,jj,jk) = ua(ji,jj,jk) - sqrt( grav*hur (ji,jj) )               &
+                  &                      * ( ( sshn(ji,jj) + sshn(ji+1,jj) ) * 0.5  &
+                  &                          - sshfow(jj) ) * uwmsk(jj,jk)
+            END DO
+         END DO
+         DO jj = 1, jpj
+            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshfow(jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_west
+
+
+   SUBROUTINE obc_dyn_bt_north 
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_dyn_bt_north  ***
+      !!
+      !! ** Purpose :
+      !!      Apply Flather algorithm on north OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on north open boundary
+      !!      The logical lfbcnorth must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njn0, njn1
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,jj,jk) = va(ji,jj,jk) + sqrt( grav*hvr (ji,jj) )               &
+                  &                      * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5  &
+                  &                          - sshfon(ji) ) * vnmsk(ji,jk)
+            END DO
+         END DO
+      END DO
+      DO jj = njn0p1, njn1p1
+         DO ji = 1, jpi
+            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshfon(ji)*tnmsk(ji,1)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_north
+
+
+   SUBROUTINE obc_dyn_bt_south 
+      !!----------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_dyn_bt_south  ***
+      !!                    
+      !! ** Purpose :
+      !!      Apply Flather algorithm on south OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on south open boundary
+      !!      The logical lfbcsouth must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njs0, njs1
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,jj,jk) = va(ji,jj,jk) - sqrt( grav*hvr (ji,jj) )               &
+                  &                       * ( ( sshn(ji,jj) + sshn(ji,jj+1) ) * 0.5 &
+                  &                           - sshfos(ji) ) * vsmsk(ji,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshfos(ji)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_south
+
+# elif defined key_dynspg_ts
+
+   SUBROUTINE obc_dyn_bt_east 
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_bt_east  ***
+      !!
+      !! ** Purpose :
+      !!      Apply Flather's algorithm on east OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on east open boundary
+      !!      The logical lfbceast must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO ji = nie0, nie1
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfoe_b(ji,jj) ) * uemsk(jj,jk)
+            END DO
+         END DO
+      END DO
+      DO ji = nie0p1, nie1p1
+         DO jj = 1, jpj
+            sshn(ji,jj) = sshn(ji,jj) * (1.-temsk(jj,1)) + temsk(jj,1)*sshn_b(ji,jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_east
+
+
+   SUBROUTINE obc_dyn_bt_west 
+      !!---------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_dyn_bt_west  ***
+      !!
+      !! ** Purpose :   Apply Flather algorithm on west OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on west open boundary
+      !!      The logical lfbcwest must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO ji = niw0, niw1
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               ua(ji,jj,jk) = ( ua(ji,jj,jk) + sshfow_b(ji,jj) ) * uwmsk(jj,jk)
+            END DO
+         END DO
+         DO jj = 1, jpj
+            sshn(ji,jj) = sshn(ji,jj) * (1.-twmsk(jj,1)) + twmsk(jj,1)*sshn_b(ji,jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_west
+
+
+   SUBROUTINE obc_dyn_bt_north 
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_dyn_bt_north  ***
+      !!                
+      !! ** Purpose :
+      !!      Apply Flather algorithm on north OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on north open boundary
+      !!      The logical lfbcnorth must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njn0, njn1
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfon_b(ji,jj) ) * vnmsk(jj,jk)
+            END DO
+         END DO
+      END DO
+      DO jj = njn0p1, njn1p1
+         DO ji = 1, jpi
+            sshn(ji,jj)= sshn(ji,jj) * (1.-tnmsk(ji,1)) + sshn_b(ji,jj)*tnmsk(ji,1)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_north
+
+
+   SUBROUTINE obc_dyn_bt_south 
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_dyn_bt_south  ***
+      !!                  
+      !! ** Purpose :
+      !!      Apply Flather algorithm on south OBC velocities ua, va
+      !!      Fix sea surface height (sshn) on south open boundary
+      !!      The logical lfbcsouth must be .TRUE.
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njs0, njs1
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+               va(ji,jj,jk) = ( va(ji,jj,jk) + sshfos_b(ji,jj) ) * vsmsk(jj,jk)
+            END DO
+         END DO
+         DO ji = 1, jpi
+            sshn(ji,jj)= sshn(ji,jj) * (1.-tsmsk(ji,1)) + tsmsk(ji,1) * sshn_b(ji,jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_dyn_bt_south
+
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option       No Open Boundaries or not explicit fre surface
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_dyn_bt      ! Dummy routine
+   END SUBROUTINE obc_dyn_bt
+#endif
+
+   !!======================================================================
+END MODULE obcdyn_bt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcfla.F90	(revision 3437)
@@ -0,0 +1,193 @@
+MODULE obcfla
+   !!======================================================================
+   !!                       ***  MODULE  obcfla  ***
+   !! Ocean dynamics:   Flather's algorithm at open boundaries for the time-splitting
+   !!======================================================================
+   !! History :  2.0  ! 2005-12  (V. Garnier) original code
+   !!            3.3  ! 2010-11  (G. Madec) 
+   !!            4.0  ! 2011-02  (G. Madec) velocity & ssh passed in argument
+   !!----------------------------------------------------------------------
+#if defined key_obc   &&   defined key_dynspg_ts
+   !!----------------------------------------------------------------------
+   !!   'key_obc'          and                      Open Boundary Condition
+   !!   'key_dynspg_ts'                    free surface with time splitting
+   !!----------------------------------------------------------------------
+   !!   obc_fla_ts        : call the subroutine for each open boundary
+   !!   obc_fla_ts_east   : Flather on the east  open boundary velocities & ssh
+   !!   obc_fla_ts_west   : Flather on the west  open boundary velocities & ssh
+   !!   obc_fla_ts_north  : Flather on the north open boundary velocities & ssh
+   !!   obc_fla_ts_south  : Flather on the south open boundary velocities & ssh
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE dynspg_oce      ! surface pressure gradient variables
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE obcdta          ! ocean open boundary conditions: climatology
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_fla_ts   ! routine called in dynspg_ts (free surface time splitting case)
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id: obcfla.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha )
+      !!----------------------------------------------------------------------
+      !!                      SUBROUTINE obc_fla_ts
+      !!
+      !! ** Purpose :   Apply Flather's algorithm at open boundaries for the 
+      !!      time-splitting free surface case (barotropic variables)
+      !!
+      !!      This routine is called in dynspg_ts.F90 routine 
+      !!
+      !!      The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
+      !!      and/or lp_obc_south allow the user to determine which boundary is an
+      !!      open one (must be done in the obc_par.F90 file).
+      !!
+      !! ** Reference : Flather, R. A., 1976, Mem. Soc. R. Sci. Liege, Ser. 6, 10, 141-164
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
+      !!----------------------------------------------------------------------
+      !
+      IF( lp_obc_east  )   CALL obc_fla_ts_east ( pua, pva, p_sshn, p_ssha ) 
+      IF( lp_obc_west  )   CALL obc_fla_ts_west ( pua, pva, p_sshn, p_ssha )
+      IF( lp_obc_north )   CALL obc_fla_ts_north( pua, pva, p_sshn, p_ssha )
+      IF( lp_obc_south )   CALL obc_fla_ts_south( pua, pva, p_sshn, p_ssha ) 
+      !
+   END SUBROUTINE obc_fla_ts
+
+
+   SUBROUTINE obc_fla_ts_east( pua, pva, p_sshn, p_ssha ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_fla_ts_east  ***
+      !!
+      !! ** Purpose :   Apply Flather's algorithm on east OBC velocities ua, va
+      !!              Fix sea surface height (p_sshn) on east open boundary
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO ji = nie0, nie1
+         DO jj = 1, jpj
+            pua     (ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + SQRT( grav*hur(ji,jj) )          &
+               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )  ) * uemsk(jj,1)
+            sshfoe_b(ji,jj) =    sshfoe_b(ji,jj)         + SQRT( grav*hur(ji,jj) )          &
+               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfoe(jj) )    * uemsk(jj,1)
+         END DO
+      END DO
+      DO ji = nie0p1, nie1p1
+         DO jj = 1, jpj
+            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - temsk(jj,1) ) + temsk(jj,1) * sshfoe(jj)
+            pva   (ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_fla_ts_east
+
+
+   SUBROUTINE obc_fla_ts_west( pua, pva, p_sshn, p_ssha )
+      !!----------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_fla_ts_west  ***
+      !! 
+      !! ** Purpose :   Apply Flather's algorithm on west OBC velocities ua, va
+      !!              Fix sea surface height (p_sshn) on west open boundary
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO ji = niw0, niw1
+         DO jj = 1, jpj
+            pua     (ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )            &
+               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) ) ) * uwmsk(jj,1)
+            pva     (ji,jj) =   vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1)
+            sshfow_b(ji,jj) =   sshfow_b(ji,jj) - SQRT( grav * hur(ji,jj) )                    &
+               &            * ( ( p_sshn(ji,jj) + p_sshn(ji+1,jj) ) * 0.5 - sshfow(jj) )   * uwmsk(jj,1)
+            p_ssha  (ji,jj) = p_ssha(ji,jj) * ( 1. - twmsk(jj,1) ) + twmsk(jj,1)*sshfow(jj)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_fla_ts_west
+
+
+   SUBROUTINE obc_fla_ts_north( pua, pva, p_sshn, p_ssha )
+      !!----------------------------------------------------------------------
+      !!                     SUBROUTINE obc_fla_ts_north
+      !!
+      !! ** Purpose :   Apply Flather's algorithm on north OBC velocities ua, va
+      !!              Fix sea surface height (p_sshn) on north open boundary
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njn0, njn1
+         DO ji = 1, jpi
+            pva     (ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )            &
+               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) ) ) * vnmsk(ji,1)
+            sshfon_b(ji,jj) =   sshfon_b(ji,jj) + sqrt( grav * hvr(ji,jj) )                    &
+               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfon(ji) )   * vnmsk(ji,1)
+         END DO
+      END DO
+      DO jj = njn0p1, njn1p1
+         DO ji = 1, jpi
+            p_ssha(ji,jj) = p_ssha(ji,jj) * ( 1. - tnmsk(ji,1) ) + sshfon(ji) * tnmsk(ji,1)
+            pua   (ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_fla_ts_north
+
+
+   SUBROUTINE obc_fla_ts_south( pua, pva, p_sshn, p_ssha )
+      !!----------------------------------------------------------------------
+      !!                     SUBROUTINE obc_fla_ts_south
+      !!
+      !! ** Purpose :   Apply Flather's algorithm on south OBC velocities ua, va
+      !!              Fix sea surface height (p_sshn) on south open boundary
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pua   , pva      ! after barotropic velocities
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_sshn, p_ssha   ! before, now, after sea surface height
+      !
+      INTEGER ::   ji, jj   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      DO jj = njs0, njs1
+         DO ji = 1, jpi
+            pva     (ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )            &
+               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) ) ) * vsmsk(ji,1)
+            pua     (ji,jj) =   ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1)
+            sshfos_b(ji,jj) =   sshfos_b(ji,jj) - sqrt( grav * hvr(ji,jj) )                    &
+               &                * ( ( p_sshn(ji,jj) + p_sshn(ji,jj+1) ) * 0.5 - sshfos(ji) )   * vsmsk(ji,1)
+            p_ssha  (ji,jj) = p_ssha(ji,jj) * (1. - tsmsk(ji,1) ) + tsmsk(ji,1) * sshfos(ji)
+         END DO
+      END DO
+      !
+   END SUBROUTINE obc_fla_ts_south
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                             No OBC or time-splitting
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_fla_ts( pua, pva, p_sshn, p_ssha )
+      REAL, DIMENSION(:,:)::   pua, pva, p_sshn, p_ssha
+      WRITE(*,*) 'obc_fla_ts: You should not have seen this print! error?', pua(1,1), pva(1,1), p_sshn(1,1), p_ssha(1,1)
+   END SUBROUTINE obc_fla_ts
+#endif
+   !!======================================================================
+END MODULE obcfla
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90	(revision 3437)
@@ -0,0 +1,724 @@
+ MODULE obcini
+   !!======================================================================
+   !!                       ***  MODULE  obcini  ***
+   !! OBC initial state :  Open boundary initial state
+   !!======================================================================
+   !! History :  8.0  !  97-07  (J.M. Molines, G. Madec)  Original code
+   !!   NEMO     1.0  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90
+   !!            2.0  !  05-11  (V. Garnier) Surface pressure gradient organization
+   !!----------------------------------------------------------------------
+#if defined key_obc
+   !!----------------------------------------------------------------------
+   !!   'key_obc'                                  Open Boundary Conditions
+   !!----------------------------------------------------------------------
+   !!   obc_init       : initialization for the open boundary condition
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! open boundary condition: ocean
+   USE obcdta          ! open boundary condition: data
+   USE in_out_manager  ! I/O units
+   USE lib_mpp         ! MPP library
+   USE dynspg_oce      ! flag lk_dynspg_flt
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_init   ! routine called by opa.F90
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   SUBROUTINE obc_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE obc_init  ***
+      !!         
+      !! ** Purpose :   Initialization of the dynamics and tracer fields at 
+      !!              the open boundaries.
+      !!
+      !! ** Method  :   initialization of open boundary variables
+      !!      (u, v) over 3 time step and 3 rows
+      !!      (t, s) over 2 time step and 2 rows
+      !!      if ln_rstart = .FALSE. : no restart, fields set to zero
+      !!      if ln_rstart = .TRUE.  : restart, fields are read in a file 
+      !!      if rdpxxx = 0 then lfbc is set true for this boundary.
+      !!
+      !! ** Input   :   restart.obc file, restart file for open boundaries 
+      !!----------------------------------------------------------------------
+      USE obcrst,   ONLY :   obc_rst_read   ! Make obc_rst_read routine available
+      !!
+      INTEGER  ::   ji, jj, istop , inumfbc
+      INTEGER, DIMENSION(4) ::   icorner
+      REAL(wp), DIMENSION(2) ::   ztestmask
+      !!
+      NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin,       &
+         &             rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob,       &
+         &             rn_volemp, nn_obcdta, cn_obcdta,    &
+         &             ln_obc_clim, ln_vol_cst, ln_obc_fla
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )              ! Namelist namobc : open boundaries
+      READ  ( numnam, namobc )
+
+      ! convert DOCTOR namelist name into the OLD names
+      nobc_dta = nn_obcdta
+      cffile   = cn_obcdta
+      rdpein   = rn_dpein
+      rdpwin   = rn_dpwin
+      rdpsin   = rn_dpsin
+      rdpnin   = rn_dpnin
+      rdpeob   = rn_dpeob
+      rdpwob   = rn_dpwob
+      rdpsob   = rn_dpsob
+      rdpnob   = rn_dpnob
+      volemp   = rn_volemp
+
+      !                              ! allocate obc arrays
+      IF( obc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_oce arrays' )
+      IF( obc_dta_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'obc_init : unable to allocate obc_dta arrays' )
+
+      ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated
+      IF( .NOT.lp_obc_east  ) THEN   ;   rdpein = 1.   ;   rdpeob = 15.   ;   END IF
+      IF( .NOT.lp_obc_west  ) THEN   ;   rdpwin = 1.   ;   rdpwob = 15.   ;   END IF
+      IF( .NOT.lp_obc_north ) THEN   ;   rdpnin = 1.   ;   rdpnob = 15.   ;   END IF
+      IF( .NOT.lp_obc_south ) THEN   ;   rdpsin = 1.   ;   rdpsob = 15.   ;   END IF
+
+      ! number of open boudaries and open boundary indicators
+      nbobc = 0
+      IF( lp_obc_east  )   nbobc = nbobc + 1
+      IF( lp_obc_west  )   nbobc = nbobc + 1
+      IF( lp_obc_north )   nbobc = nbobc + 1
+      IF( lp_obc_south )   nbobc = nbobc + 1
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~'
+      IF(lwp) WRITE(numout,*) '   Number of open boundaries    nbobc = ', nbobc
+      IF(lwp) WRITE(numout,*)
+
+      ! control prints
+      IF(lwp) WRITE(numout,*) '   Namelist namobc'
+      IF(lwp) WRITE(numout,*) '      data in file (=1) or initial state used (=0)   nn_obcdta   = ', nn_obcdta
+      IF(lwp) WRITE(numout,*) '      climatology (true) or not                      ln_obc_clim = ', ln_obc_clim
+      IF(lwp) WRITE(numout,*) '      vol_cst (true) or not:                         ln_vol_cst  = ', ln_vol_cst
+      IF(lwp) WRITE(numout,*) ' '
+      IF(lwp) WRITE(numout,*) '   WARNING                                                  '
+      IF(lwp) WRITE(numout,*) '      Flather"s algorithm is applied with explicit free surface scheme                 '
+      IF(lwp) WRITE(numout,*) '      or with free surface time-splitting scheme                                       '
+      IF(lwp) WRITE(numout,*) '      Nor radiation neither relaxation is allowed with explicit free surface scheme:   '
+      IF(lwp) WRITE(numout,*) '      Radiation and/or relaxation is allowed with free surface time-splitting scheme '
+      IF(lwp) WRITE(numout,*) '      depending of the choice of rdpXin = rdpXob  = 0. for open boundaries             '
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '      For the filtered free surface case,                                              '
+      IF(lwp) WRITE(numout,*) '      radiation, relaxation or presciption of data can be applied                      '
+      IF(lwp) WRITE(numout,*)
+
+      IF( lwp.AND.lp_obc_east ) THEN
+         WRITE(numout,*) '      East open boundary :'
+         WRITE(numout,*) '         i index                    jpieob   = ', jpieob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpeob = ', rn_dpeob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpein = ', rn_dpein
+      ENDIF
+
+      IF( lwp.AND.lp_obc_west ) THEN
+         WRITE(numout,*) '      West open boundary :'
+         WRITE(numout,*) '         i index                    jpiwob   = ', jpiwob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpwob = ', rn_dpwob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpwin = ', rn_dpwin
+      ENDIF
+
+      IF( lwp.AND.lp_obc_north ) THEN
+         WRITE(numout,*) '      North open boundary :'
+         WRITE(numout,*) '         j index                    jpjnob   = ', jpjnob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpnob = ', rn_dpnob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpnin = ', rn_dpnin
+      ENDIF
+
+      IF( lwp.AND.lp_obc_south ) THEN
+         WRITE(numout,*) '      South open boundary :'
+         WRITE(numout,*) '         j index                    jpjsob   = ', jpjsob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpsob = ', rn_dpsob
+         WRITE(numout,*) '         damping time scale (days)  rn_dpsin = ', rn_dpsin
+         WRITE(numout,*)
+      ENDIF
+
+      IF( nbobc >= 2 .AND. jperio /= 0 )   &
+         &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' )
+
+      ! 1. Initialisation of constants 
+      ! ------------------------------
+      ! ...                          convert rdp$ob in seconds
+      ! Fixed Bdy flag              inbound                outbound
+      lfbceast  = .FALSE.   ;   rdpein = rdpein * rday    ;   rdpeob = rdpeob * rday
+      lfbcwest  = .FALSE.   ;   rdpwin = rdpwin * rday    ;   rdpwob = rdpwob * rday
+      lfbcnorth = .FALSE.   ;   rdpnin = rdpnin * rday    ;   rdpnob = rdpnob * rday
+      lfbcsouth = .FALSE.   ;   rdpsin = rdpsin * rday    ;   rdpsob = rdpsob * rday
+      inumfbc = 0
+      ! ... look for Fixed Boundaries (rdp = 0 )
+      ! ... When specified, lbcxxx flags are set to TRUE and rdpxxx are set to
+      ! ...  a small arbitrary value, (to avoid division by zero further on). 
+      ! ...  rdpxxx is not used anymore.
+      IF( lp_obc_east )  THEN
+         IF( (rdpein+rdpeob) == 0 )  THEN
+            lfbceast = .TRUE.   ;   rdpein = 1e-3   ;   rdpeob = 1e-3
+            inumfbc = inumfbc+1
+         ELSEIF ( (rdpein*rdpeob) == 0 )  THEN
+            CALL ctl_stop( 'obc_init : rn_dpein & rn_dpeob must be both zero or non zero' )
+         END IF
+      END IF
+
+      IF( lp_obc_west )  THEN
+         IF( (rdpwin + rdpwob) == 0 )  THEN
+            lfbcwest = .TRUE.     ;     rdpwin = 1e-3     ;     rdpwob = 1e-3
+            inumfbc = inumfbc+1
+         ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN
+            CALL ctl_stop( 'obc_init : rn_dpwin & rn_dpwob must be both zero or non zero' )
+         END IF
+      END IF
+      IF( lp_obc_north )  THEN
+         IF( (rdpnin + rdpnob) == 0 )  THEN
+            lfbcnorth = .TRUE.     ;     rdpnin = 1e-3     ;     rdpnob = 1e-3
+            inumfbc = inumfbc+1
+         ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN
+            CALL ctl_stop( 'obc_init : rn_dpnin & rn_dpnob must be both zero or non zero' )
+         END IF
+      END IF
+      IF( lp_obc_south )  THEN
+         IF( (rdpsin + rdpsob) == 0 )  THEN
+            lfbcsouth = .TRUE.   ;   rdpsin = 1e-3   ;   rdpsob = 1e-3
+            inumfbc = inumfbc+1
+         ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN
+            CALL ctl_stop( 'obc_init : rn_dpsin & rn_dpsob must be both zero or non zero' )
+         END IF
+      END IF
+
+      ! 2.  Clever mpp indices for loops on the open boundaries. 
+      !     The loops will be performed only on the processors 
+      !     that contain a given open boundary.
+      ! --------------------------------------------------------
+
+      IF( lp_obc_east ) THEN
+         ! ...   mpp initialization
+         nie0   = max( 1, min(jpieob   - nimpp+1, jpi     ) )
+         nie1   = max( 0, min(jpieob   - nimpp+1, jpi - 1 ) )
+         nie0p1 = max( 1, min(jpieob+1 - nimpp+1, jpi     ) )
+         nie1p1 = max( 0, min(jpieob+1 - nimpp+1, jpi - 1 ) )
+         nie0m1 = max( 1, min(jpieob-1 - nimpp+1, jpi     ) )
+         nie1m1 = max( 0, min(jpieob-1 - nimpp+1, jpi - 1 ) )
+         nje0   = max( 2, min(jpjed    - njmpp+1, jpj     ) )
+         nje1   = max( 0, min(jpjef    - njmpp+1, jpj - 1 ) )
+         nje0p1 = max( 1, min(jpjedp1  - njmpp+1, jpj     ) )
+         nje0m1 = max( 1, min(jpjed    - njmpp+1, jpj     ) )
+         nje1m1 = max( 0, min(jpjefm1  - njmpp+1, jpj - 1 ) )
+         nje1m2 = max( 0, min(jpjefm1-1- njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbceast ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified East Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative East Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      IF( lp_obc_west ) THEN
+         ! ...   mpp initialization
+         niw0   = max( 1, min(jpiwob   - nimpp+1, jpi     ) )
+         niw1   = max( 0, min(jpiwob   - nimpp+1, jpi - 1 ) )
+         niw0p1 = max( 1, min(jpiwob+1 - nimpp+1, jpi     ) )
+         niw1p1 = max( 0, min(jpiwob+1 - nimpp+1, jpi - 1 ) )
+         njw0   = max( 2, min(jpjwd    - njmpp+1, jpj     ) )
+         njw1   = max( 0, min(jpjwf    - njmpp+1, jpj - 1 ) )
+         njw0p1 = max( 1, min(jpjwdp1  - njmpp+1, jpj     ) )
+         njw0m1 = max( 1, min(jpjwd    - njmpp+1, jpj     ) )
+         njw1m1 = max( 0, min(jpjwfm1  - njmpp+1, jpj - 1 ) )
+         njw1m2 = max( 0, min(jpjwfm1-1- njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcwest ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified West Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative West Open Boundary'
+            END IF
+         END IF
+      END IF
+ 
+      IF( lp_obc_north ) THEN
+         ! ...   mpp initialization
+         nin0   = max( 2, min(jpind    - nimpp+1, jpi     ) )
+         nin1   = max( 0, min(jpinf    - nimpp+1, jpi - 1 ) )
+         nin0p1 = max( 1, min(jpindp1  - nimpp+1, jpi     ) )
+         nin0m1 = max( 1, min(jpind    - nimpp+1, jpi     ) )
+         nin1m1 = max( 0, min(jpinfm1  - nimpp+1, jpi - 1 ) )
+         nin1m2 = max( 0, min(jpinfm1-1- nimpp+1, jpi - 1 ) )
+         njn0   = max( 1, min(jpjnob   - njmpp+1, jpj     ) )
+         njn1   = max( 0, min(jpjnob   - njmpp+1, jpj - 1 ) )
+         njn0p1 = max( 1, min(jpjnob+1 - njmpp+1, jpj     ) )
+         njn1p1 = max( 0, min(jpjnob+1 - njmpp+1, jpj - 1 ) )
+         njn0m1 = max( 1, min(jpjnob-1 - njmpp+1, jpj     ) )
+         njn1m1 = max( 0, min(jpjnob-1 - njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcnorth ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified North Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative North Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      IF( lp_obc_south ) THEN
+         ! ...   mpp initialization
+         nis0   = max( 2, min(jpisd    - nimpp+1, jpi     ) )
+         nis1   = max( 0, min(jpisf    - nimpp+1, jpi - 1 ) )
+         nis0p1 = max( 1, min(jpisdp1  - nimpp+1, jpi     ) )
+         nis0m1 = max( 1, min(jpisd    - nimpp+1, jpi     ) )
+         nis1m1 = max( 0, min(jpisfm1  - nimpp+1, jpi - 1 ) )
+         nis1m2 = max( 0, min(jpisfm1-1- nimpp+1, jpi - 1 ) )
+         njs0   = max( 1, min(jpjsob   - njmpp+1, jpj     ) )
+         njs1   = max( 0, min(jpjsob   - njmpp+1, jpj - 1 ) )
+         njs0p1 = max( 1, min(jpjsob+1 - njmpp+1, jpj     ) )
+         njs1p1 = max( 0, min(jpjsob+1 - njmpp+1, jpj - 1 ) )
+         IF(lwp) THEN
+            IF( lfbcsouth ) THEN
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Specified South Open Boundary'
+            ELSE
+               WRITE(numout,*)'     '
+               WRITE(numout,*)'         Radiative South Open Boundary'
+            END IF
+         END IF
+      END IF
+
+      ! 3. mask correction for OBCs
+      ! ---------------------------
+
+      IF( lp_obc_east ) THEN
+         !... (jpjed,jpjefm1),jpieob
+         bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0
+
+         ! ... initilization to zero
+         uemsk(:,:) = 0.e0   ;   vemsk(:,:) = 0.e0   ;   temsk(:,:) = 0.e0
+
+         ! ... set 2D mask on East OBC,  Vopt
+         DO ji = fs_nie0, fs_nie1
+            DO jj = nje0, nje1
+               uemsk(jj,:) = umask(ji,  jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj)
+               vemsk(jj,:) = vmask(ji+1,jj,:) * tmask_i(ji+1,jj) 
+               temsk(jj,:) = tmask(ji+1,jj,:) * tmask_i(ji+1,jj) 
+            END DO
+         END DO
+
+      END IF
+
+      IF( lp_obc_west ) THEN
+         ! ... (jpjwd,jpjwfm1),jpiwob
+         bmask(niw0:niw1,njw0:njw1m1) = 0.e0
+
+         ! ... initilization to zero
+         uwmsk(:,:) = 0.e0   ;   vwmsk(:,:) = 0.e0   ;   twmsk(:,:) = 0.e0  
+
+         ! ... set 2D mask on West OBC,  Vopt
+         DO ji = fs_niw0, fs_niw1
+            DO jj = njw0, njw1
+               uwmsk(jj,:) = umask(ji,jj,:) * tmask_i(ji,jj)   * tmask_i(ji+1,jj)
+               vwmsk(jj,:) = vmask(ji,jj,:) * tmask_i(ji,jj)  
+               twmsk(jj,:) = tmask(ji,jj,:) * tmask_i(ji,jj)
+            END DO
+         END DO
+
+      END IF
+
+      IF( lp_obc_north ) THEN
+         ! ... jpjnob,(jpind,jpisfm1)
+         bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0
+
+         ! ... initilization to zero
+         unmsk(:,:) = 0.e0   ;   vnmsk(:,:) = 0.e0   ;   tnmsk(:,:) = 0.e0
+
+         ! ... set 2D mask on North OBC,  Vopt
+         DO jj = fs_njn0, fs_njn1
+            DO ji = nin0, nin1
+               unmsk(ji,:) = umask(ji,jj+1,:) * tmask_i(ji,jj+1) 
+               vnmsk(ji,:) = vmask(ji,jj  ,:) * tmask_i(ji,jj)   * tmask_i(ji,jj+1)
+               tnmsk(ji,:) = tmask(ji,jj+1,:) * tmask_i(ji,jj+1)
+            END DO
+         END DO
+
+      END IF
+
+      IF( lp_obc_south ) THEN 
+         ! ... jpjsob,(jpisd,jpisfm1)
+         bmask(nis0:nis1m1,njs0:njs1) = 0.e0
+
+         ! ... initilization to zero
+         usmsk(:,:) = 0.e0   ;   vsmsk(:,:) = 0.e0   ;   tsmsk(:,:) = 0.e0
+
+         ! ... set 2D mask on South OBC,  Vopt
+         DO jj = fs_njs0, fs_njs1 
+            DO ji = nis0, nis1
+               usmsk(ji,:) = umask(ji,jj,:) * tmask_i(ji,jj) 
+               vsmsk(ji,:) = vmask(ji,jj,:) * tmask_i(ji,jj) * tmask_i(ji,jj+1)
+               tsmsk(ji,:) = tmask(ji,jj,:) * tmask_i(ji,jj)
+            END DO
+         END DO
+
+      END IF
+
+      ! ... Initialize obcumask and obcvmask for the Force filtering 
+      !     boundary condition in dynspg_flt
+      obcumask(:,:) = umask(:,:,1)
+      obcvmask(:,:) = vmask(:,:,1)
+
+      ! ... Initialize obctmsk on overlap region and obcs. This mask
+      !     is used in obcvol.F90 to calculate cumulate flux E-P. 
+      !     obc Tracer point are outside the domain ( U/V obc points) ==> masked by obctmsk
+      !     - no flux E-P on obcs and overlap region (jpreci = jprecj = 1)
+      obctmsk(:,:) = tmask_i(:,:)     
+
+      IF( lp_obc_east ) THEN
+         ! ... East obc Force filtering mask for the grad D
+         obcumask(nie0  :nie1  ,nje0p1:nje1m1) = 0.e0
+         obcvmask(nie0p1:nie1p1,nje0p1:nje1m1) = 0.e0
+         ! ... set to 0 on East OBC
+         obctmsk(nie0p1:nie1p1,nje0:nje1) = 0.e0
+      END IF
+
+      IF( lp_obc_west ) THEN
+         ! ... West obc Force filtering mask for the grad D
+         obcumask(niw0:niw1,njw0:njw1) = 0.e0
+         obcvmask(niw0:niw1,njw0:njw1) = 0.e0
+         ! ... set to 0 on West OBC
+         obctmsk(niw0:niw1,njw0:njw1) = 0.e0
+      END IF
+
+      IF( lp_obc_north ) THEN
+         ! ... North obc Force filtering mask for the grad D
+         obcumask(nin0p1:nin1m1,njn0p1:njn1p1) = 0.e0
+         obcvmask(nin0p1:nin1m1,njn0  :njn1  ) = 0.e0
+         ! ... set to 0 on North OBC
+         obctmsk(nin0:nin1,njn0p1:njn1p1) = 0.e0
+      END IF
+
+      IF( lp_obc_south ) THEN
+         ! ... South obc Force filtering mask for the grad D
+         obcumask(nis0p1:nis1m1,njs0:njs1) = 0.e0
+         obcvmask(nis0p1:nis1m1,njs0:njs1) = 0.e0
+         ! ... set to 0 on South OBC
+         obctmsk(nis0:nis1,njs0:njs1) = 0.e0
+      END IF
+
+      ! 3.1 Total lateral surface 
+      ! -------------------------
+      obcsurftot = 0.e0
+
+      IF( lp_obc_east ) THEN ! ... East open boundary lateral surface
+         DO ji = nie0, nie1
+            DO jj = 1, jpj 
+               obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+            END DO
+         END DO
+      END IF
+
+      IF( lp_obc_west ) THEN ! ... West open boundary lateral surface
+         DO ji = niw0, niw1
+            DO jj = 1, jpj 
+               obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+            END DO
+         END DO
+      END IF
+
+      IF( lp_obc_north ) THEN ! ... North open boundary lateral surface
+         DO jj = njn0, njn1
+            DO ji = 1, jpi
+               obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+            END DO
+         END DO
+      END IF
+
+      IF( lp_obc_south ) THEN ! ... South open boundary lateral surface
+         DO jj = njs0, njs1
+            DO ji = 1, jpi
+               obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+            END DO
+         END DO
+      END IF
+
+      IF( lk_mpp )   CALL mpp_sum( obcsurftot )   ! sum over the global domain
+
+      ! 5. Control print on mask 
+      !    The extremities of the open boundaries must be in land
+      !    or else correspond to an "ocean corner" between two open boundaries. 
+      !    corner 1 is southwest, 2 is south east, 3 is northeast, 4 is northwest. 
+      ! --------------------------------------------------------------------------
+
+      icorner(:)=0
+
+      ! ... control of the west boundary
+      IF( lp_obc_west ) THEN
+         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo-2 ) THEN
+            WRITE(ctmp1,*) ' jpiwob exceed ', jpiglo-2, 'or less than 2'
+            CALL ctl_stop( ctmp1 )
+         END IF
+         ztestmask(:)=0.
+         DO ji=niw0,niw1
+            IF( (njw0 + njmpp - 1) == jpjwd ) ztestmask(1)=ztestmask(1)+ tmask(ji,njw0,1)
+            IF( (njw1 + njmpp - 1) == jpjwf ) ztestmask(2)=ztestmask(2)+ tmask(ji,njw1,1)
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
+         IF( ztestmask(2) /= 0. ) icorner(4)=icorner(4)+1
+      END IF
+
+      ! ... control of the east boundary
+      IF( lp_obc_east ) THEN
+         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
+            WRITE(ctmp1,*) ' jpieob exceed ', jpiglo, ' or less than 4'
+            CALL ctl_stop( ctmp1 )
+         END IF
+         ztestmask(:)=0.
+         DO ji=nie0p1,nie1p1
+            IF( (nje0 + njmpp - 1) == jpjed ) ztestmask(1)=ztestmask(1)+ tmask(ji,nje0,1)
+            IF( (nje1 + njmpp - 1) == jpjef ) ztestmask(2)=ztestmask(2)+ tmask(ji,nje1,1)
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+        IF( ztestmask(1) /= 0. ) icorner(2)=icorner(2)+1
+        IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
+      END IF
+
+      ! ... control of the north boundary
+      IF( lp_obc_north ) THEN
+         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
+            WRITE(ctmp1,*) 'jpjnob exceed ', jpjglo, ' or less than 4'
+            CALL ctl_stop( ctmp1 )
+         END IF
+         ztestmask(:)=0.
+         DO jj=njn0p1,njn1p1
+            IF( (nin0 + nimpp - 1) == jpind ) ztestmask(1)=ztestmask(1)+ tmask(nin0,jj,1)
+            IF( (nin1 + nimpp - 1) == jpinf ) ztestmask(2)=ztestmask(2)+ tmask(nin1,jj,1)
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF( ztestmask(1) /= 0. ) icorner(4)=icorner(4)+1
+         IF( ztestmask(2) /= 0. ) icorner(3)=icorner(3)+1
+      END IF
+
+      ! ... control of the south boundary
+      IF( lp_obc_south ) THEN
+         IF( jpjsob < 2 .OR.  jpjsob >= jpjglo-2 ) THEN
+            WRITE(ctmp1,*) ' jpjsob exceed ', jpjglo-2, ' or less than 2'
+            CALL ctl_stop( ctmp1 )
+         END IF
+         ztestmask(:)=0.
+         DO jj=njs0,njs1
+            IF( (nis0 + nimpp - 1) == jpisd ) ztestmask(1)=ztestmask(1)+ tmask(nis0,jj,1)
+            IF( (nis1 + nimpp - 1) == jpisf ) ztestmask(2)=ztestmask(2)+ tmask(nis1,jj,1)
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztestmask, 2 )   ! sum over the global domain
+
+         IF( ztestmask(1) /= 0. ) icorner(1)=icorner(1)+1
+         IF( ztestmask(2) /= 0. ) icorner(2)=icorner(2)+1
+      END IF
+
+      IF( icorner(1) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' South West ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpisd /= jpiwob.OR.jpjsob /= jpjwd ) &
+              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
+
+      ELSE IF( icorner(1) == 1 ) THEN
+         CALL ctl_stop( ' Open boundaries do not fit at SW corner, we stop' )
+      END IF 
+
+      IF( icorner(2) == 2 ) THEN
+          IF(lwp) WRITE(numout,*)
+          IF(lwp) WRITE(numout,*) ' South East ocean corner, two open boudaries'
+          IF(lwp) WRITE(numout,*) ' ========== '
+          IF(lwp) WRITE(numout,*)
+          IF( jpisf /= jpieob+1.OR.jpjsob /= jpjed ) &
+               &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
+      ELSE IF( icorner(2) == 1 ) THEN
+         CALL ctl_stop( ' Open boundaries do not fit at SE corner, we stop' )
+      END IF 
+
+      IF( icorner(3) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' North East ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpinf /= jpieob+1 .OR. jpjnob+1 /= jpjef ) &
+              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
+       ELSE IF( icorner(3) == 1 ) THEN
+          CALL ctl_stop( ' Open boundaries do not fit at NE corner, we stop' )
+       END IF 
+
+      IF( icorner(4) == 2 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' North West ocean corner, two open boudaries'
+         IF(lwp) WRITE(numout,*) ' ========== '
+         IF(lwp) WRITE(numout,*)
+         IF( jpind /= jpiwob.OR.jpjnob+1 /= jpjwf ) &
+              &   CALL ctl_stop( ' Open boundaries do not fit, we stop' )
+       ELSE IF( icorner(4) == 1 ) THEN
+          CALL ctl_stop( ' Open boundaries do not fit at NW corner, we stop' )
+       END IF 
+
+      ! 6. Initialization of open boundary variables (u, v, t, s)
+      ! --------------------------------------------------------------
+      !   only if at least one boundary is  radiative 
+      IF ( inumfbc < nbobc .AND.  ln_rstart ) THEN
+         !  Restart from restart.obc
+         CALL obc_rst_read
+      ELSE
+
+!         ! ... Initialization to zero of radiation arrays.
+!         !     Those have dimensions of local subdomains
+
+          uebnd(:,:,:,:) = 0.e0   ;   unbnd(:,:,:,:) = 0.e0
+          vebnd(:,:,:,:) = 0.e0   ;   vnbnd(:,:,:,:) = 0.e0
+          tebnd(:,:,:,:) = 0.e0   ;   tnbnd(:,:,:,:) = 0.e0
+          sebnd(:,:,:,:) = 0.e0   ;   snbnd(:,:,:,:) = 0.e0
+
+          uwbnd(:,:,:,:) = 0.e0   ;   usbnd(:,:,:,:) = 0.e0
+          vwbnd(:,:,:,:) = 0.e0   ;   vsbnd(:,:,:,:) = 0.e0
+          twbnd(:,:,:,:) = 0.e0   ;   tsbnd(:,:,:,:) = 0.e0
+          swbnd(:,:,:,:) = 0.e0   ;   ssbnd(:,:,:,:) = 0.e0
+
+      END IF
+
+      ! 7. Control print
+      ! -----------------------------------------------------------------
+
+      ! ... control of the east boundary
+      IF( lp_obc_east ) THEN
+         istop = 0
+         IF( jpieob < 4 .OR.  jpieob >= jpiglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '            jpieob exceed ', jpim1, ' or less than 4'
+            istop = istop + 1
+         END IF
+
+         IF( lk_mpp ) THEN
+            ! ... 
+            IF( nimpp > jpieob-5) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the East OBC'
+               IF(lwp) WRITE(numout,*) '        nimpp must be < jpieob-5'
+               istop = istop + 1
+            ENDIF
+         ELSE
+
+            ! ... stop if  e r r o r (s)   detected
+            IF( istop /= 0 ) THEN
+               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
+               CALL ctl_stop( ctmp1 )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! ... control of the west boundary
+      IF( lp_obc_west ) THEN
+         istop = 0
+         IF( jpiwob < 2 .OR.  jpiwob >= jpiglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '            jpiwob exceed ', jpim1, ' or less than 2'
+            istop = istop + 1
+         END IF
+
+         IF( lk_mpp ) THEN
+            IF( (nimpp < jpiwob+5) .AND. (nimpp > 1) ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the West OBC'
+               IF(lwp) WRITE(numout,*) '        nimpp must be > jpiwob-5 or =1'
+               istop = istop + 1
+            ENDIF
+         ELSE
+   
+            ! ... stop if  e r r o r (s)   detected
+            IF( istop /= 0 ) THEN
+               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
+               CALL ctl_stop( ctmp1 )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      ! control of the north boundary
+      IF( lp_obc_north ) THEN
+         istop = 0
+         IF( jpjnob < 4 .OR.  jpjnob >= jpjglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          jpjnob exceed ', jpjm1,' or less than 4'
+            istop = istop + 1
+         END IF
+
+         IF( lk_mpp ) THEN
+            IF( njmpp > jpjnob-5) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the North OBC'
+               IF(lwp) WRITE(numout,*) '        njmpp must be < jpjnob-5'
+               istop = istop + 1
+            ENDIF
+         ELSE
+   
+            ! ... stop if  e r r o r (s)   detected
+            IF( istop /= 0 ) THEN
+                WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
+               CALL ctl_stop( ctmp1 )
+           ENDIF
+         ENDIF
+      ENDIF
+
+      ! control of the south boundary
+      IF( lp_obc_south ) THEN
+         istop = 0
+         IF( jpjsob < 2 .OR. jpjsob >= jpjglo ) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) '          jpjsob exceed ', jpjm1,' or less than 2'
+            istop = istop + 1
+         END IF
+
+         IF( lk_mpp ) THEN
+            IF( (njmpp < jpjsob+5) .AND. (njmpp > 1) ) THEN
+               IF(lwp) WRITE(numout,cform_err)
+               IF(lwp) WRITE(numout,*) '        A sub-domain is too close to the South OBC'
+               IF(lwp) WRITE(numout,*) '        njmpp must be > jpjsob+5 or =1'
+               istop = istop + 1
+            ENDIF
+         ELSE
+   
+            ! ... stop if  e r r o r (s)   detected
+            IF( istop /= 0 ) THEN
+               WRITE(ctmp1,*) istop,' obcini : E R R O R (S) detected : stop'
+               CALL ctl_stop( ctmp1 )
+            ENDIF
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE obc_init
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Dummy module                                                NO open boundaries
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_init      ! Dummy routine
+   END SUBROUTINE obc_init
+#endif
+
+   !!=================================================================================
+END MODULE obcini
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90	(revision 3437)
@@ -0,0 +1,1171 @@
+MODULE obcrad 
+   !!=================================================================================
+   !!                       ***  MODULE  obcrad  ***
+   !! Ocean dynamic :   Phase velocities for each open boundary
+   !!=================================================================================
+#if defined key_obc
+   !!---------------------------------------------------------------------------------
+   !!   obc_rad        : call the subroutine for each open boundary
+   !!   obc_rad_east   : compute the east phase velocities
+   !!   obc_rad_west   : compute the west phase velocities
+   !!   obc_rad_north  : compute the north phase velocities
+   !!   obc_rad_south  : compute the south phase velocities
+   !!---------------------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppobc
+   USE in_out_manager  ! I/O units
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_rad    ! routine called by step.F90
+
+   INTEGER ::   ji, jj, jk     ! dummy loop indices
+
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_rad ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     SUBROUTINE obc_rad
+      !!                    ********************
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      boundaries and calculate those phase speeds if the open boundaries are 
+      !!      not fixed. In case of fixed open boundaries does nothing.
+      !!
+      !!     The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
+      !!     and/or lp_obc_south allow the user to determine which boundary is an
+      !!     open one (must be done in the param_obc.h90 file).
+      !! 
+      !! ** Reference : 
+      !!     Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !!  History :
+      !!    8.5  !  02-10  (C. Talandier, A-M. Treguier) Free surface, F90 from the 
+      !!                                                 J. Molines and G. Madec version
+      !!------------------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt
+      !!----------------------------------------------------------------------
+
+      IF( lp_obc_east  .AND. .NOT.lfbceast  )   CALL obc_rad_east ( kt )   ! East open boundary
+
+      IF( lp_obc_west  .AND. .NOT.lfbcwest  )   CALL obc_rad_west ( kt )   ! West open boundary
+
+      IF( lp_obc_north .AND. .NOT.lfbcnorth )   CALL obc_rad_north( kt )   ! North open boundary
+
+      IF( lp_obc_south .AND. .NOT.lfbcsouth )   CALL obc_rad_south( kt )   ! South open boundary
+
+   END SUBROUTINE obc_rad
+
+
+   SUBROUTINE obc_rad_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                     ***  SUBROUTINE obc_rad_east  ***
+      !!                   
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      east boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER  ::   ij
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zucb, zucbm, zucbm2
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 .OR. ln_rstart ) THEN 
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               uebnd(jj,jk,nib  ,nitm2) = uebnd(jj,jk,nib  ,nitm)*uemsk(jj,jk)
+               uebnd(jj,jk,nibm ,nitm2) = uebnd(jj,jk,nibm ,nitm)*uemsk(jj,jk)
+               uebnd(jj,jk,nibm2,nitm2) = uebnd(jj,jk,nibm2,nitm)*uemsk(jj,jk)
+            END DO
+         END DO
+         ! ... fields nitm <== nit  plus time filter at the boundary 
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  uebnd(jj,jk,nib  ,nitm) = uebnd(jj,jk,nib,  nit)*uemsk(jj,jk)
+                  uebnd(jj,jk,nibm ,nitm) = uebnd(jj,jk,nibm ,nit)*uemsk(jj,jk)
+                  uebnd(jj,jk,nibm2,nitm) = uebnd(jj,jk,nibm2,nit)*uemsk(jj,jk)
+         ! ... fields nit <== now (kt+1) 
+         ! ... Total or baroclinic velocity at b, bm and bm2
+                  zucb   = un(ji,jj,jk)
+                  zucbm  = un(ji-1,jj,jk)
+                  zucbm2 = un(ji-2,jj,jk)
+                  uebnd(jj,jk,nib  ,nit) = zucb   *uemsk(jj,jk)
+                  uebnd(jj,jk,nibm ,nit) = zucbm  *uemsk(jj,jk) 
+                  uebnd(jj,jk,nibm2,nit) = zucbm2 *uemsk(jj,jk) 
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj, numout )
+
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uebnd(ij,jk,nibm,nitm) = uebnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uebnd(ij,jk,nibm,nitm) = uebnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.2 tangential velocity
+         ! -----------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm2 <== nitm
+               vebnd(jj,jk,nib  ,nitm2) = vebnd(jj,jk,nib  ,nitm)*vemsk(jj,jk)
+               vebnd(jj,jk,nibm ,nitm2) = vebnd(jj,jk,nibm ,nitm)*vemsk(jj,jk)
+               vebnd(jj,jk,nibm2,nitm2) = vebnd(jj,jk,nibm2,nitm)*vemsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  vebnd(jj,jk,nib  ,nitm) = vebnd(jj,jk,nib,  nit)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm ,nitm) = vebnd(jj,jk,nibm ,nit)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm2,nitm) = vebnd(jj,jk,nibm2,nit)*vemsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  vebnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm ,nit) = vn(ji-1,jj,jk)*vemsk(jj,jk)
+                  vebnd(jj,jk,nibm2,nit) = vn(ji-2,jj,jk)*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout )
+
+         !... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               vebnd(ij,jk,nibm,nitm) = vebnd(ij+1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+         ij = jpjef +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vebnd(ij,jk,nibm,nitm) = vebnd(ij-1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tebnd(jj,jk,nib,nitm) = tebnd(jj,jk,nib,nit)*temsk(jj,jk)
+               sebnd(jj,jk,nib,nitm) = sebnd(jj,jk,nib,nit)*temsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  tebnd(jj,jk,nibm,nitm) = tebnd(jj,jk,nibm,nit)*temsk(jj,jk)
+                  sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  tebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_tem)*temsk(jj,jk)
+                  tebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_tem)*temsk(jj,jk)
+                  sebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_sal)*temsk(jj,jk)
+                  sebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_sal)*temsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout )
+         IF( lk_mpp )   CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout )
+
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               tebnd(ij,jk,nibm,nitm) = tebnd(ij+1 ,jk,nibm,nitm)
+               sebnd(ij,jk,nibm,nitm) = sebnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               tebnd(ij,jk,nibm,nitm) = tebnd(ij-1 ,jk,nibm,nitm)
+               sebnd(ij,jk,nibm,nitm) = sebnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity U based on phase velocity u_cxebnd
+         ! ---------------------------------------------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |  nibm   |   nib   |///
+         !            |    |    |    |    |///
+         !  jj-line --f----v----f----v----f---
+         !            |    |    |    |    |///
+         !            |         |         |///
+         !  jj-line   u    T    u    T    u///
+         !            |         |         |///
+         !            |    |    |    |    |///
+         !          jpieob-2   jpieob-1   jpieob
+         !                 |         |        
+         !              jpieob-1    jpieob      
+         !
+         ! ... (jpjedp1, jpjefm1),jpieob
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* gradi(u) (T-point i=nibm, time mean)
+                  z2dx = ( uebnd(jj,jk,nibm ,nit) + uebnd(jj,jk,nibm ,nitm2) &
+                           - 2.*uebnd(jj,jk,nibm2,nitm) ) / e1t(ji-1,jj)
+         ! ... 2* gradj(u) (u-point i=nibm, time nitm)
+                  z2dy = ( uebnd(jj+1,jk,nibm,nitm) - uebnd(jj-1,jk,nibm,nitm) ) / e2u(ji-1,jj)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = uebnd(jj,jk,nibm,nitm2) - uebnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1)               
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cxebnd(jj,jk) = z05cx*uemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2  Calculate the tangential velocity based on phase velocity v_cxebnd
+         ! -----------------------------------------------------------------------
+         !
+         !          nibm2      nibm      nib
+         !            |   nibm  |   nib///|///
+         !            |    |    |    |////|///
+         !  jj-line --v----f----v----f----v---
+         !            |    |    |    |////|///
+         !            |    |    |    |////|///
+         !            | jpieob-1| jpieob /|///
+         !            |         |         |   
+         !         jpieob-1    jpieob     jpieob+1
+         !
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* i-gradient of v (f-point i=nibm, time mean)
+                  z2dx = ( vebnd(jj,jk,nibm ,nit) + vebnd(jj,jk,nibm ,nitm2) &
+                          - 2.*vebnd(jj,jk,nibm2,nitm) ) / e1f(ji-2,jj)
+         ! ... 2* j-gradient of v (v-point i=nibm, time nitm)
+                  z2dy = ( vebnd(jj+1,jk,nibm,nitm) -  vebnd(jj-1,jk,nibm,nitm) ) / e2v(ji-1,jj)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vebnd(jj,jk,nibm,nitm2) - vebnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.000001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cxebnd(jj,jk) = z05cx*vemsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj, numout )
+
+         ! ... extremeties nie0, nie1
+         ij = jpjed +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxebnd(ij,jk) = v_cxebnd(ij+1 ,jk)
+            END DO
+         END IF
+         ij = jpjef +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxebnd(ij,jk) = v_cxebnd(ij-1 ,jk)
+            END DO
+         END IF
+
+      END IF
+
+   END SUBROUTINE obc_rad_east
+
+
+   SUBROUTINE obc_rad_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_rad_west  ***
+      !!                    
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      west boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ij
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zucb, zucbm, zucbm2
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 .OR. ln_rstart ) THEN
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj 
+               uwbnd(jj,jk,nib  ,nitm2) = uwbnd(jj,jk,nib  ,nitm)*uwmsk(jj,jk)
+               uwbnd(jj,jk,nibm ,nitm2) = uwbnd(jj,jk,nibm ,nitm)*uwmsk(jj,jk)
+               uwbnd(jj,jk,nibm2,nitm2) = uwbnd(jj,jk,nibm2,nitm)*uwmsk(jj,jk)
+            END DO
+         END DO
+
+         ! ... fields nitm <== nit  plus time filter at the boundary 
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  uwbnd(jj,jk,nib  ,nitm) = uwbnd(jj,jk,nib  ,nit)*uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm ,nitm) = uwbnd(jj,jk,nibm ,nit)*uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm2,nitm) = uwbnd(jj,jk,nibm2,nit)*uwmsk(jj,jk)
+         ! ... total or baroclinic velocity at b, bm and bm2
+                  zucb   = un (ji,jj,jk)
+                  zucbm  = un (ji+1,jj,jk)
+                  zucbm2 = un (ji+2,jj,jk)
+
+         ! ... fields nit <== now (kt+1) 
+                  uwbnd(jj,jk,nib  ,nit) = zucb  *uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm ,nit) = zucbm *uwmsk(jj,jk)
+                  uwbnd(jj,jk,nibm2,nit) = zucbm2*uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout )
+
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uwbnd(ij,jk,nibm,nitm) = uwbnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               uwbnd(ij,jk,nibm,nitm) = uwbnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.2 tangential velocity
+         ! -----------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj 
+         ! ... fields nitm2 <== nitm
+                  vwbnd(jj,jk,nib  ,nitm2) = vwbnd(jj,jk,nib  ,nitm)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nitm2) = vwbnd(jj,jk,nibm ,nitm)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nitm2) = vwbnd(jj,jk,nibm2,nitm)*vwmsk(jj,jk)
+            END DO
+         END DO
+
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  vwbnd(jj,jk,nib  ,nitm) = vwbnd(jj,jk,nib,  nit)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nitm) = vwbnd(jj,jk,nibm ,nit)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nitm) = vwbnd(jj,jk,nibm2,nit)*vwmsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  vwbnd(jj,jk,nib  ,nit) = vn(ji  ,jj,jk)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm ,nit) = vn(ji+1,jj,jk)*vwmsk(jj,jk)
+                  vwbnd(jj,jk,nibm2,nit) = vn(ji+2,jj,jk)*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout )
+
+         ! ... extremeties niw0, niw1 
+         ij = jpjwd +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vwbnd(ij,jk,nibm,nitm) = vwbnd(ij+1 ,jk,nibm,nitm)
+            END DO 
+         END IF
+         ij = jpjwf +1 - njmpp 
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN 
+            DO jk = 1,jpkm1 
+               vwbnd(ij,jk,nibm,nitm) = vwbnd(ij-1 ,jk,nibm,nitm)
+            END DO 
+         END IF 
+ 
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+ 
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               twbnd(jj,jk,nib,nitm) = twbnd(jj,jk,nib,nit)*twmsk(jj,jk)
+               swbnd(jj,jk,nib,nitm) = swbnd(jj,jk,nib,nit)*twmsk(jj,jk)
+            END DO
+         END DO
+ 
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  twbnd(jj,jk,nibm ,nitm) = twbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
+                  swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk)
+         ! ... fields nit <== now (kt+1)
+                  twbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_tem)*twmsk(jj,jk)
+                  twbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_tem)*twmsk(jj,jk)
+                  swbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_sal)*twmsk(jj,jk)
+                  swbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_sal)*twmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout )
+         IF( lk_mpp )   CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout )
+
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               twbnd(ij,jk,nibm,nitm) = twbnd(ij+1 ,jk,nibm,nitm)
+               swbnd(ij,jk,nibm,nitm) = swbnd(ij+1 ,jk,nibm,nitm)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               twbnd(ij,jk,nibm,nitm) = twbnd(ij-1 ,jk,nibm,nitm)
+               swbnd(ij,jk,nibm,nitm) = swbnd(ij-1 ,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+   
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+  
+         ! 2.1  Calculate the normal velocity U based on phase velocity u_cxwbnd
+         ! ----------------------------------------------------------------------
+         !
+         !          nib       nibm      nibm2
+         !        ///|   nib   |   nibm  |
+         !        ///|    |    |    |    |
+         !        ---f----v----f----v----f-- jj-line
+         !        ///|    |    |    |    |
+         !        ///|         |         |
+         !        ///u    T    u    T    u   jj-line
+         !        ///|         |         |
+         !        ///|    |    |    |    |
+         !         jpiwob    jpiwob+1    jpiwob+2
+         !                |         |        
+         !              jpiwob+1    jpiwob+2     
+         !
+         ! ... If free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... (jpjwdp1, jpjwfm1), jpiwob
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* gradi(u) (T-point i=nibm, time mean)
+                  z2dx = ( - uwbnd(jj,jk,nibm ,nit) -  uwbnd(jj,jk,nibm ,nitm2) &
+                           + 2.*uwbnd(jj,jk,nibm2,nitm) ) / e1t(ji+2,jj)
+         ! ... 2* gradj(u) (u-point i=nibm, time nitm)
+                  z2dy = ( uwbnd(jj+1,jk,nibm,nitm) - uwbnd(jj-1,jk,nibm,nitm) ) / e2u(ji+1,jj)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = uwbnd(jj,jk,nibm,nitm2) - uwbnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1)
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=0.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cxwbnd(jj,jk)=z05cx*uwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+         ! 2.2  Calculate the tangential velocity based on phase velocity v_cxwbnd
+         ! -----------------------------------------------------------------------
+         !
+         !      nib       nibm     nibm2
+         !    ///|///nib   |   nibm  |  nibm2
+         !    ///|////|    |    |    |    |    |
+         !    ---v----f----v----f----v----f----v-- jj-line
+         !    ///|////|    |    |    |    |    |
+         !    ///|////|    |    |    |    |    |
+         !   jpiwob     jpiwob+1    jpiwob+2
+         !            |         |         |   
+         !          jpiwob   jpiwob+1   jpiwob+2    
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... (jpjwdp1, jpjwfm1),jpiwob
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... 2* i-gradient of v (f-point i=nibm, time mean)
+                  z2dx = ( - vwbnd(jj,jk,nibm ,nit) - vwbnd(jj,jk,nibm ,nitm2) &
+                           + 2.*vwbnd(jj,jk,nibm2,nitm) ) / e1f(ji+1,jj)
+         ! ... 2* j-gradient of v (v-point i=nibm, time nitm)
+                  z2dy = ( vwbnd(jj+1,jk,nibm,nitm) - vwbnd(jj-1,jk,nibm,nitm) ) / e2v(ji+1,jj)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vwbnd(jj,jk,nibm,nitm2) - vwbnd(jj,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0) THEN
+                     z4nor2=0.000001
+                  endif
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cxwbnd(jj,jk) = z05cx*vwmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj, numout )
+
+         ! ... extremeties niw0, niw1
+         ij = jpjwd +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxwbnd(ij,jk) = v_cxwbnd(ij+1 ,jk)
+            END DO
+         END IF
+         ij = jpjwf +1 - njmpp
+         IF( ij >= 2 .AND. ij < jpjm1 ) THEN
+            DO jk = 1,jpkm1
+               v_cxwbnd(ij,jk) = v_cxwbnd(ij-1 ,jk)
+            END DO
+         END IF
+
+      END IF
+
+   END SUBROUTINE obc_rad_west
+
+
+   SUBROUTINE obc_rad_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_rad_north  ***
+      !!           
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      north boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER  ::   ii
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zvcb, zvcbm, zvcbm2
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! -------------------
+
+      IF( kt > nit000 .OR. ln_rstart ) THEN 
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm
+               unbnd(ji,jk,nib  ,nitm2) = unbnd(ji,jk,nib  ,nitm)*unmsk(ji,jk)
+               unbnd(ji,jk,nibm ,nitm2) = unbnd(ji,jk,nibm ,nitm)*unmsk(ji,jk)
+               unbnd(ji,jk,nibm2,nitm2) = unbnd(ji,jk,nibm2,nitm)*unmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  unbnd(ji,jk,nib  ,nitm) = unbnd(ji,jk,nib,  nit)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm ,nitm) = unbnd(ji,jk,nibm ,nit)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm2,nitm) = unbnd(ji,jk,nibm2,nit)*unmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  unbnd(ji,jk,nib  ,nit) = un(ji,jj,  jk)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm ,nit) = un(ji,jj-1,jk)*unmsk(ji,jk)
+                  unbnd(ji,jk,nibm2,nit) = un(ji,jj-2,jk)*unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout )
+
+         ! ... extremeties njn0,njn1 
+         ii = jpind + 1 - nimpp 
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN 
+            DO jk = 1, jpkm1
+                unbnd(ii,jk,nibm,nitm) = unbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF 
+         ii = jpinf + 1 - nimpp 
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               unbnd(ii,jk,nibm,nitm) = unbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+         ! 1.2. normal velocity 
+         ! --------------------
+
+         ! ... advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm 
+               vnbnd(ji,jk,nib  ,nitm2) = vnbnd(ji,jk,nib  ,nitm)*vnmsk(ji,jk)
+               vnbnd(ji,jk,nibm ,nitm2) = vnbnd(ji,jk,nibm ,nitm)*vnmsk(ji,jk)
+               vnbnd(ji,jk,nibm2,nitm2) = vnbnd(ji,jk,nibm2,nitm)*vnmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0, fs_njn1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  vnbnd(ji,jk,nib  ,nitm) = vnbnd(ji,jk,nib,  nit)*vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm ,nitm) = vnbnd(ji,jk,nibm ,nit)*vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm2,nitm) = vnbnd(ji,jk,nibm2,nit)*vnmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+         ! ... total or baroclinic velocity at b, bm and bm2
+                  zvcb   = vn (ji,jj,jk)
+                  zvcbm  = vn (ji,jj-1,jk)
+                  zvcbm2 = vn (ji,jj-2,jk)
+         ! ... fields nit <== now (kt+1) 
+                  vnbnd(ji,jk,nib  ,nit) = zvcb  *vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm ,nit) = zvcbm *vnmsk(ji,jk)
+                  vnbnd(ji,jk,nibm2,nit) = zvcbm2*vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi, numout )
+
+         ! ... extremeties njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vnbnd(ii,jk,nibm,nitm) = vnbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vnbnd(ii,jk,nibm,nitm) = vnbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tnbnd(ji,jk,nib ,nitm) = tnbnd(ji,jk,nib,nit)*tnmsk(ji,jk)
+               snbnd(ji,jk,nib ,nitm) = snbnd(ji,jk,nib,nit)*tnmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tnbnd(ji,jk,nibm ,nitm) = tnbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  tnbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_tem)*tnmsk(ji,jk)
+                  tnbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_tem)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_sal)*tnmsk(ji,jk)
+                  snbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_sal)*tnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout )
+         IF( lk_mpp )   CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout )
+
+         ! ... extremeties  njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tnbnd(ii,jk,nibm,nitm) = tnbnd(ii+1,jk,nibm,nitm)
+               snbnd(ii,jk,nibm,nitm) = snbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tnbnd(ii,jk,nibm,nitm) = tnbnd(ii-1,jk,nibm,nitm)
+               snbnd(ii,jk,nibm,nitm) = snbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity based on phase velocity u_cynbnd
+         ! -------------------------------------------------------------------
+         !
+         !           ji-row
+         !             |
+         !     nib -///u//////  jpjnob + 1
+         !        /////|//////
+         !   nib  -----f-----   jpjnob
+         !             |    
+         !     nibm--  u   ---- jpjnob
+         !             |        
+         !  nibm  -----f-----   jpjnob-1
+         !             |        
+         !    nibm2--  u   ---- jpjnob-1
+         !             |        
+         !  nibm2 -----f-----   jpjnob-2
+         !             |
+         ! ... radiative condition
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* j-gradient of u (f-point i=nibm, time mean)
+                  z2dx = ( unbnd(ji,jk,nibm ,nit) + unbnd(ji,jk,nibm ,nitm2) &
+                        - 2.*unbnd(ji,jk,nibm2,nitm)) / e2f(ji,jj-2)
+         ! ... 2* i-gradient of u (u-point i=nibm, time nitm)
+                  z2dy = ( unbnd(ji+1,jk,nibm,nitm) - unbnd(ji-1,jk,nibm,nitm) ) / e1u(ji,jj-1)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = unbnd(ji,jk,nibm,nitm2) - unbnd(ji,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by 1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2=.000001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cynbnd(ji,jk) = z05cx *unmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi, numout )
+
+         ! ... extremeties  njn0,njn1
+         ii = jpind + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cynbnd(ii,jk) = u_cynbnd(ii+1,jk)
+            END DO
+         END IF
+         ii = jpinf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cynbnd(ii,jk) = u_cynbnd(ii-1,jk)
+            END DO
+         END IF
+
+         ! 2.2 Calculate the normal velocity based on phase velocity v_cynbnd 
+         ! ------------------------------------------------------------------
+         !
+         !                ji-row  ji-row
+         !                     |
+         !        /////|/////////////////
+         !   nib  -----f----v----f----  jpjnob
+         !             |         |
+         !     nib  -  u -- T -- u ---- jpjnob
+         !             |         |
+         !  nibm  -----f----v----f----  jpjnob-1
+         !             |         |
+         !    nibm --  u -- T -- u ---  jpjnob-1
+         !             |         |
+         !  nibm2 -----f----v----f----  jpjnob-2
+         !             |         |
+         ! ... Free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology 
+         ! ... jpjnob,(jpindp1, jpinfm1)
+         DO jj = fs_njn0, fs_njn1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  ii = ji -1 + nimpp
+                  z2dx = ( vnbnd(ji,jk,nibm ,nit) + vnbnd(ji,jk,nibm ,nitm2) &
+                          - 2.*vnbnd(ji,jk,nibm2,nitm)) / e2t(ji,jj-1)
+         ! ... 2* gradi(v) (v-point i=nibm, time nitm)
+                  z2dy = ( vnbnd(ji+1,jk,nibm,nitm) - vnbnd(ji-1,jk,nibm,nitm) ) / e1v(ji,jj-1)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vnbnd(ji,jk,nibm,nitm2) - vnbnd(ji,jk,nibm,nit)
+         ! ... j-phase speed ratio (bounded by 1)
+                  IF( z4nor2 == 0. ) THEN
+                     z4nor2=.00001
+                  END IF
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cynbnd(ji,jk)=z05cx *vnmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_rad_north
+
+
+   SUBROUTINE obc_rad_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_rad_south  ***
+      !!           
+      !! ** Purpose :
+      !!      Perform swap of arrays to calculate radiative phase speeds at the open 
+      !!      south boundary and calculate those phase speeds if this OBC is not fixed.
+      !!      In case of fixed OBC, this subrountine is not called.
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declarations
+      INTEGER ::   ii
+      REAL(wp) ::   z05cx, zdt, z4nor2, z2dx, z2dy
+      REAL(wp) ::   zvcb, zvcbm, zvcbm2
+      !!------------------------------------------------------------------------------
+
+      ! 1. Swap arrays before calculating radiative velocities
+      ! ------------------------------------------------------
+
+      ! 1.1  zonal velocity 
+      ! --------------------
+  
+      IF( kt > nit000 .OR. ln_rstart ) THEN 
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm
+                  usbnd(ji,jk,nib  ,nitm2) = usbnd(ji,jk,nib  ,nitm)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nitm2) = usbnd(ji,jk,nibm ,nitm)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nitm2) = usbnd(ji,jk,nibm2,nitm)*usmsk(ji,jk)
+            END DO
+         END DO
+ 
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  usbnd(ji,jk,nib  ,nitm) = usbnd(ji,jk,nib,  nit)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nitm) = usbnd(ji,jk,nibm ,nit)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nitm) = usbnd(ji,jk,nibm2,nit)*usmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  usbnd(ji,jk,nib  ,nit) = un(ji,jj  ,jk)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm ,nit) = un(ji,jj+1,jk)*usmsk(ji,jk)
+                  usbnd(ji,jk,nibm2,nit) = un(ji,jj+2,jk)*usmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout )
+
+         ! ... extremeties njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               usbnd(ii,jk,nibm,nitm) = usbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               usbnd(ii,jk,nibm,nitm) = usbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+ 
+         ! 1.2 normal velocity
+         ! -------------------
+ 
+         !.. advance in time (time filter, array swap) 
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm2 <== nitm 
+               vsbnd(ji,jk,nib  ,nitm2) = vsbnd(ji,jk,nib  ,nitm)*vsmsk(ji,jk)
+               vsbnd(ji,jk,nibm ,nitm2) = vsbnd(ji,jk,nibm ,nitm)*vsmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  vsbnd(ji,jk,nib  ,nitm) = vsbnd(ji,jk,nib,  nit)*vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm ,nitm) = vsbnd(ji,jk,nibm ,nit)*vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm2,nitm) = vsbnd(ji,jk,nibm2,nit)*vsmsk(ji,jk)
+         ! ... total or baroclinic velocity at b, bm and bm2
+                  zvcb   = vn (ji,jj,jk)
+                  zvcbm  = vn (ji,jj+1,jk)
+                  zvcbm2 = vn (ji,jj+2,jk)
+         ! ... fields nit <== now (kt+1) 
+                  vsbnd(ji,jk,nib  ,nit) = zvcb   *vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm ,nit) = zvcbm  *vsmsk(ji,jk)
+                  vsbnd(ji,jk,nibm2,nit) = zvcbm2 *vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout )
+
+         ! ... extremeties njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vsbnd(ii,jk,nibm,nitm) = vsbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               vsbnd(ii,jk,nibm,nitm) = vsbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+         ! 1.3 Temperature and salinity
+         ! ----------------------------
+
+         ! ... advance in time (time filter, array swap)
+         DO jk = 1, jpkm1
+            DO ji = 1, jpi
+         ! ... fields nitm <== nit  plus time filter at the boundary
+               tsbnd(ji,jk,nib,nitm) = tsbnd(ji,jk,nib,nit)*tsmsk(ji,jk)
+               ssbnd(ji,jk,nib,nitm) = ssbnd(ji,jk,nib,nit)*tsmsk(ji,jk)
+            END DO
+         END DO
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tsbnd(ji,jk,nibm ,nitm) = tsbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk)
+         ! ... fields nit <== now (kt+1)
+                  tsbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_tem)*tsmsk(ji,jk)
+                  tsbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_tem)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_sal)*tsmsk(ji,jk)
+                  ssbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_sal)*tsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout )
+         IF( lk_mpp )   CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout )
+
+         ! ... extremeties  njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tsbnd(ii,jk,nibm,nitm) = tsbnd(ii+1,jk,nibm,nitm)
+               ssbnd(ii,jk,nibm,nitm) = ssbnd(ii+1,jk,nibm,nitm)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               tsbnd(ii,jk,nibm,nitm) = tsbnd(ii-1,jk,nibm,nitm)
+               ssbnd(ii,jk,nibm,nitm) = ssbnd(ii-1,jk,nibm,nitm)
+            END DO
+         END IF
+
+      END IF     ! End of array swap
+
+      ! 2 - Calculation of radiation velocities
+      ! ---------------------------------------
+
+      IF( kt >= nit000 +3 .OR. ln_rstart ) THEN
+
+         ! 2.1  Calculate the normal velocity based on phase velocity u_cysbnd
+         ! -------------------------------------------------------------------
+         !
+         !          ji-row
+         !            |
+         ! nibm2 -----f-----   jpjsob +2
+         !            |    
+         !  nibm2 --  u  ----- jpjsob +2 
+         !            |        
+         !  nibm -----f-----   jpjsob +1
+         !            |        
+         !  nibm  --  u  ----- jpjsob +1
+         !            |        
+         !  nib  -----f-----   jpjsob
+         !       /////|//////
+         !  nib   ////u/////   jpjsob 
+         !
+         ! ... radiative condition plus Raymond-Kuo
+         ! ... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* j-gradient of u (f-point i=nibm, time mean)
+                  z2dx = (- usbnd(ji,jk,nibm ,nit) - usbnd(ji,jk,nibm ,nitm2) &
+                          + 2.*usbnd(ji,jk,nibm2,nitm) ) / e2f(ji,jj+1)
+         ! ... 2* i-gradient of u (u-point i=nibm, time nitm)
+                  z2dy = ( usbnd(ji+1,jk,nibm,nitm) - usbnd(ji-1,jk,nibm,nitm) ) / e1u(ji, jj+1)
+         ! ... square of the norm of grad(v)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2 = 0.000001
+                  END IF
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = usbnd(ji,jk,nibm,nitm2) - usbnd(ji,jk,nibm,nit)
+         ! ... i-phase speed ratio (bounded by -1) and save the unbounded phase
+         !     velocity ratio no divided by e1f for the tracer radiation
+                  z05cx = zdt * z2dx / z4nor2
+                  u_cysbnd(ji,jk) = z05cx*usmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi, numout )
+
+         ! ... extremeties  njs0,njs1
+         ii = jpisd + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cysbnd(ii,jk) = u_cysbnd(ii+1,jk)
+            END DO
+         END IF
+         ii = jpisf + 1 - nimpp
+         IF( ii >= 2 .AND. ii < jpim1 ) THEN
+            DO jk = 1, jpkm1
+               u_cysbnd(ii,jk) = u_cysbnd(ii-1,jk)
+            END DO
+         END IF
+
+         ! 2.2 Calculate the normal velocity based on phase velocity v_cysbnd 
+         ! -------------------------------------------------------------------
+         !
+         !               ji-row  ji-row
+         !            |         |
+         ! nibm2 -----f----v----f----  jpjsob+2
+         !            |         |
+         !  nibm   -  u -- T -- u ---- jpjsob+2
+         !            |         |
+         ! nibm  -----f----v----f----  jpjsob+1 
+         !            |         |
+         ! nib    --  u -- T -- u ---  jpjsob+1
+         !            |         |
+         ! nib   -----f----v----f----  jpjsob
+         !       /////////////////////
+         !
+         ! ... Free surface formulation:
+         ! ... radiative conditions on the total part + relaxation toward climatology
+         ! ... jpjsob,(jpisdp1,jpisfm1)
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... 2* gradj(v) (T-point i=nibm, time mean)
+                  z2dx = ( - vsbnd(ji,jk,nibm ,nit) - vsbnd(ji,jk,nibm ,nitm2) &
+                           + 2.*vsbnd(ji,jk,nibm2,nitm) ) / e2t(ji,jj+1)
+         ! ... 2* gradi(v) (v-point i=nibm, time nitm)
+                  z2dy = ( vsbnd(ji+1,jk,nibm,nitm) - vsbnd(ji-1,jk,nibm,nitm) ) / e1v(ji,jj+1)
+         ! ... square of the norm of grad(u)
+                  z4nor2 = z2dx * z2dx + z2dy * z2dy
+                  IF( z4nor2 == 0.) THEN
+                     z4nor2 = 0.000001
+                  END IF
+         ! ... minus time derivative (leap-frog) at nibm, without / 2 dt
+                  zdt = vsbnd(ji,jk,nibm,nitm2) - vsbnd(ji,jk,nibm,nit)
+         ! ... j-phase speed ratio (bounded by -1)
+                  z05cx = zdt * z2dx / z4nor2
+                  v_cysbnd(ji,jk)=z05cx*vsmsk(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ENDIF
+ 
+   END SUBROUTINE obc_rad_south
+
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcrad  ***
+   !! Ocean dynamic :   Phase velocities for each open boundary
+   !!=================================================================================
+CONTAINS
+   SUBROUTINE obc_rad( kt )            ! No open boundaries ==> empty routine
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'obc_rad: You should not have seen this print! error?', kt
+   END SUBROUTINE obc_rad
+#endif
+
+END MODULE obcrad
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcrst.F90	(revision 3437)
@@ -0,0 +1,606 @@
+MODULE obcrst
+#if defined key_obc
+   !!=================================================================================
+   !!                       ***  MODULE  obcrst  ***
+   !! Ocean dynamic :  Input/Output files for restart on OBC
+   !!=================================================================================
+
+   !!---------------------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppobc
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   obc_rst_read    ! routine called by obc_ini
+   PUBLIC   obc_rst_write   ! routine called by step
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: obcrst.F90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_rst_write ( kt )
+      !!--------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE obc_rst_write  ***
+      !!                
+      !! ** Purpose :   Write open boundary restart fields in restart.obc.output file 
+      !!
+      !! ** Method  :   restart.obc.output file: Direct access non formatted file.
+      !!      Each nstock time step , save fields which are necessary for restart.
+      !!      - This routine is called if at least the key_obc is defined. It is called
+      !!        at the same time step than rstwrite.
+      !!      - First record holds OBC parameters nbobc,jpieob,jpiwob,jpjnob,jpjsob and 
+      !!        the OBC layout jpjed, jpjef ... for checking purposes.
+      !!      - Following records hold the boundary arrays, in the order east west north
+      !!        south, if they exist.
+      !!      - The writing is realised by vertical slab across the boundary, for bsf, u,
+      !!        v, t, and s boundary arrays. Each record hold a vertical slab.
+      !!      - For mpp, this allows each processor to write only the correct informations
+      !!        it hold. If a processor has no valid informations on boundary, it just 
+      !!        skip the writing part (automatically).
+      !!      - Special care is taken for dumping the starting point of a boundary (jpjed,
+      !!        jpjwd, jpind, jpisd) because of the general definition of nje0 njw0,nin0,
+      !!        nis0. This is done to avoid records to be written by 2 adjacent processors.
+      !!
+      !!  History :
+      !!         ! 97-11 (J.M. Molines) Original code
+      !!         ! 98-11 (J.M. Molines) Bug fix for adjacent processors
+      !!   8.5   ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!         ! 03-06 (J.M. Molines) Bug fix for adjacent processors
+      !!   9.0   ! 04-02 (G. Madec)  suppression of numwob, use inum
+      !!-----------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk
+      INTEGER ::   inum               ! temporary logical unit
+      INTEGER ::   ibloc, nreclo, jrec, jt, jb 
+      INTEGER ::   jfoe, jfow, ifon, ifos
+      INTEGER ::   ino0, it0
+      !!-----------------------------------------------------------------------------
+
+      ! 1. Output of restart fields (inum)
+      ! ------------------------------------
+ 
+      IF( ( mod(kt,nstock) == 0 ) .OR. ( kt == nitend ) ) THEN
+
+         ! 1.0 Initializations
+         ! -------------------
+         IF(lwp) THEN
+              WRITE(numout,*) ' '
+              WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_write routine'
+              WRITE(numout,*) '~~~~~~'
+              WRITE(numout,*) '        output done in restart.obc.output file at it= ', kt, ' date= ', ndastp
+         END IF
+
+         ino0 = no
+         it0  = kt
+         ibloc  = 4096*4
+         nreclo = ibloc*( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
+         IF(lwp) WRITE(numout,*) '             '
+         IF(lwp) WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo
+
+         ! 1.1 Open file
+         ! -------------
+
+         CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )
+ 
+         ! 1.2 Write header
+         ! ----------------
+         WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob,     &
+                              jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf
+
+         ! 1.3 Write east boundary array if any.
+         ! -------------------------------------
+         IF( lp_obc_east ) THEN
+            IF( lfbceast ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed east OBC'
+               END IF
+            ELSE
+               IF( jpieob /= 0 ) THEN
+                  IF( nje0+njmpp-1  == jpjed .AND. nie1 >= nie0 ) THEN
+            ! ... dump of jpjed if it is on this proc.
+                     jrec = 2
+                     jfoe = jpjed - njmpp + 1
+                     PRINT *,'Narea =',narea,' write jrec =2 east'
+                     WRITE(inum,REC=jrec)                                    &
+                           ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  ENDIF
+                  DO ji = nie0, nie1
+                     DO jj = nje0, nje1
+            ! ... only interested processors go through the following lines
+            !           jfoe = jj + njmpp -1
+                        jfoe = jj 
+                        jrec = 2 + jj + njmpp -1 -jpjed
+                        WRITE (inum,REC=jrec)                                   &
+                              ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.4 Write west boundary arrays if any
+         ! -------------------------------------
+         IF( lp_obc_west ) THEN
+            IF( lfbcwest ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed west OBC'
+               END IF
+            ELSE
+               IF( jpiwob /= 0 ) THEN
+                  IF( njw0+njmpp+1 == jpjwd .AND. niw1 >= niw0 ) THEN
+            ! ... dump of jpjwd if it is on this proc.
+                     jrec = 3 + jpjef - jpjed
+            !        jfow = jpjwd
+                     jfow = jpjwd -njmpp + 1
+                     PRINT *,'Narea =',narea,' write jrec =',jrec,' west'
+                     WRITE (inum,REC=jrec)                                   &
+                           ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO ji = niw0, niw1
+                     DO jj = njw0, njw1
+            ! ... only interested processors go through the following lines
+            !           jfow = jj + njmpp -1
+                        jfow = jj 
+                        jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
+                        WRITE (inum,REC=jrec)                                   &
+                              ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.5 Write north boundary arrays if any
+         ! --------------------------------------
+         IF( lp_obc_north ) THEN
+            IF( lfbcnorth ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed north OBC'
+               END IF
+            ELSE
+               IF( jpjnob /= 0) THEN
+                  IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
+            ! ... dump of jpind if it is on this proc.
+                     jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
+            !        ifon = jpind
+                     ifon = jpind -nimpp +1
+                     WRITE (inum,REC=jrec)                                   &
+                           ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO jj = njn0, njn1
+                     DO ji = nin0, nin1
+            ! ... only interested processors go through the following lines
+            !           ifon = ji + nimpp -1
+                        ifon = ji 
+                        jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
+                        WRITE (inum,REC=jrec)                                   &
+                              ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+ 
+         ! 1.6 Write south boundary arrays if any
+         ! --------------------------------------
+         IF( lp_obc_south ) THEN
+            IF( lfbcsouth ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*) ' '
+                  WRITE(numout,*) '        No restart file for the fixed south OBC'
+                  WRITE(numout,*) ' '
+               END IF
+            ELSE
+               IF( jpjsob /= 0 ) THEN
+                  IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
+            ! ... dump of jpisd if it is on this proc.
+                     jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
+            !        ifos = jpisd
+                     ifos = jpisd -nimpp + 1
+                     WRITE (inum,REC=jrec)                                   &
+                           ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                           ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                           ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                  END IF
+                  DO jj = njs0, njs1
+                     DO ji = nis0, nis1
+            ! ... only interested processors go through the following lines
+            !           ifos = ji + nimpp -1
+                        ifos = ji 
+                        jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + &
+                              ji + nimpp -1 -jpisd
+                        WRITE (inum,REC=jrec) &
+                              ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                              ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                              ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+                     END DO
+                  END DO
+               END IF
+            END IF
+         END IF
+      CLOSE(inum)
+      END IF
+
+   END SUBROUTINE obc_rst_write
+
+
+   SUBROUTINE obc_rst_read
+      !!----------------------------------------------------------------------------
+      !!                   ***  SUBROUTINE obc_rst_read  ***
+      !!                   
+      !! ** Purpose :   Read files for restart at open boundaries
+      !!
+      !! ** Method  :   Read the previous boundary arrays on unit inum
+      !!      The first record indicates previous characterics
+      !!
+      !! History :
+      !!        ! 97-11 (J.M. Molines) Original code
+      !!   8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!----------------------------------------------------------------------------
+      !! * Local declarations
+      INTEGER ::   inum = 11            ! temporary logical unit
+      INTEGER ::   ji,jj,jk
+      INTEGER ::   ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0
+      INTEGER ::   ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,jpjsob1
+      INTEGER ::   ied0,ief0,iwd0,iwf0,ind0,inf0,isd0,isf0
+      INTEGER ::   ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
+      INTEGER ::   ibloc, nreclo, jrec, jt, jb
+      INTEGER ::   jfoe, jfow, ifon, ifos
+      !!-----------------------------------------------------------------------------
+
+      ! 0. Initialisations
+      ! ------------------
+ 
+      ino0    = no
+      it0     = nit000
+      nbobc0  = nbobc
+      jpieob0 = jpieob
+      jpiwob0 = jpiwob
+      jpjnob0 = jpjnob
+      jpjsob0 = jpjsob
+ 
+      ied0   = jpjed
+      ief0   = jpjef
+      iwd0   = jpjwd
+      iwf0   = jpjwf
+      ind0   = jpind
+      inf0   = jpinf
+      isd0   = jpisd
+      isf0   = jpisf
+ 
+      ibloc  = 4096*4
+      nreclo = ibloc *( ( ( 26 *jpk + 9 )*jpbyt -1)/ibloc + 1)
+ 
+      IF(lwp) THEN
+         WRITE(numout,*) 'obcrst: beginning of restart with obc_rst_read routine'
+         WRITE(numout,*) '~~~~~~'
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '        The present run :'
+         WRITE(numout,*) '        number job is  : ',no 
+         WRITE(numout,*) '        with the time nit000 : ',nit000
+         WRITE(numout,*) '        OBC restart file opened with nreclo = ',nreclo 
+      END IF
+ 
+      ! 0.1 Open files
+      ! ---------------
+      CALL ctl_opn( inum, 'restart.obc', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp )
+
+      ! 1. Read
+      ! -------
+ 
+      ! 1.1 First record
+      ! -----------------
+      READ(inum,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1,     &
+                         jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1
+ 
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) '        READ inum with number job : ',ino1,' with the time it: ',it1
+         WRITE(numout,*) ' '
+      END IF
+ 
+      ! 1.2 Control of date
+      ! --------------------
+      IF( ( it0-it1 ) /= 1 .AND. abs(nrstdt) == 1 ) THEN
+          CALL ctl_stop( '        ===>>>> : problem with nit000 for the restart',   &
+               &         '        ==============',   &
+               &         '        we stop in obc_rst_read routine. Verify the file or rerun with the value',   &
+               &         '        0 for the control of time parameter nrstdt' )
+             
+      END IF
+ 
+      ! 1.3 Control of number of open boundaries
+      ! ----------------------------------------
+      IF( nbobc1 /= nbobc0 ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '        ===> W A R N I N G: The number of OBC have changed:'
+            WRITE(numout,*) '        Last run : ',nbobc0,' obcs'
+            WRITE(numout,*) '        This run : ',nbobc1,' obcs'
+         END IF
+      END IF
+ 
+      ! 1.4 Control of which boundary is open
+      ! -------------------------------------
+      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        East open boundary'
+            IF( jpieob0 /= jpieob1 ) CALL ctl_stop( '         ==>>>> : Problem in obc_rst_read, jpieob have changed' )
+         END IF
+      END IF
+ 
+      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        West open boundary'
+            IF( jpiwob0 /= jpiwob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpiwob has changed' )
+         END IF
+      END IF
+ 
+      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        North open boundary'
+            IF( jpjnob0 /= jpjnob1 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjnob has changed' )
+         END IF
+      END IF
+ 
+      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
+         IF(lwp) THEN
+            WRITE(numout,*) '         '
+            WRITE(numout,*) '        South open boundary'
+            IF( jpjsob0 /= jpjsob1) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjsob has changed' )
+         END IF
+      END IF
+ 
+ 
+      ! 1.5 Control of the limit of the boundaries
+      ! ------------------------------------------
+      IF( lp_obc_east .AND. ( jpieob1 /= 0 ) ) THEN
+         IF( ied1 /= ied0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjed has changed' )
+         IF( ief1 /= ief0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjef has changed' )
+      END IF
+
+      IF( lp_obc_west .AND. ( jpiwob1 /= 0 ) ) THEN
+         IF( iwd1 /= iwd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjwd has changed' )
+         IF( iwf1 /= iwf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpjwf has changed' )
+      END IF
+ 
+      IF( lp_obc_north .AND. ( jpjnob1 /= 0 ) ) THEN
+         IF( ind1 /= ind0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpind has changed' )
+         IF( inf1 /= inf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpinf has changed' )
+      END IF
+ 
+      IF( lp_obc_south .AND. ( jpjsob1 /= 0 ) ) THEN
+         IF( isd1 /= isd0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpisd has changed' )
+         IF( isf1 /= isf0 ) CALL ctl_stop( '        ==>>>> : Problem in obc_rst_read, jpisf has changed' )
+      END IF
+ 
+ 
+      ! 2. Now read the boundary arrays
+      ! -------------------------------
+ 
+      ! 2.1 Read east boundary array if any.
+      ! ------------------------------------
+      IF( lp_obc_east ) THEN
+         IF( jpieob1 /= 0) THEN
+            IF( nje0+njmpp-1 == jpjed .AND. nie1 >= nie0 ) THEN
+      ! ... read of jpjed if it is on this proc.
+               jrec = 2
+      !        jfoe = jpjed
+               jfoe = jpjed -njmpp + 1
+               READ (inum,REC=jrec)                                   &
+                    ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO ji = nie0, nie1
+               DO jj = nje0, nje1
+      ! ... only interested processors go through the following lines
+      !           jfoe = jj + njmpp -1
+                  jfoe = jj 
+                  jrec = 2 + jj + njmpp -1 -jpjed
+                  READ (inum,REC=jrec)                                   &
+                       ((( uebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( sebnd(jfoe,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+            !  lp_obc_east was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.2 Read west boundary arrays if any.
+      ! -------------------------------------
+      IF( lp_obc_west ) THEN
+         IF( jpiwob1 /= 0) THEN
+            IF( njw0+njmpp-1 == jpjwd .AND. niw1 >= niw0 ) THEN
+      ! ... read of jpjwd if it is on this proc.
+               jrec = 3 + jpjef - jpjed
+      !        jfow = jpjwd
+               jfow = jpjwd -njmpp + 1
+               READ (inum,REC=jrec)                                   &
+                    ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO ji = niw0, niw1
+               DO jj = njw0, njw1
+      ! ... only interested processors go through the following lines
+      !           jfow = jj + njmpp -1
+                  jfow = jj 
+                  jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd
+                  READ (inum,REC=jrec)                                   &
+                       ((( uwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vwbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( twbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( swbnd(jfow,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+            !  lp_obc_west was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.3 Read north boundary arrays if any.
+      ! --------------------------------------
+      IF( lp_obc_north ) THEN
+         IF( jpjnob1 /= 0) THEN
+            IF( nin0+nimpp-1 == jpind .AND. njn1 >= njn0 ) THEN
+      ! ... read of jpind if it is on this proc.
+               jrec = 4 + jpjef -jpjed + jpjwf -jpjwd
+      !        ifon = jpind
+               ifon = jpind -nimpp +1
+               READ (inum,REC=jrec)                                   &
+                    ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), & 
+                    ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO jj = njn0, njn1
+               DO ji = nin0, nin1
+      ! ... only interested processors go through the following lines
+      !           ifon = ji + nimpp -1
+                  ifon = ji 
+                  jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1  -jpind
+                  READ (inum,REC=jrec)                                   & 
+                       ((( unbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tnbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( snbnd(ifon,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+
+         ELSE
+
+           !  lp_obc_north was not TRUE previously
+         END IF
+
+      END IF
+ 
+      ! 2.4 Read south boundary arrays if any.
+      ! -------------------------------------
+      IF( lp_obc_south ) THEN
+         IF( jpjsob1 /= 0) THEN
+            IF( nis0+nimpp-1 == jpisd .AND. njs1 >= njs0 ) THEN
+      ! ... read of jpisd if it is on this proc.
+               jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind
+      !        ifos = jpisd
+               ifos = jpisd -nimpp + 1
+               READ (inum,REC=jrec)                                   &
+                    ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                    ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                    ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+            END IF
+            DO jj = njs0, njs1
+               DO ji = nis0, nis1
+      ! ... only interested processors go through the following lines
+      !           ifos = ji + nimpp -1
+                  ifos = ji 
+                  jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind +  &
+                        ji + nimpp -1 -jpisd
+                  READ (inum,REC=jrec)                                   & 
+                       ((( usbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( vsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,3),jt=1,3), &
+                       ((( tsbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2), &
+                       ((( ssbnd(ifos,jk,jb,jt),jk=1,jpk),jb=1,2),jt=1,2)
+               END DO
+            END DO
+         ELSE
+            !  lp_obc_south was not TRUE previously
+         END IF
+
+      END IF
+      CLOSE(inum)
+
+      IF( lk_mpp ) THEN
+         IF( lp_obc_east ) THEN
+            CALL mppobc(uebnd,jpjed,jpjef,jpieob  ,jpk*3*3,2,jpj, numout )
+            CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj, numout )
+            CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout )
+            CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj, numout )
+         ENDIF
+         IF( lp_obc_west ) THEN
+            CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout )
+            CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj, numout )
+            CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout )
+            CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj, numout )
+         ENDIF
+         IF( lp_obc_north ) THEN 
+            CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi, numout )
+            CALL mppobc(vnbnd,jpind,jpinf,jpjnob  ,jpk*3*3,1,jpi, numout )
+            CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout )
+            CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi, numout )
+         ENDIF
+         IF( lp_obc_south ) THEN
+            CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout )
+            CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi, numout )
+            CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout )
+            CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi, numout )
+         ENDIF
+      ENDIF
+ 
+   END SUBROUTINE obc_rst_read
+#else
+   !!=================================================================================
+   !!                       ***  MODULE  obcrst  ***
+   !! Ocean dynamic :  Input/Output files for restart on OBC
+   !!=================================================================================
+CONTAINS
+   SUBROUTINE obc_rst_write( kt )           !  No Open boundary ==> empty routine
+      INTEGER,INTENT(in) :: kt
+      WRITE(*,*) 'obc_rst_write: You should not have seen this print! error?', kt
+   END SUBROUTINE obc_rst_write
+   SUBROUTINE obc_rst_read                 !  No Open boundary ==> empty routine
+   END SUBROUTINE obc_rst_read
+#endif
+
+   !!=================================================================================
+END MODULE obcrst
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90	(revision 3437)
@@ -0,0 +1,524 @@
+MODULE obctra
+   !!=================================================================================
+   !!                       ***  MODULE  obctra  ***
+   !! Ocean tracers:   Radiation of tracers on each open boundary
+   !!=================================================================================
+#if defined key_obc
+   !!---------------------------------------------------------------------------------
+   !!   'key_obc'      :                                      Open Boundary Conditions
+   !!---------------------------------------------------------------------------------
+   !!   obc_tra        : call the subroutine for each open boundary
+   !!   obc_tra_east   : radiation of the east open boundary tracers
+   !!   obc_tra_west   : radiation of the west open boundary tracers
+   !!   obc_tra_north  : radiation of the north open boundary tracers
+   !!   obc_tra_south  : radiation of the south open boundary tracers
+   !!----------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! ???
+   USE lbclnk          ! ???
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_tra     ! routine called in tranxt.F90 
+
+   !! * Module variables
+   INTEGER ::      & ! ... boundary space indices 
+      nib   = 1,   & ! nib   = boundary point
+      nibm  = 2,   & ! nibm  = 1st interior point
+      nibm2 = 3,   & ! nibm2 = 2nd interior point
+                     ! ... boundary time indices 
+      nit   = 1,   & ! nit    = now
+      nitm  = 2,   & ! nitm   = before
+      nitm2 = 3      ! nitm2  = before-before
+
+   REAL(wp) ::     &
+      rtaue  , rtauw  , rtaun  , rtaus  ,  &  ! Boundary restoring coefficient
+      rtauein, rtauwin, rtaunin, rtausin      ! Boundary restoring coefficient for inflow 
+
+   !! * Substitutions
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_tra( kt )
+      !!-------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra  ***
+      !!                    
+      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries.
+      !!      This routine is called by the tranxt.F routine and updates tsa
+      !!      which are the actual temperature and salinity fields.
+      !!        The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north,
+      !!      and/or lp_obc_south allow the user to determine which boundary is an
+      !!      open one (must be done in the param_obc.h90 file).
+      !!
+      !! Reference : 
+      !!   Marchesiello P., 1995, these de l'universite J. Fourier, Grenoble, France.
+      !!
+      !!  History :
+      !!        !  95-03 (J.-M. Molines) Original, SPEM
+      !!        !  97-07 (G. Madec, J.-M. Molines) addition
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) F90
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+      !!----------------------------------------------------------------------
+
+      ! 0. Local constant initialization
+
+      IF( kt == nit000 .OR. ln_rstart) THEN
+         ! ... Boundary restoring coefficient
+         rtaue = 2. * rdt / rdpeob
+         rtauw = 2. * rdt / rdpwob
+         rtaun = 2. * rdt / rdpnob
+         rtaus = 2. * rdt / rdpsob
+         ! ... Boundary restoring coefficient for inflow ( all boundaries)
+         rtauein = 2. * rdt / rdpein 
+         rtauwin = 2. * rdt / rdpwin
+         rtaunin = 2. * rdt / rdpnin
+         rtausin = 2. * rdt / rdpsin 
+      END IF
+
+      IF( lp_obc_east  )   CALL obc_tra_east ( kt )    ! East open boundary
+
+      IF( lp_obc_west  )   CALL obc_tra_west ( kt )    ! West open boundary
+
+      IF( lp_obc_north )   CALL obc_tra_north( kt )    ! North open boundary
+
+      IF( lp_obc_south )   CALL obc_tra_south( kt )    ! South open boundary
+
+      IF( lk_mpp ) THEN                  !!bug ???
+         IF( kt >= nit000+3 .AND. ln_rstart ) THEN
+            CALL lbc_lnk( tsb(:,:,:,jp_tem), 'T', 1. )
+            CALL lbc_lnk( tsb(:,:,:,jp_sal), 'T', 1. )
+         END IF
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )
+         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      ENDIF
+
+   END SUBROUTINE obc_tra
+
+
+   SUBROUTINE obc_tra_east ( kt )
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_tra_east  ***
+      !!                  
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on east OBC tracers tsa using the 
+      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module
+      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbceast is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) + &
+                                         tfoe(jj,jk)*temsk(jj,jk)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) + &
+                                         sfoe(jj,jk)*temsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbceast is .FALSE.
+      ! -----------------------------------------------------
+
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !            nibm2      nibm      nib
+         !              |   nibm  |   nib///|///
+         !              |    |    |    |////|///
+         !  jj   line --v----f----v----f----v---
+         !              |    |    |    |////|///
+         !                   |         |///   //
+         !  jj   line   T    u    T    u/// T //
+         !                   |         |///   //
+         !              |    |    |    |////|///
+         !  jj-1 line --v----f----v----f----v---
+         !              |    |    |    |////|///
+         !                jpieob-1    jpieob / ///
+         !              |         |         |
+         !           jpieob-1    jpieob     jpieob+1
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         !     the phase velocity is taken as the phase velocity of the tangen-
+         !     tial velocity (here vn), which have been saved in (u_cxebnd,v_cxebnd)
+         ! ... (jpjedp1, jpjefm1), jpieob+1
+         DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... i-phase speed ratio (from averaged of v_cxebnd)
+                  z05cx = ( 0.5 * ( v_cxebnd(jj,jk) + v_cxebnd(jj-1,jk) ) ) / e1t(ji-1,jj)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaue
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtauein is used for relaxation coefficient else rtaue
+                  ztau = (1.-zin ) * rtauein  + zin * rtaue
+                  z05cx = z05cx * zin
+         ! ... update tsa with radiative or climatological ts
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) +           &
+                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) &
+                                 / (1. + z05cx)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) +           &
+                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx              &
+                                 * sebnd(jj,jk,nibm,nit ) + ztau * sfoe (jj,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_east
+
+
+   SUBROUTINE obc_tra_west ( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra_west  ***
+      !!           
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on west OBC tracers tsa using the 
+      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module
+      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcwest is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN
+
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) + &
+                                         tfow(jj,jk)*twmsk(jj,jk)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) + &
+                                         sfow(jj,jk)*twmsk(jj,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcwest is .FALSE.
+      ! -----------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !          nib       nibm     nibm2
+         !     nib///|   nibm  |  nibm2  |
+         !   ///|////|    |    |    |    |   
+         !   ---v----f----v----f----v----f-- jj   line
+         !   ///|////|    |    |    |    |   
+         !   //   ///|         |         |   
+         !   // T ///u    T    u    T    u   jj   line
+         !   //   ///|         |         |   
+         !   ///|////|    |    |    |    |   
+         !   ---v----f----v----f----v----f-- jj-1 line
+         !   ///|////|    |    |    |    |   
+         !         jpiwob    jpiwob+1    jpiwob+2
+         !      |         |         |        
+         !    jpiwob    jpiwob+1   jpiwob+2
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         ! ... the phase velocity is taken as the phase velocity of the tangen-
+         ! ... tial velocity (here vn), which have been saved in (v_cxwbnd)
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+         ! ... i-phase speed ratio (from averaged of v_cxwbnd)
+                  z05cx = (  0.5 * ( v_cxwbnd(jj,jk) + v_cxwbnd(jj-1,jk) ) ) / e1t(ji+1,jj)
+                  z05cx = max( z05cx, -1. )
+         ! ... z05cx > 0, inflow  zin=0, ztau=1    
+         !           < 0, outflow zin=1, ztau=rtauw
+                  zin = sign( 1., -1.* z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin )*rtauwin + zin * rtauw
+                  z05cx = z05cx * zin
+         ! ... update tsa with radiative or climatological (ts)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) +           &
+                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) &
+                                 / (1. - z05cx)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) +           &
+                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx              &
+                                 * swbnd(jj,jk,nibm,nit ) + ztau * sfow (jj,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_west
+
+
+   SUBROUTINE obc_tra_north ( kt )
+      !!------------------------------------------------------------------------------
+      !!                 ***  SUBROUTINE obc_tra_north  ***
+      !!
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on north OBC tracers ta, sa using the 
+      !!      phase velocities calculated in obc_rad_north subroutine in obcrad.F90 module
+      !!      If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M. Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcnorth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN
+
+         DO jj = fs_njn0+1, fs_njn1+1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) + &
+                                        tnmsk(ji,jk) * tfon(ji,jk)
+                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) + &
+                                        tnmsk(ji,jk) * sfon(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcnorth is .FALSE.
+      ! -------------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !           ji-1   ji   ji   ji +1
+         !             |
+         !    nib //// u // T // u // T //   jpjnob + 1
+         !        /////|//////////////////
+         !    nib  ----f----v----f----v---   jpjnob
+         !             |         |       
+         !      nibm-- u -- T -- u -- T --   jpjnob
+         !             |         |            
+         !   nibm  ----f----v----f----v---  jpjnob-1
+         !             |         |      
+         !     nibm2-- u -- T -- T -- T --  jpjnob-1
+         !             |         |    
+         !   nibm2 ----f----v----f----v---  jpjnob-2
+         !             |         |
+         !
+         ! ... radiative conditions + relaxation toward a climatology
+         ! ... the phase velocity is taken as the normal phase velocity of the tangen-
+         ! ... tial velocity (here un), which has been saved in (u_cynbnd)
+         ! ... jpjnob+1,(jpindp1, jpinfm1)
+         DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         ! ... j-phase speed ratio (from averaged of vtnbnd)
+         !        (bounded by 1)
+                  z05cx = ( 0.5 * ( u_cynbnd(ji,jk) + u_cynbnd(ji-1,jk) ) ) / e2t(ji,jj-1)
+                  z05cx = min( z05cx, 1. )
+         ! ... z05cx=< 0, inflow  zin=0, ztau=1    
+         !           > 0, outflow zin=1, ztau=rtaun
+                  zin = sign( 1., z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+         ! ... for inflow rtaunin is used for relaxation coefficient else rtaun
+                  ztau = (1.-zin ) * rtaunin + zin * rtaun
+                  z05cx = z05cx * zin
+         ! ... update tsa with radiative or climatological (t, s)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) +             &
+                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) &
+                                 / (1. + z05cx)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) +             &
+                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         &
+                                 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx              &
+                                 * snbnd(ji,jk,nibm,nit ) + ztau * sfon (ji,jk) ) &
+                                 / (1. + z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF
+
+   END SUBROUTINE obc_tra_north
+
+
+   SUBROUTINE obc_tra_south ( kt )
+      !!------------------------------------------------------------------------------
+      !!                ***  SUBROUTINE obc_tra_south  ***
+      !!     
+      !! ** Purpose :
+      !!      Apply the radiation algorithm on south OBC tracers tsa using the 
+      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module
+      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC
+      !!
+      !!  History :
+      !!         ! 95-03 (J.-M. Molines) Original from SPEM
+      !!         ! 97-07 (G. Madec, J.-M. Molines) additions
+      !!         ! 97-12 (M. Imbard) Mpp adaptation
+      !!         ! 00-06 (J.-M. Molines) 
+      !!    8.5  ! 02-10 (C. Talandier, A-M Treguier) F90
+      !!------------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt
+
+      !! * Local declaration
+      INTEGER ::   ji, jj, jk      ! dummy loop indices
+      REAL(wp) ::   z05cx, ztau, zin
+      !!------------------------------------------------------------------------------
+
+      ! 1. First three time steps and more if lfbcsouth is .TRUE.
+      !    In that case open boundary conditions are FIXED.
+      ! --------------------------------------------------------
+
+      IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN
+
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) + &
+                                        tsmsk(ji,jk) * tfos(ji,jk)
+                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) + &
+                                        tsmsk(ji,jk) * sfos(ji,jk)
+               END DO
+            END DO
+         END DO
+
+      ELSE
+
+      ! 2. Beyond the fourth time step if lfbcsouth is .FALSE.
+      ! -------------------------------------------------------
+          
+         ! Temperature and salinity radiation
+         ! ----------------------------------
+         !
+         !           ji-1   ji   ji   ji +1
+         !             |         |
+         !   nibm2 ----f----v----f----v---   jpjsob+2
+         !             |         |       
+         !   nibm2 --  u -- T -- u -- T --   jpjsob+2
+         !             |         |            
+         !   nibm  ----f----v----f----v---   jpjsob+1
+         !             |         |      
+         !    nibm --  u -- T -- T -- T --   jpjsob+1
+         !             |         |    
+         !   nib  -----f----v----f----v---   jpjsob
+         !       //////|/////////|//////// 
+         !    nib //// u // T // u // T //   jpjsob 
+         !
+         !... radiative conditions + relaxation toward a climatology
+         !... the phase velocity is taken as the phase velocity of the tangen-
+         !... tial velocity (here un), which has been saved in (u_cysbnd)
+         !... jpjsob,(jpisdp1, jpisfm1)
+         DO jj = fs_njs0, fs_njs1  ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+         !... j-phase speed ratio (from averaged of u_cysbnd)
+         !       (bounded by 1)
+                  z05cx = ( 0.5 * ( u_cysbnd(ji,jk) + u_cysbnd(ji-1,jk) ) ) / e2t(ji,jj+1)
+                  z05cx = max( z05cx, -1. )
+         !... z05cx > 0, inflow  zin=0, ztau=1
+         !          < 0, outflow zin=1, ztau=rtaus
+                  zin = sign( 1., -1.* z05cx )
+                  zin = 0.5*( zin + abs(zin) )
+                  ztau = (1.-zin ) * rtausin + zin * rtaus
+                  z05cx = z05cx * zin
+
+         !... update tsa with radiative or climatological (t, s)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) +             &
+                                 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         &
+                                 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) &
+                                 / (1. - z05cx)
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) +             &
+                                 tsmsk(ji,jk) * (  ( 1. + z05cx - ztau )        &
+                                 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx              &
+                                 * ssbnd(ji,jk,nibm,nit ) + ztau * sfos (ji,jk) ) &
+                                 / (1. - z05cx)
+               END DO
+            END DO
+         END DO
+
+      END IF   
+
+   END SUBROUTINE obc_tra_south
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!   Default option                                                    Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_tra      ! Empty routine
+   END SUBROUTINE obc_tra
+#endif
+
+   !!=================================================================================
+END MODULE obctra
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBC/obcvol.F90	(revision 3437)
@@ -0,0 +1,288 @@
+MODULE obcvol
+   !!=================================================================================
+   !!                       ***  MODULE  obcvol  ***
+   !! Ocean dynamic :  Volume constraint when OBC and Free surface are used
+   !!=================================================================================
+#if   defined key_obc   &&   ! defined key_vvl
+   !!---------------------------------------------------------------------------------
+   !!   'key_obc'               and   NOT                 open boundary conditions
+   !!   'key_vvl'                                         constant volume free surface
+   !!---------------------------------------------------------------------------------
+   !! * Modules used
+   USE oce             ! ocean dynamics and tracers 
+   USE dom_oce         ! ocean space and time domain 
+   USE sbc_oce         ! ocean surface boundary conditions
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE lib_mpp         ! for mppsum
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Accessibility
+   PUBLIC obc_vol        ! routine called by dynspg_flt
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "obc_vectopt_loop_substitute.h90"
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obc_vol ( kt )
+      !!------------------------------------------------------------------------------
+      !!                      ***  ROUTINE obcvol  ***
+      !!
+      !! ** Purpose : 
+      !!      This routine is called in dynspg_flt to control 
+      !!      the volume of the system. A correction velocity is calculated
+      !!      to correct the total transport through the OBC. 
+      !!      The total depth used is constant (H0) to be consistent with the 
+      !!      linear free surface coded in OPA 8.2
+      !!
+      !! ** Method :  
+      !!      The correction velocity (zubtpecor here) is defined calculating
+      !!      the total transport through all open boundaries (trans_obc) minus
+      !!      the cumulate E-P flux (zCflxemp) divided by the total lateral 
+      !!      surface (obcsurftot) of these OBC. 
+      !!
+      !!      zubtpecor = [trans_obc - zCflxemp ]*(1./obcsurftot)
+      !!
+      !!      with zCflxemp => sum of (Evaporation minus Precipitation)
+      !!                       over all the domain in m3/s at each time step.
+      !!
+      !!      zCflxemp < 0 when precipitation dominate
+      !!      zCflxemp > 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 (zCflxemp=0) to calculate the correction velocity. So
+      !!            it will only balance the flux through open boundaries.
+      !!            (set volemp 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 volemp to 1 in tne namelist for this option)
+      !!
+      !! History :
+      !!   8.5  !  02-10 (C. Talandier, A-M. Treguier) Original code
+      !!----------------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+
+      !! * Local declarations
+      INTEGER ::   ji, jj, jk
+      REAL(wp) ::   zubtpecor
+      REAL(wp) ::   zCflxemp
+      REAL(wp) ::   ztransw, ztranse, ztransn, ztranss, ztranst
+      !!-----------------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN 
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'obc_vol : Correction of velocities along OBC'
+         IF(lwp) WRITE(numout,*)'~~~~~~~'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+      ! 1. Calculate the cumulate surface Flux zCflxemp (m3/s) over all the domain.
+      ! ---------------------------------------------------------------------------
+
+      zCflxemp = SUM ( ( emp(:,:)-rnf(:,:) )*obctmsk(:,:)* e1t(:,:) * e2t(:,:)  / rau0 ) 
+
+      IF( lk_mpp )   CALL mpp_sum( zCflxemp )   ! sum over the global domain
+
+      ! 2. Barotropic velocity for each open boundary
+      ! ---------------------------------------------
+
+      zubtpecor = 0.e0
+
+      ! ... East open boundary
+      IF( lp_obc_east ) THEN                      ! ... Total transport through the East OBC
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * &
+             &     uemsk(jj,jk)*MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+               END DO
+            END DO
+         END DO
+      END IF 
+
+      ! ... West open boundary
+      IF( lp_obc_west ) THEN                      ! ... Total transport through the West OBC
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * &
+             &    uwmsk(jj,jk) *MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+               END DO
+            END DO
+         END DO
+       ENDIF
+
+      ! ... North open boundary
+      IF( lp_obc_north ) THEN                     ! ... Total transport through the North OBC
+         DO jj = fs_njn0, fs_njn1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * &
+             &    vnmsk(ji,jk) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+               END DO
+            END DO
+         END DO
+       ENDIF
+
+      ! ... South open boundary
+      IF( lp_obc_south ) THEN                     ! ... Total transport through the South OBC
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * &
+             &    vsmsk(ji,jk) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+               END DO
+            END DO
+         END DO
+       ENDIF
+
+      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain
+
+
+      ! 3. The normal velocity correction
+      ! ---------------------------------
+      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'obc_vol : time step :', kt
+         IF(lwp) WRITE(numout,*)'~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'          cumulate flux EMP :', zCflxemp,' (m3/s)'
+         IF(lwp) WRITE(numout,*)'          lateral transport :',zubtpecor,'(m3/s)'
+         IF(lwp) WRITE(numout,*)'          net inflow        :',zubtpecor-zCflxemp,'(m3/s)'
+      ENDIF
+
+      zubtpecor = (zubtpecor - zCflxemp*volemp)*(1./obcsurftot)
+
+      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+         IF(lwp) WRITE(numout,*)'          total lateral surface of OBC :',obcsurftot,'(m2)'
+         IF(lwp) WRITE(numout,*)'          correction velocity zubtpecor :',zubtpecor,'(m/s)'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+      ! 4. Correction of the total velocity on each open 
+      !    boundary to respect the mass flux conservation
+      ! -------------------------------------------------
+
+      ztranse = 0.e0   ; ztransw = 0.e0 ; ztransn = 0.e0 ; ztranss = 0.e0
+      ztranst = 0.e0  ! total
+
+      IF( lp_obc_west ) THEN
+         ! ... correction of the west velocity
+         DO ji = fs_niw0, fs_niw1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) - zubtpecor*uwmsk(jj,jk)
+                  ztransw= ztransw + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uwmsk(jj,jk) * &
+             &    MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+               END DO
+            END DO
+         END DO
+
+         IF( lk_mpp )   CALL mpp_sum( ztransw )   ! sum over the global domain
+
+         IF( lwp .AND. MOD( kt, nwrite ) == 0)  WRITE(numout,*)'          West OB transport ztransw :', ztransw,'(m3/s)'
+      END IF 
+
+      IF( lp_obc_east ) THEN
+
+         ! ... correction of the east velocity
+         DO ji = fs_nie0, fs_nie1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO jj = 1, jpj
+                  ua(ji,jj,jk) = ua(ji,jj,jk) + zubtpecor*uemsk(jj,jk)
+                  ztranse= ztranse + ua(ji,jj,jk)*fse3u(ji,jj,jk)*e2u(ji,jj)*uemsk(jj,jk) * &
+            &     MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) )
+               END DO
+            END DO
+         END DO
+
+         IF( lk_mpp )   CALL mpp_sum( ztranse )   ! sum over the global domain
+
+         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          East OB transport ztranse :', ztranse,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      IF( lp_obc_north ) THEN
+
+         ! ... correction of the north velocity
+         DO jj = fs_njn0, fs_njn1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji =  1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) + zubtpecor*vnmsk(ji,jk)
+                  ztransn= ztransn + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vnmsk(ji,jk) * &
+           &      MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztransn )   ! sum over the global domain
+
+         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          North OB transport ztransn :', ztransn,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      IF( lp_obc_south ) THEN
+
+         ! ... correction of the south velocity
+         DO jj = fs_njs0, fs_njs1 ! Vector opt.
+            DO jk = 1, jpkm1
+               DO ji =  1, jpi
+                  va(ji,jj,jk) = va(ji,jj,jk) - zubtpecor*vsmsk(ji,jk)
+                  ztranss= ztranss + va(ji,jj,jk)*fse3v(ji,jj,jk)*e1v(ji,jj)*vsmsk(ji,jk) * &
+            &     MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) )
+               END DO
+            END DO
+         END DO
+         IF( lk_mpp )   CALL mpp_sum( ztranss )   ! sum over the global domain
+
+         IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+            IF(lwp) WRITE(numout,*)'          South OB transport ztranss :', ztranss,'(m3/s)'
+         END IF 
+
+      END IF 
+
+      ! 5. Check the cumulate transport through OBC
+      !    once barotropic velocities corrected
+      ! -------------------------------------------
+
+
+      IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN
+         ztranst = ztransw - ztranse + ztranss - ztransn
+         IF(lwp) WRITE(numout,*)'        '
+         IF(lwp) WRITE(numout,*)'          Cumulate transport ztranst =', ztranst,'(m3/s)'
+         IF(lwp) WRITE(numout,*)'          Balance  =', ztranst - zCflxemp ,'(m3/s)'
+         IF(lwp) WRITE(numout,*)'        '
+      END IF 
+
+   END SUBROUTINE obc_vol
+
+#else
+   !!---------------------------------------------------------------------------------
+   !!  Default option :                                                   Empty module
+   !!---------------------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE obc_vol        ! Empty routine
+   END SUBROUTINE obc_vol
+#endif
+
+   !!=================================================================================
+END MODULE obcvol
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90	(revision 3437)
@@ -0,0 +1,43 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ddatetoymdhms( ddate, kyea, kmon, kday, khou, kmin, ksec )
+      !!----------------------------------------------------------------------
+      !!
+      !!                    *** ROUTINE ddatetoymdhms ***
+      !!
+      !! ** Purpose : Convert YYYYMMDD.hhmmss to components
+      !!
+      !! ** Method  :
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      REAL(dp), INTENT(IN) :: ddate
+      INTEGER, INTENT(OUT) :: kyea
+      INTEGER, INTENT(OUT) :: kmon
+      INTEGER, INTENT(OUT) :: kday
+      INTEGER, INTENT(OUT) :: khou
+      INTEGER, INTENT(OUT) :: kmin
+      INTEGER, INTENT(OUT) :: ksec
+      !! * Local declarations
+      INTEGER :: iyymmdd
+      INTEGER :: ihhmmss
+      
+      iyymmdd = INT( ddate )
+      ihhmmss = INT( ( ddate - iyymmdd ) * 1000000 )
+      kyea = iyymmdd/10000
+      kmon = iyymmdd / 100 - 100 * kyea
+      kday = MOD( iyymmdd, 100 )
+      khou = ihhmmss/10000
+      kmin = ihhmmss / 100 - 100 * khou
+      ksec = MOD( ihhmmss, 100 )
+      
+   END SUBROUTINE ddatetoymdhms
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90	(revision 3437)
@@ -0,0 +1,1571 @@
+MODULE diaobs
+   !!======================================================================
+   !!                       ***  MODULE diaobs  ***
+   !! Observation diagnostics: Computation of the misfit between data and
+   !!                          their model equivalent 
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_diaobs' : Switch on the observation diagnostic computation
+   !!----------------------------------------------------------------------
+   !!   dia_obs_init : Reading and prepare observations
+   !!   dia_obs      : Compute model equivalent to observations
+   !!   dia_obs_wri  : Write observational diagnostics
+   !!   ini_date     : Compute the initial date YYYYMMDD.HHMMSS
+   !!   fin_date     : Compute the final date YYYYMMDD.HHMMSS
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE 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 observations (Coriolis)
+   USE obs_read_sla             ! Reading and allocation of SLA observations  
+   USE obs_read_sst             ! Reading and allocation of SST observations  
+   USE obs_readmdt              ! Reading and allocation of MDT for SLA.
+   USE obs_read_seaice          ! Reading and allocation of Sea Ice observations  
+   USE obs_read_vel             ! Reading and allocation of velocity component observations
+   USE obs_prep                 ! Preparation of obs. (grid search etc).
+   USE obs_oper                 ! Observation operators
+   USE obs_write                ! Writing of observation related diagnostics
+   USE obs_grid                 ! Grid searching
+   USE obs_read_altbias         ! Bias treatment for altimeter
+   USE obs_profiles_def         ! Profile data definitions
+   USE obs_profiles             ! Profile data storage
+   USE obs_surf_def             ! Surface data definitions
+   USE obs_sla                  ! SLA data storage
+   USE obs_sst                  ! SST data storage
+   USE obs_seaice               ! Sea Ice data storage
+   USE obs_types                ! Definitions for observation types
+   USE mpp_map                  ! MPP mapping
+   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
+
+   !! * Shared Module variables
+   LOGICAL, PUBLIC, PARAMETER :: &
+#if defined key_diaobs
+      & lk_diaobs = .TRUE.   !: Logical switch for observation diangostics
+#else
+      & lk_diaobs = .FALSE.  !: Logical switch for observation diangostics
+#endif
+
+   !! * Module variables
+   LOGICAL, PUBLIC :: ln_t3d         !: Logical switch for temperature profiles
+   LOGICAL, PUBLIC :: ln_s3d         !: Logical switch for salinity profiles
+   LOGICAL, PUBLIC :: ln_ena         !: Logical switch for the ENACT data set
+   LOGICAL, PUBLIC :: ln_cor         !: Logical switch for the Coriolis data set
+   LOGICAL, PUBLIC :: ln_profb       !: Logical switch for profile feedback datafiles
+   LOGICAL, PUBLIC :: ln_sla         !: Logical switch for sea level anomalies 
+   LOGICAL, PUBLIC :: ln_sladt       !: Logical switch for SLA from AVISO files
+   LOGICAL, PUBLIC :: ln_slafb       !: Logical switch for SLA from feedback files
+   LOGICAL, PUBLIC :: ln_sst         !: Logical switch for sea surface temperature
+   LOGICAL, PUBLIC :: ln_reysst      !: Logical switch for Reynolds sea surface temperature
+   LOGICAL, PUBLIC :: ln_ghrsst      !: Logical switch for GHRSST data
+   LOGICAL, PUBLIC :: ln_sstfb       !: Logical switch for SST from feedback files
+   LOGICAL, PUBLIC :: ln_seaice      !: Logical switch for sea ice concentration
+   LOGICAL, PUBLIC :: ln_vel3d       !: Logical switch for velocity component (u,v) observations
+   LOGICAL, PUBLIC :: ln_velavcur    !: Logical switch for raw daily averaged netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velhrcur    !: Logical switch for raw high freq netCDF current meter vel. data 
+   LOGICAL, PUBLIC :: ln_velavadcp   !: Logical switch for raw daily averaged netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velhradcp   !: Logical switch for raw high freq netCDF ADCP vel. data 
+   LOGICAL, PUBLIC :: ln_velfb       !: Logical switch for velocities from feedback files
+   LOGICAL, PUBLIC :: ln_ssh         !: Logical switch for sea surface height
+   LOGICAL, PUBLIC :: ln_sss         !: Logical switch for sea surface salinity
+   LOGICAL, PUBLIC :: ln_nea         !: Remove observations near land
+   LOGICAL, PUBLIC :: ln_altbias     !: Logical switch for altimeter bias  
+   LOGICAL, PUBLIC :: ln_ignmis      !: Logical switch for ignoring missing files
+   LOGICAL, PUBLIC :: ln_s_at_t      !: Logical switch to compute model S at T observations
+
+   REAL(KIND=dp), PUBLIC :: dobsini   !: Observation window start date YYYYMMDD.HHMMSS
+   REAL(KIND=dp), PUBLIC :: dobsend   !: Observation window end date YYYYMMDD.HHMMSS
+  
+   INTEGER, PUBLIC :: n1dint       !: Vertical interpolation method
+   INTEGER, PUBLIC :: n2dint       !: Horizontal interpolation method 
+
+   INTEGER, DIMENSION(imaxavtypes) :: &
+      & endailyavtypes !: ENACT data types which are daily average
+
+   INTEGER, PARAMETER :: MaxNumFiles = 1000
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_profb_ena, & !: Is the feedback files from ENACT data ?
+   !                    !: If so use endailyavtypes
+      & ln_profb_enatim !: Change tim for 820 enact data set.
+   
+   LOGICAL, DIMENSION(MaxNumFiles) :: &
+      & ln_velfb_av   !: Is the velocity feedback files daily average?
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_enact     !: Profile data is ENACT so use endailyavtypes
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: &
+      & ld_velav     !: Velocity data is daily averaged
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE dia_obs_init
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs_init  ***
+      !!          
+      !! ** Purpose : Initialize and read observations
+      !!
+      !! ** Method  : Read the namelist and call reading routines
+      !!
+      !! ** Action  : Read the namelist and call reading routines
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (A. Weaver) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning and add controls
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+      !! * Local declarations
+      CHARACTER(len=128) :: enactfiles(MaxNumFiles)
+      CHARACTER(len=128) :: coriofiles(MaxNumFiles)
+      CHARACTER(len=128) :: profbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: sstfiles(MaxNumFiles)      
+      CHARACTER(len=128) :: sstfbfiles(MaxNumFiles) 
+      CHARACTER(len=128) :: slafilesact(MaxNumFiles)      
+      CHARACTER(len=128) :: slafilespas(MaxNumFiles)      
+      CHARACTER(len=128) :: slafbfiles(MaxNumFiles)
+      CHARACTER(len=128) :: seaicefiles(MaxNumFiles)           
+      CHARACTER(len=128) :: velcurfiles(MaxNumFiles)  
+      CHARACTER(len=128) :: veladcpfiles(MaxNumFiles)    
+      CHARACTER(len=128) :: velavcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhrcurfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velavadcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velhradcpfiles(MaxNumFiles)
+      CHARACTER(len=128) :: velfbfiles(MaxNumFiles)
+      CHARACTER(LEN=128) :: reysstname
+      CHARACTER(LEN=12)  :: reysstfmt
+      CHARACTER(LEN=128) :: bias_file
+      CHARACTER(LEN=20)  :: datestr=" ", timestr=" "
+      NAMELIST/namobs/ln_ena, ln_cor, ln_profb, ln_t3d, ln_s3d,       &
+         &            ln_sla, ln_sladt, ln_slafb,                     &
+         &            ln_ssh, ln_sst, ln_sstfb, ln_sss, ln_nea,       &
+         &            enactfiles, coriofiles, profbfiles,             &
+         &            slafilesact, slafilespas, slafbfiles,           &
+         &            sstfiles, sstfbfiles,                           &
+         &            ln_seaice, seaicefiles,                         &
+         &            dobsini, dobsend, n1dint, n2dint,               &
+         &            nmsshc, mdtcorr, mdtcutoff,                     &
+         &            ln_reysst, ln_ghrsst, reysstname, reysstfmt,    &
+         &            ln_grid_search_lookup,                          &
+         &            grid_search_file, grid_search_res,              &
+         &            ln_grid_global, bias_file, ln_altbias,          &
+         &            endailyavtypes, ln_s_at_t, ln_profb_ena,        &
+         &            ln_vel3d, ln_velavcur, velavcurfiles,           &
+         &            ln_velhrcur, velhrcurfiles,                     &
+         &            ln_velavadcp, velavadcpfiles,                   &
+         &            ln_velhradcp, velhradcpfiles,                   &
+         &            ln_velfb, velfbfiles, ln_velfb_av,              &
+         &            ln_profb_enatim, ln_ignmis
+
+      INTEGER :: jprofset
+      INTEGER :: jveloset
+      INTEGER :: jvar
+      INTEGER :: jnumenact
+      INTEGER :: jnumcorio
+      INTEGER :: jnumprofb
+      INTEGER :: jnumslaact
+      INTEGER :: jnumslapas
+      INTEGER :: jnumslafb
+      INTEGER :: jnumsst
+      INTEGER :: jnumsstfb
+      INTEGER :: jnumseaice
+      INTEGER :: jnumvelavcur
+      INTEGER :: jnumvelhrcur  
+      INTEGER :: jnumvelavadcp
+      INTEGER :: jnumvelhradcp   
+      INTEGER :: jnumvelfb
+      INTEGER :: ji
+      INTEGER :: jset
+      LOGICAL :: lmask(MaxNumFiles), ll_u3d, ll_v3d
+
+      !-----------------------------------------------------------------------
+      ! Read namelist parameters
+      !-----------------------------------------------------------------------
+      ! default values already set except:
+
+      ln_t3d = .FALSE.
+      ln_s3d = .FALSE.
+      ln_vel3d = .FALSE.
+      ln_sla = .FALSE.
+      ln_altbias = .FALSE.
+      ln_ssh = .FALSE.
+      ln_sst = .FALSE.
+      ln_seaice = .FALSE.
+      ln_reysst = .FALSE.
+      ln_ghrsst = .FALSE.
+      ln_sss = .FALSE.
+      ln_profb = .FALSE.
+      ln_ena = .TRUE.
+      ln_cor = .FALSE.
+      ln_sladt = .TRUE.
+      ln_slafb = .FALSE.
+      ln_sstfb = .FALSE.
+      ln_velavcur = .FALSE.
+      ln_velhrcur = .FALSE.
+      ln_velavadcp = .FALSE.
+      ln_velhradcp = .FALSE.
+      ln_velfb = .FALSE.
+      ln_nea = .FALSE.
+      ln_grid_search_lookup = .FALSE.
+      ln_grid_global = .FALSE.
+      ln_s_at_t = .TRUE.
+      grid_search_file = 'xypos'
+      bias_file='bias.nc'
+      enactfiles(:) = ''
+      coriofiles(:) = ''
+      profbfiles(:) = ''
+      slafilesact(:) = ''
+      slafilespas(:) = ''
+      slafbfiles(:) = ''
+      sstfiles(:)   = ''
+      sstfbfiles(:) = ''
+      seaicefiles(:) = ''
+      velcurfiles(:) = ''
+      veladcpfiles(:) = ''
+      velavcurfiles(:) = ''
+      velhrcurfiles(:) = ''
+      velavadcpfiles(:) = ''
+      velhradcpfiles(:) = ''
+      velfbfiles(:) = ''
+      reysstname = 'sst_yYYYYmMM.nc'
+      reysstfmt = 'monthly'
+      endailyavtypes(:) = -1
+      endailyavtypes(1) = 820
+      ln_profb_ena(:) = .FALSE.
+      ln_profb_enatim(:) = .TRUE.
+      ln_velfb_av(:) = .FALSE.
+      ln_ignmis = .FALSE.
+      CALL ini_date( dobsini )
+      CALL fin_date( dobsend )
+      n1dint = 1
+      n2dint = 3
+
+      ! Read Namelist namobs : control observation diagnostics
+      REWIND( numnam )
+      READ  ( numnam, namobs )
+
+      ! Count number of files for each type
+      IF (ln_ena) THEN
+         lmask(:) = .FALSE.
+         WHERE (enactfiles(:) /= '') lmask(:) = .TRUE.
+         jnumenact = COUNT(lmask)
+      ENDIF
+      IF (ln_cor) THEN
+         lmask(:) = .FALSE.
+         WHERE (coriofiles(:) /= '') lmask(:) = .TRUE.
+         jnumcorio = COUNT(lmask)
+      ENDIF
+      IF (ln_profb) THEN
+         lmask(:) = .FALSE.
+         WHERE (profbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumprofb = COUNT(lmask)
+      ENDIF
+      IF (ln_sladt) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafilesact(:) /= '') lmask(:) = .TRUE.
+         jnumslaact = COUNT(lmask)
+         lmask(:) = .FALSE.
+         WHERE (slafilespas(:) /= '') lmask(:) = .TRUE.
+         jnumslapas = COUNT(lmask)
+      ENDIF
+      IF (ln_slafb) THEN
+         lmask(:) = .FALSE.
+         WHERE (slafbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumslafb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_ghrsst) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsst = COUNT(lmask)
+      ENDIF      
+      IF (ln_sstfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (sstfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumsstfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      IF (ln_seaice) THEN
+         lmask(:) = .FALSE.
+         WHERE (seaicefiles(:) /= '') lmask(:) = .TRUE.
+         jnumseaice = COUNT(lmask)
+      ENDIF
+      IF (ln_velavcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velhrcur) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhrcurfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhrcur = COUNT(lmask)
+      ENDIF
+      IF (ln_velavadcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velavadcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelavadcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velhradcp) THEN
+         lmask(:) = .FALSE.
+         WHERE (velhradcpfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelhradcp = COUNT(lmask)
+      ENDIF
+      IF (ln_velfb) THEN
+         lmask(:) = .FALSE.
+         WHERE (velfbfiles(:) /= '') lmask(:) = .TRUE.
+         jnumvelfb = COUNT(lmask)
+         lmask(:) = .FALSE.
+      ENDIF
+      
+      ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dia_obs_init : Observation diagnostic initialization'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '          Namelist namobs : set observation diagnostic parameters' 
+         WRITE(numout,*) '             Logical switch for T profile observations          ln_t3d = ', ln_t3d
+         WRITE(numout,*) '             Logical switch for S profile observations          ln_s3d = ', ln_s3d
+         WRITE(numout,*) '             Logical switch for ENACT insitu data set           ln_ena = ', ln_ena
+         WRITE(numout,*) '             Logical switch for Coriolis insitu data set        ln_cor = ', ln_cor
+         WRITE(numout,*) '             Logical switch for feedback insitu data set      ln_profb = ', ln_profb
+         WRITE(numout,*) '             Logical switch for SLA observations                ln_sla = ', ln_sla
+         WRITE(numout,*) '             Logical switch for AVISO SLA data                ln_sladt = ', ln_sladt
+         WRITE(numout,*) '             Logical switch for feedback SLA data             ln_slafb = ', ln_slafb
+         WRITE(numout,*) '             Logical switch for SSH observations                ln_ssh = ', ln_ssh
+         WRITE(numout,*) '             Logical switch for SST observations                ln_sst = ', ln_sst
+         WRITE(numout,*) '             Logical switch for Reynolds observations        ln_reysst = ', ln_reysst    
+         WRITE(numout,*) '             Logical switch for GHRSST observations          ln_ghrsst = ', ln_ghrsst
+         WRITE(numout,*) '             Logical switch for feedback SST data             ln_sstfb = ', ln_sstfb
+         WRITE(numout,*) '             Logical switch for SSS observations                ln_sss = ', ln_sss
+         WRITE(numout,*) '             Logical switch for Sea Ice observations         ln_seaice = ', ln_seaice
+         WRITE(numout,*) '             Logical switch for velocity observations         ln_vel3d = ', ln_vel3d
+         WRITE(numout,*) '             Logical switch for velocity daily av. cur.    ln_velavcur = ', ln_velavcur
+         WRITE(numout,*) '             Logical switch for velocity high freq. cur.   ln_velhrcur = ', ln_velhrcur
+         WRITE(numout,*) '             Logical switch for velocity daily av. ADCP   ln_velavadcp = ', ln_velavadcp
+         WRITE(numout,*) '             Logical switch for velocity high freq. ADCP  ln_velhradcp = ', ln_velhradcp
+         WRITE(numout,*) '             Logical switch for feedback velocity data        ln_velfb = ', ln_velfb
+         WRITE(numout,*) '             Global distribtion of observations         ln_grid_global = ',ln_grid_global
+         WRITE(numout,*) &
+   '             Logical switch for obs grid search w/lookup table  ln_grid_search_lookup = ',ln_grid_search_lookup
+         IF (ln_grid_search_lookup) &
+            WRITE(numout,*) '             Grid search lookup file header       grid_search_file = ', grid_search_file
+         IF (ln_ena) THEN
+            DO ji = 1, jnumenact
+               WRITE(numout,'(1X,2A)') '             ENACT input observation file name          enactfiles = ', &
+                  TRIM(enactfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_cor) THEN
+            DO ji = 1, jnumcorio
+               WRITE(numout,'(1X,2A)') '             Coriolis input observation file name       coriofiles = ', &
+                  TRIM(coriofiles(ji))
+            END DO
+         ENDIF
+         IF (ln_profb) THEN
+            DO ji = 1, jnumprofb
+               IF (ln_profb_ena(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '       Enact feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Feedback input observation file name       profbfiles = ', &
+                     TRIM(profbfiles(ji))
+               ENDIF
+               WRITE(numout,'(1X,2A)') '       Enact feedback input time setting switch    ln_profb_enatim = ', ln_profb_enatim(ji)
+            END DO
+         ENDIF
+         IF (ln_sladt) THEN
+            DO ji = 1, jnumslaact
+               WRITE(numout,'(1X,2A)') '             Active SLA input observation file name    slafilesact = ', &
+                  TRIM(slafilesact(ji))
+            END DO
+            DO ji = 1, jnumslapas
+               WRITE(numout,'(1X,2A)') '             Passive SLA input observation file name   slafilespas = ', &
+                  TRIM(slafilespas(ji))
+            END DO
+         ENDIF
+         IF (ln_slafb) THEN
+            DO ji = 1, jnumslafb
+               WRITE(numout,'(1X,2A)') '             Feedback SLA input observation file name   slafbfiles = ', &
+                  TRIM(slafbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_ghrsst) THEN
+            DO ji = 1, jnumsst
+               WRITE(numout,'(1X,2A)') '             GHRSST input observation file name           sstfiles = ', &
+                  TRIM(sstfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_sstfb) THEN
+            DO ji = 1, jnumsstfb
+               WRITE(numout,'(1X,2A)') '             Feedback SST input observation file name   sstfbfiles = ', &
+                  TRIM(sstfbfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_seaice) THEN
+            DO ji = 1, jnumseaice
+               WRITE(numout,'(1X,2A)') '             Sea Ice input observation file name       seaicefiles = ', &
+                  TRIM(seaicefiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavcur) THEN
+            DO ji = 1, jnumvelavcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. daily av. input file name     velavcurfiles = ', &
+                  TRIM(velavcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhrcur) THEN
+            DO ji = 1, jnumvelhrcur
+               WRITE(numout,'(1X,2A)') '             Vel. cur. high freq. input file name    velhvcurfiles = ', &
+                  TRIM(velhrcurfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velavadcp) THEN
+            DO ji = 1, jnumvelavadcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP daily av. input file name    velavadcpfiles = ', &
+                  TRIM(velavadcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velhradcp) THEN
+            DO ji = 1, jnumvelhradcp
+               WRITE(numout,'(1X,2A)') '             Vel. ADCP high freq. input file name   velhvadcpfiles = ', &
+                  TRIM(velhradcpfiles(ji))
+            END DO
+         ENDIF
+         IF (ln_velfb) THEN
+            DO ji = 1, jnumvelfb
+               IF (ln_velfb_av(ji)) THEN
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback daily av. input file name    velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ELSE
+                  WRITE(numout,'(1X,2A)') '             Vel. feedback input observation file name  velfbfiles = ', &
+                     TRIM(velfbfiles(ji))
+               ENDIF
+            END DO
+         ENDIF
+         WRITE(numout,*) '             Initial date in window YYYYMMDD.HHMMSS        dobsini = ', dobsini
+         WRITE(numout,*) '             Final date in window YYYYMMDD.HHMMSS          dobsend = ', dobsend
+         WRITE(numout,*) '             Type of vertical interpolation method          n1dint = ', n1dint
+         WRITE(numout,*) '             Type of horizontal interpolation method        n2dint = ', n2dint
+         WRITE(numout,*) '             Rejection of observations near land swithch    ln_nea = ', ln_nea
+         WRITE(numout,*) '             MSSH correction scheme                         nmsshc = ', nmsshc
+         WRITE(numout,*) '             MDT  correction                               mdtcorr = ', mdtcorr
+         WRITE(numout,*) '             MDT cutoff for computed correction          mdtcutoff = ', mdtcutoff
+         WRITE(numout,*) '             Logical switch for alt bias                ln_altbias = ', ln_altbias
+         WRITE(numout,*) '             Logical switch for ignoring missing files   ln_ignmis = ', ln_ignmis
+         WRITE(numout,*) '             ENACT daily average types                             = ',endailyavtypes
+
+      ENDIF
+      
+      IF ( ln_vel3d .AND. ( .NOT. ln_grid_global ) ) THEN
+         CALL ctl_stop( 'Velocity data only works with ln_grid_global=.true.' )
+         RETURN
+      ENDIF
+
+      CALL obs_typ_init
+      
+      CALL mppmap_init
+      
+      ! Parameter control
+#if defined key_diaobs
+      IF ( ( .NOT. ln_t3d ).AND.( .NOT. ln_s3d ).AND.( .NOT. ln_sla ).AND. &
+         & ( .NOT. ln_vel3d ).AND.                                         &
+         & ( .NOT. ln_ssh ).AND.( .NOT. ln_sst ).AND.( .NOT. ln_sss ).AND. &
+         & ( .NOT. ln_seaice ).AND.( .NOT. ln_vel3d ) ) THEN
+         IF(lwp) WRITE(numout,cform_war)
+         IF(lwp) WRITE(numout,*) ' key_diaobs is activated but logical flags', &
+            &                    ' ln_t3d, ln_s3d, ln_sla, ln_ssh, ln_sst, ln_sss, ln_seaice, ln_vel3d are all set to .FALSE.'
+         nwarn = nwarn + 1
+      ENDIF
+#endif
+
+      CALL obs_grid_setup( )
+      IF ( ( n1dint < 0 ).OR.( n1dint > 1 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of vertical (1D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+      IF ( ( n2dint < 0 ).OR.( n2dint > 4 ) ) THEN
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) ' Choice of horizontal (2D) interpolation method', &
+            &                    ' is not available'
+         nstop = nstop + 1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Depending on switches read the various observation types
+      !-----------------------------------------------------------------------
+      !  - Temperature/salinity profiles
+
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Set the number of variables for profiles to 2 (T and S)
+         nprofvars = 2
+         ! Set the number of extra variables for profiles to 1 (insitu temp).
+         nprofextr = 1
+
+         ! Count how may insitu data sets we have and allocate data.
+         jprofset = 0
+         IF ( ln_ena ) jprofset = jprofset + 1
+         IF ( ln_cor ) jprofset = jprofset + 1
+         IF ( ln_profb ) jprofset = jprofset + jnumprofb
+         nprofsets = jprofset
+         IF ( nprofsets > 0 ) THEN
+            ALLOCATE(ld_enact(nprofsets))
+            ALLOCATE(profdata(nprofsets))
+            ALLOCATE(prodatqc(nprofsets))
+         ENDIF
+
+         jprofset = 0
+          
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+
+            jprofset = jprofset + 1
+            
+            ld_enact(jprofset) = .TRUE.
+
+            CALL obs_rea_pro_dri( 1, profdata(jprofset),          &
+               &                  jnumenact, enactfiles(1:jnumenact), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .TRUE., .FALSE., &
+               &                  kdailyavtypes = endailyavtypes )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+               &              ln_t3d, ln_s3d, ln_nea, &
+               &              kdailyavtypes=endailyavtypes )
+            
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+           
+            jprofset = jprofset + 1
+
+            ld_enact(jprofset) = .FALSE.
+
+            CALL obs_rea_pro_dri( 2, profdata(jprofset),          &
+               &                  jnumcorio, coriofiles(1:jnumcorio), &
+               &                  nprofvars, nprofextr,        &
+               &                  nitend-nit000+2,             &
+               &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+               &                  ln_ignmis, ln_s_at_t, .FALSE., .FALSE. )
+
+            DO jvar = 1, 2
+
+               CALL obs_prof_staend( profdata(jprofset), jvar )
+
+            END DO
+
+            CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                 &            ln_t3d, ln_s3d, ln_nea )
+            
+         ENDIF
+ 
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+           
+            DO jset = 1, jnumprofb
+               
+               jprofset = jprofset + 1
+               ld_enact (jprofset) = ln_profb_ena(jset)
+
+               CALL obs_rea_pro_dri( 0, profdata(jprofset),          &
+                  &                  1, profbfiles(jset:jset), &
+                  &                  nprofvars, nprofextr,        &
+                  &                  nitend-nit000+2,             &
+                  &                  dobsini, dobsend, ln_t3d, ln_s3d, &
+                  &                  ln_ignmis, ln_s_at_t, &
+                  &                  ld_enact(jprofset).AND.&
+                  &                  ln_profb_enatim(jset), &
+                  &                  .FALSE., kdailyavtypes = endailyavtypes )
+               
+               DO jvar = 1, 2
+                  
+                  CALL obs_prof_staend( profdata(jprofset), jvar )
+                  
+               END DO
+               
+               IF ( ld_enact(jprofset) ) THEN
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea, &
+                     &              kdailyavtypes = endailyavtypes )
+               ELSE
+                  CALL obs_pre_pro( profdata(jprofset), prodatqc(jprofset),   &
+                     &              ln_t3d, ln_s3d, ln_nea )
+               ENDIF
+               
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea level anomalies
+      IF ( ln_sla ) THEN
+        ! Set the number of variables for sla to 1
+         nslavars = 1
+
+         ! Set the number of extra variables for sla to 2
+         nslaextr = 2
+         
+         ! Set the number of sla data sets to 2
+         nslasets = 0
+         IF ( ln_sladt ) THEN
+            nslasets = nslasets + 2
+         ENDIF
+         IF ( ln_slafb ) THEN
+            nslasets = nslasets + jnumslafb
+         ENDIF
+         
+         ALLOCATE(sladata(nslasets))
+         ALLOCATE(sladatqc(nslasets))
+         sladata(:)%nsurf=0
+         sladatqc(:)%nsurf=0
+
+         nslasets = 0
+
+         ! AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+
+            ! Active SLA observations
+            
+            nslasets = nslasets + 1
+            
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslaact, &
+               &              slafilesact(1:jnumslaact), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+            
+            ! Passive SLA observations
+            
+            nslasets = nslasets + 1
+            
+            CALL obs_rea_sla( 1, sladata(nslasets), jnumslapas, &
+               &              slafilespas(1:jnumslapas), &
+               &              nslavars, nslaextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            
+            CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+               &              ln_sla, ln_nea )
+
+         ENDIF
+         
+         ! Feedback SLA data
+
+         IF ( ln_slafb ) THEN
+
+            DO jset = 1, jnumslafb
+            
+               nslasets = nslasets + 1
+            
+               CALL obs_rea_sla( 0, sladata(nslasets), 1, &
+                  &              slafbfiles(jset:jset), &
+                  &              nslavars, nslaextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+               CALL obs_pre_sla( sladata(nslasets), sladatqc(nslasets), &
+                  &              ln_sla, ln_nea )
+
+            END DO               
+
+         ENDIF
+         
+         CALL obs_rea_mdt( nslasets, sladatqc, n2dint )
+            
+         ! read in altimeter bias
+         
+         IF ( ln_altbias ) THEN     
+            CALL obs_rea_altbias ( nslasets, sladatqc, n2dint, bias_file )
+         ENDIF
+     
+      ENDIF
+
+      !  - Sea surface height
+      IF ( ln_ssh ) THEN
+         IF(lwp) WRITE(numout,*) ' SSH currently not available'
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+
+         ! Set the number of variables for sst to 1
+         nsstvars = 1
+
+         ! Set the number of extra variables for sst to 0
+         nsstextr = 0
+
+         nsstsets = 0
+
+         IF (ln_reysst) nsstsets = nsstsets + 1
+         IF (ln_ghrsst) nsstsets = nsstsets + 1
+         IF ( ln_sstfb ) THEN
+            nsstsets = nsstsets + jnumsstfb
+         ENDIF
+
+         ALLOCATE(sstdata(nsstsets))
+         ALLOCATE(sstdatqc(nsstsets))
+         sstdata(:)%nsurf=0
+         sstdatqc(:)%nsurf=0         
+
+         nsstsets = 0
+
+         IF (ln_reysst) THEN
+
+            nsstsets = nsstsets + 1
+
+            CALL obs_rea_sst_rey( reysstname, reysstfmt, sstdata(nsstsets), &
+               &                  nsstvars, nsstextr, &
+               &                  nitend-nit000+2, dobsini, dobsend )
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+        
+        IF (ln_ghrsst) THEN
+        
+            nsstsets = nsstsets + 1
+          
+            CALL obs_rea_sst( 1, sstdata(nsstsets), jnumsst, &
+               &              sstfiles(1:jnumsst), &
+               &              nsstvars, nsstextr, nitend-nit000+2, &
+               &              dobsini, dobsend, ln_ignmis, .FALSE. )
+            CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), ln_sst, &
+               &              ln_nea )
+
+        ENDIF
+               
+         ! Feedback SST data
+
+         IF ( ln_sstfb ) THEN
+
+            DO jset = 1, jnumsstfb
+            
+               nsstsets = nsstsets + 1
+            
+               CALL obs_rea_sst( 0, sstdata(nsstsets), 1, &
+                  &              sstfbfiles(jset:jset), &
+                  &              nsstvars, nsstextr, nitend-nit000+2, &
+                  &              dobsini, dobsend, ln_ignmis, .FALSE. )
+               CALL obs_pre_sst( sstdata(nsstsets), sstdatqc(nsstsets), &
+                  &              ln_sst, ln_nea )
+
+            END DO               
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      
+      IF ( ln_seaice ) THEN
+
+         ! Set the number of variables for seaice to 1
+         nseaicevars = 1
+
+         ! Set the number of extra variables for seaice to 0
+         nseaiceextr = 0
+         
+         ! Set the number of data sets to 1
+         nseaicesets = 1
+
+         ALLOCATE(seaicedata(nseaicesets))
+         ALLOCATE(seaicedatqc(nseaicesets))
+         seaicedata(:)%nsurf=0
+         seaicedatqc(:)%nsurf=0
+
+         CALL obs_rea_seaice( 1, seaicedata(nseaicesets), jnumseaice, &
+            &                 seaicefiles(1:jnumseaice), &
+            &                 nseaicevars, nseaiceextr, nitend-nit000+2, &
+            &                 dobsini, dobsend, ln_ignmis, .FALSE. )
+
+         CALL obs_pre_seaice( seaicedata(nseaicesets), seaicedatqc(nseaicesets), &
+            &                 ln_seaice, ln_nea )
+ 
+      ENDIF
+
+      IF (ln_vel3d) THEN
+
+         ! Set the number of variables for profiles to 2 (U and V)
+         nvelovars = 2
+
+         ! Set the number of extra variables for profiles to 2 to store 
+         ! rotation parameters
+         nveloextr = 2
+
+         jveloset = 0
+         
+         IF ( ln_velavcur ) jveloset = jveloset + 1
+         IF ( ln_velhrcur ) jveloset = jveloset + 1
+         IF ( ln_velavadcp ) jveloset = jveloset + 1
+         IF ( ln_velhradcp ) jveloset = jveloset + 1
+         IF (ln_velfb) jveloset = jveloset + jnumvelfb
+
+         nvelosets = jveloset
+         IF ( nvelosets > 0 ) THEN
+            ALLOCATE( velodata(nvelosets) )
+            ALLOCATE( veldatqc(nvelosets) )
+            ALLOCATE( ld_velav(nvelosets) )
+         ENDIF
+         
+         jveloset = 0
+         
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavcur, &
+               &                  velavcurfiles(1:jnumvelavcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhrcur, &
+               &                  velhrcurfiles(1:jnumvelhrcur), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .TRUE.
+            
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelavadcp, &
+               &                  velavadcpfiles(1:jnumvelavadcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            ld_velav(jveloset) = .FALSE.
+               
+            CALL obs_rea_vel_dri( 1, velodata(jveloset), jnumvelhradcp, &
+               &                  velhradcpfiles(1:jnumvelhradcp), &
+               &                  nvelovars, nveloextr, &
+               &                  nitend-nit000+2,              &
+               &                  dobsini, dobsend, ln_ignmis, &
+               &                  ld_velav(jveloset), &
+               &                  .FALSE. )
+            
+            DO jvar = 1, 2
+               CALL obs_prof_staend( velodata(jveloset), jvar )
+            END DO
+            
+            CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+               &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+            
+         ENDIF
+
+         IF ( ln_velfb ) THEN
+
+            DO jset = 1, jnumvelfb
+            
+               jveloset = jveloset + 1
+
+               ld_velav(jveloset) = ln_velfb_av(jset)
+               
+               CALL obs_rea_vel_dri( 0, velodata(jveloset), 1, &
+                  &                  velfbfiles(jset:jset), &
+                  &                  nvelovars, nveloextr, &
+                  &                  nitend-nit000+2,              &
+                  &                  dobsini, dobsend, ln_ignmis, &
+                  &                  ld_velav(jveloset), &
+                  &                  .FALSE. )
+               
+               DO jvar = 1, 2
+                  CALL obs_prof_staend( velodata(jveloset), jvar )
+               END DO
+               
+               CALL obs_pre_vel( velodata(jveloset), veldatqc(jveloset), &
+                  &              ln_vel3d, ln_nea, ld_velav(jveloset) )
+
+
+            END DO
+            
+         ENDIF
+
+      ENDIF
+     
+   END SUBROUTINE dia_obs_init
+
+   SUBROUTINE dia_obs( kstp )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE dia_obs  ***
+      !!          
+      !! ** Purpose : Call the observation operators on each time step
+      !!
+      !! ** Method  : Call the observation operators on each time step to
+      !!              compute the model equivalent of the following date:
+      !!               - T profiles
+      !!               - S profiles
+      !!               - Sea surface height (referenced to a mean)
+      !!               - Sea surface temperature
+      !!               - Sea surface salinity
+      !!               - Velocity component (U,V) profiles
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen) Original code
+      !!        !  06-05  (K. Mogensen) Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  07-03  (K. Mogensen) General handling of profiles
+      !!        !  07-04  (G. Smith) Generalized surface operators
+      !!        !  08-10  (M. Valdivieso) obs operator for velocity profiles
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &             ! Ocean space and time domain variables
+         & rdt,           &                       
+         & gdept_0,       &             
+         & tmask, umask, vmask                            
+      USE phycst, ONLY : &              ! Physical constants
+         & rday                         
+      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables
+         & tsn,  &             
+         & un, vn,  &
+         & sshn
+#if defined  key_lim3
+      USE ice, ONLY : &                     ! LIM Ice model variables
+         & frld
+#endif
+#if defined key_lim2
+      USE ice_2, ONLY : &                     ! LIM Ice model variables
+         & frld
+#endif
+      IMPLICIT NONE
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kstp                         ! Current timestep
+      !! * Local declarations
+      INTEGER :: idaystp                ! Number of timesteps per day
+      INTEGER :: jprofset               ! Profile data set loop variable
+      INTEGER :: jslaset                ! SLA data set loop variable
+      INTEGER :: jsstset                ! SST data set loop variable
+      INTEGER :: jseaiceset             ! sea ice data set loop variable
+      INTEGER :: jveloset               ! velocity profile data loop variable
+      INTEGER :: jvar                   ! Variable number    
+#if ! defined key_lim2 && ! defined key_lim3
+      REAL(wp), POINTER, DIMENSION(:,:) :: frld   
+#endif
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+ 
+#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
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation operators
+      !-----------------------------------------------------------------------
+
+      !  - Temperature/salinity profiles
+      IF ( ln_t3d .OR. ln_s3d ) THEN
+         DO jprofset = 1, nprofsets
+            IF ( ld_enact(jprofset) ) THEN
+               CALL obs_pro_opt( prodatqc(jprofset),                     &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   &
+                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   &
+                  &              gdept_0, tmask, n1dint, n2dint,         &
+                  &              kdailyavtypes = endailyavtypes )
+            ELSE
+               CALL obs_pro_opt( prodatqc(jprofset),                     &
+                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   &
+                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   &
+                  &              gdept_0, tmask, n1dint, n2dint               )
+            ENDIF
+         END DO
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+         DO jslaset = 1, nslasets
+            CALL obs_sla_opt( sladatqc(jslaset),            &
+               &              kstp, jpi, jpj, nit000, sshn, &
+               &              tmask(:,:,1), n2dint )
+         END DO         
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+         DO jsstset = 1, nsstsets
+            CALL obs_sst_opt( sstdatqc(jsstset),                 &
+               &              kstp, jpi, jpj, nit000, tsn(:,:,1,jp_tem), &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+#if defined key_lim2 || defined key_lim3
+      IF ( ln_seaice ) THEN
+         DO jseaiceset = 1, nseaicesets
+            CALL obs_seaice_opt( seaicedatqc(jseaiceset),      &
+               &              kstp, jpi, jpj, nit000, 1.-frld, &
+               &              tmask(:,:,1), n2dint )
+         END DO
+      ENDIF      
+#endif
+
+      !  - Velocity profiles
+      IF ( ln_vel3d ) THEN
+         DO jveloset = 1, nvelosets
+           ! zonal component of velocity
+           CALL obs_vel_opt( veldatqc(jveloset), kstp, jpi, jpj, jpk, &
+              &              nit000, idaystp, un, vn, gdept_0, umask, vmask, &
+                             n1dint, n2dint, ld_velav(jveloset) )
+         END DO
+      ENDIF
+
+#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
+      !!----------------------------------------------------------------------
+      IMPLICIT NONE
+
+      !! * Local declarations
+
+      INTEGER :: jprofset                 ! Profile data set loop variable
+      INTEGER :: jveloset                 ! Velocity data set loop variable
+      INTEGER :: jslaset                  ! SLA data set loop variable
+      INTEGER :: jsstset                  ! SST data set loop variable
+      INTEGER :: jseaiceset               ! Sea Ice data set loop variable
+      INTEGER :: jset
+      INTEGER :: jfbini
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      CHARACTER(LEN=10) :: cdtmp
+      !-----------------------------------------------------------------------
+      ! Depending on switches call various observation output routines
+      !-----------------------------------------------------------------------
+
+      !  - Temperature/salinity profiles
+
+      IF( ln_t3d .OR. ln_s3d ) THEN
+
+         ! Copy data from prodatqc to profdata structures
+         DO jprofset = 1, nprofsets
+
+            CALL obs_prof_decompress( prodatqc(jprofset), &
+                 &                    profdata(jprofset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jprofset = 0
+
+         ! ENACT insitu data
+
+         IF ( ln_ena ) THEN
+           
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'enact', profdata(jprofset) )
+
+         ENDIF
+
+         ! Coriolis insitu data
+
+         IF ( ln_cor ) THEN
+            
+            jprofset = jprofset + 1
+
+            CALL obs_wri_p3d( 'corio', profdata(jprofset) )
+            
+         ENDIF
+         
+         ! Feedback insitu data
+
+         IF ( ln_profb ) THEN
+
+            jfbini = jprofset + 1
+
+            DO jprofset = jfbini, nprofsets
+               
+               jset = jprofset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'profb_',jset
+               CALL obs_wri_p3d( cdtmp, profdata(jprofset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface anomaly
+      IF ( ln_sla ) THEN
+
+         ! Copy data from sladatqc to sladata structures
+         DO jslaset = 1, nslasets
+
+              CALL obs_surf_decompress( sladatqc(jslaset), &
+                 &                    sladata(jslaset), .TRUE., numout )
+
+         END DO
+
+         jslaset = 0 
+
+         ! Write the AVISO SLA data
+
+         IF ( ln_sladt ) THEN
+            
+            jslaset = 1
+            CALL obs_wri_sla( 'aviso_act', sladata(jslaset) )
+            jslaset = 2
+            CALL obs_wri_sla( 'aviso_pas', sladata(jslaset) )
+
+         ENDIF
+
+         IF ( ln_slafb ) THEN
+            
+            jfbini = jslaset + 1
+
+            DO jslaset = jfbini, nslasets
+               
+               jset = jslaset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'slafb_',jset
+               CALL obs_wri_sla( cdtmp, sladata(jslaset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface temperature
+      IF ( ln_sst ) THEN
+
+         ! Copy data from sstdatqc to sstdata structures
+         DO jsstset = 1, nsstsets
+     
+              CALL obs_surf_decompress( sstdatqc(jsstset), &
+                 &                    sstdata(jsstset), .TRUE., numout )
+
+         END DO
+
+         jsstset = 0 
+
+         ! Write the AVISO SST data
+
+         IF ( ln_reysst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'reynolds', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_ghrsst ) THEN
+            
+            jsstset = jsstset + 1
+            CALL obs_wri_sst( 'ghr', sstdata(jsstset) )
+
+         ENDIF
+
+         IF ( ln_sstfb ) THEN
+            
+            jfbini = jsstset + 1
+
+            DO jsstset = jfbini, nsstsets
+               
+               jset = jsstset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'sstfb_',jset
+               CALL obs_wri_sst( cdtmp, sstdata(jsstset) )
+
+            END DO
+
+         ENDIF
+
+      ENDIF
+
+      !  - Sea surface salinity
+      IF ( ln_sss ) THEN
+         IF(lwp) WRITE(numout,*) ' SSS currently not available'
+      ENDIF
+
+      !  - Sea Ice Concentration
+      IF ( ln_seaice ) THEN
+
+         ! Copy data from seaicedatqc to seaicedata structures
+         DO jseaiceset = 1, nseaicesets
+
+              CALL obs_surf_decompress( seaicedatqc(jseaiceset), &
+                 &                    seaicedata(jseaiceset), .TRUE., numout )
+
+         END DO
+
+         ! Write the Sea Ice data
+         DO jseaiceset = 1, nseaicesets
+      
+            WRITE(cdtmp,'(A,I2.2)')'seaicefb_',jseaiceset
+            CALL obs_wri_seaice( cdtmp, seaicedata(jseaiceset) )
+
+         END DO
+
+      ENDIF
+      
+      ! Velocity data
+      IF( ln_vel3d ) THEN
+
+         ! Copy data from veldatqc to velodata structures
+         DO jveloset = 1, nvelosets
+
+            CALL obs_prof_decompress( veldatqc(jveloset), &
+                 &                    velodata(jveloset), .TRUE., numout )
+
+         END DO
+
+         ! Write the profiles.
+
+         jveloset = 0
+
+         ! Daily averaged data
+
+         IF ( ln_velavcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhrcur ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velhrcurr', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! Daily averaged data
+
+         IF ( ln_velavadcp ) THEN
+            
+            jveloset = jveloset + 1
+
+            CALL obs_wri_vel( 'velavadcp', velodata(jveloset), n2dint )
+
+         ENDIF
+
+         ! High frequency data
+
+         IF ( ln_velhradcp ) THEN
+            
+            jveloset = jveloset + 1
+            
+            CALL obs_wri_vel( 'velhradcp', velodata(jveloset), n2dint )
+               
+         ENDIF
+
+         ! Feedback velocity data
+
+         IF ( ln_velfb ) THEN
+
+            jfbini = jveloset + 1
+
+            DO jveloset = jfbini, nvelosets
+               
+               jset = jveloset - jfbini + 1
+               WRITE(cdtmp,'(A,I2.2)')'velfb_',jset
+               CALL obs_wri_vel( cdtmp, velodata(jveloset), n2dint )
+
+            END DO
+
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE dia_obs_wri
+
+   SUBROUTINE ini_date( ddobsini )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE ini_date  ***
+      !!          
+      !! ** Purpose : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get initial data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  06-10  (G. Smith) Calculates initial date the same as method for final date
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len           
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsini                         ! Initial date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc ! Fraction of day
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+
+      !!----------------------------------------------------------------------
+      !! Initial date initialization (year, month, day, hour, minute)
+      !! (This assumes that the initial date is for 00z))
+      !!----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+
+      !!----------------------------------------------------------------------
+      !! Compute number of days + number of hours + min since initial time
+      !!----------------------------------------------------------------------
+      iday = iday + ( nit000 -1 ) * rdt / rday
+      zdayfrc = ( nit000 -1 ) * rdt / rday
+      zdayfrc = zdayfrc - aint(zdayfrc)
+      ihou = int( zdayfrc * 24 )
+      imin = int( (zdayfrc * 24 - ihou) * 60 )
+
+      !!-----------------------------------------------------------------------
+      !! Convert number of days (iday) into a real date
+      !!----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !!----------------------------------------------------------------------
+      !! Convert it into YYYYMMDD.HHMMSS format.
+      !!----------------------------------------------------------------------
+      ddobsini = iyea * 10000_dp + imon * 100_dp + &
+         &       iday + ihou * 0.01_dp + imin * 0.0001_dp
+
+
+   END SUBROUTINE ini_date
+
+   SUBROUTINE fin_date( ddobsfin )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fin_date  ***
+      !!          
+      !! ** Purpose : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Method  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! ** Action  : Get final data in double precision YYYYMMDD.HHMMSS format
+      !!
+      !! History :
+      !!        !  06-03  (K. Mogensen)  Original code
+      !!        !  06-05  (K. Mogensen)  Reformatted
+      !!        !  06-10  (A. Weaver) Cleaning
+      !!        !  10-05  (D. Lea) Update to month length calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      USE phycst, ONLY : &            ! Physical constants
+         & rday
+!      USE daymod, ONLY : &            ! Time variables
+!         & nmonth_len                
+      USE dom_oce, ONLY : &           ! Ocean space and time domain variables
+         & rdt
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      REAL(KIND=dp), INTENT(OUT) :: ddobsfin                   ! Final date in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      INTEGER :: iyea        ! date - (year, month, day, hour, minute)
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: imday         ! Number of days in month.
+      REAL(KIND=wp) :: zdayfrc       ! Fraction of day
+         
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+            
+      !-----------------------------------------------------------------------
+      ! Initial date initialization (year, month, day, hour, minute)
+      ! (This assumes that the initial date is for 00z)
+      !-----------------------------------------------------------------------
+      iyea =   ndate0 / 10000
+      imon = ( ndate0 - iyea * 10000 ) / 100
+      iday =   ndate0 - iyea * 10000 - imon * 100
+      ihou = 0
+      imin = 0
+      
+      !-----------------------------------------------------------------------
+      ! Compute number of days + number of hours + min since initial time
+      !-----------------------------------------------------------------------
+      iday    = iday +  nitend  * rdt / rday
+      zdayfrc =  nitend  * rdt / rday
+      zdayfrc = zdayfrc - AINT( zdayfrc )
+      ihou    = INT( zdayfrc * 24 )
+      imin    = INT( ( zdayfrc * 24 - ihou ) * 60 )
+
+      !-----------------------------------------------------------------------
+      ! Convert number of days (iday) into a real date
+      !----------------------------------------------------------------------
+
+      CALL calc_month_len( iyea, imonth_len )
+      
+      DO WHILE ( iday > imonth_len(imon) )
+         iday = iday - imonth_len(imon)
+         imon = imon + 1 
+         IF ( imon > 12 ) THEN
+            imon = 1
+            iyea = iyea + 1
+            CALL calc_month_len( iyea, imonth_len )  ! update month lengths
+         ENDIF
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Convert it into YYYYMMDD.HHMMSS format
+      !-----------------------------------------------------------------------
+      ddobsfin = iyea * 10000_dp + imon * 100_dp    + iday &
+         &     + ihou * 0.01_dp  + imin * 0.0001_dp
+
+    END SUBROUTINE fin_date
+    
+END MODULE diaobs
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/find_obs_proc.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/greg2jul.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/jul2greg.h90	(revision 3437)
@@ -0,0 +1,114 @@
+   RECURSIVE SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday, krefdate )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE jul2greg  ***
+      !!
+      !! ** Purpose : Take the relative time in days and re-express in terms of
+      !!              seconds, minutes, hours, days, month, year.
+      !!
+      !! ** Method  : Reference date : 19500101
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-05  (A. Vidard) Reformatted and refdate      
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN), OPTIONAL :: &
+         & krefdate
+      INTEGER, INTENT(OUT) :: &
+         & ksec,   &
+         & kminut, &
+         & khour,  &
+         & kday,   &
+         & kmonth, &
+         & kyear
+      REAL(KIND=dp), INTENT(IN) :: &
+         & prelday
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 2299161, &
+         & jporef = 2433283, &
+         & jparef = 2415021
+      INTEGER :: &
+         & ijulian, &
+         & ij1,     &
+         & ija,     &
+         & ijb,     &
+         & ijc,     &
+         & ijd,     &
+         & ije,     &
+         & isec,    &
+         & imin,    &
+         & ihou,    &
+         & iday,    &
+         & imon,    &
+         & iyea,    &
+         & iref
+      REAL(KIND=wp) :: &
+         & zday, &
+         & zref
+      CHARACTER(len=200) :: &
+         & cerr
+
+      ! Main computation
+      IF ( PRESENT( krefdate ) ) THEN
+
+         SELECT CASE ( krefdate )
+
+         CASE( 0 ) 
+            iref = jpgreg
+
+         CASE( 19500101 )
+            iref = jporef
+
+         CASE( 19000101 )
+            iref = jparef
+
+         CASE DEFAULT
+            WRITE(cerr,'(A,I8.8)')'jul2greg: Unknown krefdate:', krefdate
+            CALL ctl_stop( cerr )
+
+         END SELECT
+
+      ELSE
+         iref = jporef 
+      ENDIF
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1. ) )
+
+      IF ( ksec < 0. ) ksec = 86400. + ksec
+
+      khour  = ksec / 3600
+      kminut = ( ksec - 3600 * khour ) / 60
+      ksec   = MOD( ksec , 60 )
+
+      ijulian = iref + INT( zday )
+      IF ( zday < 0. ) ijulian = ijulian - 1
+
+      ! If input date after 10/15/1582 :
+      IF ( ijulian >= jpgreg ) THEN
+	 ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
+	 ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
+      ELSE
+	 ija = ijulian
+      ENDIF
+
+      ijb = ija + 1524
+      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
+      ijd = 365 * ijc + INT( 0.25 * ijc )
+      ije = INT( ( ijb - ijd ) / 30.6001 )
+      kday = ijb - ijd - INT( 30.6001 * ije )
+      kmonth = ije - 1
+      IF ( kmonth > 12 ) kmonth = kmonth - 12
+      kyear = ijc - 4715
+      IF ( kmonth > 2 ) kyear = kyear - 1
+      IF ( kyear <= 0 ) kyear = kyear - 1
+
+   END SUBROUTINE jul2greg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90	(revision 3437)
@@ -0,0 +1,32 @@
+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 
+  
+CONTAINS
+ 
+#include "jul2greg.h90"
+
+#include "greg2jul.h90"
+   
+END MODULE julian
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/linquad.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/maxdist.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/mpp_map.F90	(revision 3437)
@@ -0,0 +1,84 @@
+MODULE mpp_map
+   !!======================================================================
+   !!                       ***  MODULE mpp_mpa  ***
+   !! NEMOVAR: MPP global grid point mapping to processors
+   !!======================================================================
+   !! History :  2.0  ! 2007-08  (K. Mogensen)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!  mppmap_init : Initialize mppmap.
+   !!----------------------------------------------------------------------
+   USE par_kind, ONLY :   wp            ! Precision variables
+   USE par_oce , ONLY :   jpi, jpj      ! Ocean parameters
+   USE dom_oce , ONLY :   mig, mjg, nldi, nlei, nldj, nlej, narea   ! Ocean space and time domain variables
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY :   mpi_comm_opa   ! MPP library
+#endif
+   USE in_out_manager   ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC ::   mppmap_init, mppmap   !: ???
+
+   INTEGER, DIMENSION(:,:), ALLOCATABLE ::   mppmap   ! ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE mppmap_init
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mppmap_init ***
+      !!          
+      !! ** Purpose : Setup a global map of processor rank for all gridpoints
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER, DIMENSION(:,:), ALLOCATABLE ::   imppmap   !
+#if defined key_mpp_mpi
+      INTEGER :: ierr
+
+INCLUDE 'mpif.h'
+#endif
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( &
+         & mppmap(jpiglo,jpjglo) &
+         & )
+
+      ! Initialize local imppmap
+
+      ALLOCATE( &
+         & imppmap(jpiglo,jpjglo) &
+         & )
+      imppmap(:,:) = 0
+
+      ! Setup local grid points
+      imppmap(mig(nldi):mig(nlei),mjg(nldj):mjg(nlej)) = narea 
+      
+      ! Get global data
+
+#if defined key_mpp_mpi
+
+      ! Call the MPI library to find the max across processors
+      CALL mpi_allreduce( imppmap, mppmap, jpiglo*jpjglo, mpi_integer,   &
+         &                mpi_max, mpi_comm_opa, ierr )
+#else      
+      
+      ! No MPP: Just copy the data
+      mppmap(:,:) = imppmap(:,:)
+#endif
+      !
+   END SUBROUTINE mppmap_init
+
+   !!======================================================================
+END MODULE mpp_map
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_const.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_conv_functions.h90	(revision 3437)
@@ -0,0 +1,294 @@
+    !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+  REAL(KIND=wp) FUNCTION potemp( ps, pt, pp, ppr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION potemp  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: potemp(35,20,2000,0) = 19.621967
+      !!
+      !! References : T. J. Mcdougall, D. R. Jackett, D. G. Wright 
+      !!              and R. Feistel
+      !!              Accurate and computationally efficient algoritms for
+      !!              potential temperatures and density of seawater
+      !!              Journal of atmospheric and oceanic technology
+      !!              Vol 20, 2003, pp 730-741
+      !!              
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: ps
+      REAL(KIND=wp), INTENT(IN) :: pt
+      REAL(KIND=wp), INTENT(IN) :: pp
+      REAL(KIND=wp), INTENT(IN) :: ppr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: zpol
+      REAL(KIND=wp), PARAMETER :: a1 =  1.067610e-05
+      REAL(KIND=wp), PARAMETER :: a2 = -1.434297e-06
+      REAL(KIND=wp), PARAMETER :: a3 = -7.566349e-09
+      REAL(KIND=wp), PARAMETER :: a4 = -8.535585e-06
+      REAL(KIND=wp), PARAMETER :: a5 =  3.074672e-08
+      REAL(KIND=wp), PARAMETER :: a6 =  1.918639e-08
+      REAL(KIND=wp), PARAMETER :: a7 =  1.788718e-10
+
+      zpol = a1 + a2 * ps + a3 * ( pp + ppr ) + a4 * pt &
+         & + a5 * ps * pt + a6 * pt * pt + a7 * pt * ( pp + ppr )
+      
+      potemp = pt + ( pp - ppr ) * zpol
+      
+   END FUNCTION potemp
+
+   REAL(KIND=wp) FUNCTION fspott( pft, pfs, pfp )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION fspott  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : Check value: fspott(10,25,1000) = 8.4678516
+      !!
+      !! References : A. E. Gill
+      !!              Atmosphere-Ocean Dynamics
+      !!              Volume 30 (International Geophysics)
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) NEMO adopting of OPAVAR code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp) :: pft   ! in situ temperature in degrees celcius
+      REAL(KIND=wp) :: pfs   ! salinity in psu
+      REAL(KIND=wp) :: pfp   ! pressure in bars
+      
+      fspott = &
+         &  pft - pfp * (   (            3.6504e-4                     &
+         &                    + pft * (  8.3198e-5                     &
+         &                    + pft * ( -5.4065e-7                     &
+         &                    + pft *    4.0274e-9  ) ) )              &
+         &                + ( pfs - 35.0 ) * (         1.7439e-5       &
+         &                                     - pft * 2.9778e-7 )     &
+         &                + pfp * (            8.9309e-7               &
+         &                          + pft * ( -3.1628e-8               &
+         &                          + pft *    2.1987e-10 )            &
+         &                          - ( pfs - 35.0 ) *  4.1057e-9      &
+         &                          + pfp * (          -1.6056e-10     &
+         &                                    + pft * 5.0484e-12 ) ) )
+
+   END FUNCTION fspott
+
+   REAL(KIND=wp) FUNCTION atg( p_s, p_t, p_p )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION atg  ***
+      !!          
+      !! ** Purpose : Compute adiabatic temperature gradient deg c per decibar
+      !!
+      !! ** Method  : A regression formula is used
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: atg(40,40,10000) = 3.255974e-4
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+
+      REAL(KIND=wp), INTENT(IN) :: p_s    ! Salinity in PSU
+      REAL(KIND=wp), INTENT(IN) :: p_t    ! Temperature in centigrades
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars.
+
+      !! * Local declarations
+      
+      REAL(KIND=wp) :: z_ds
+
+      z_ds = p_s - 35.0
+      atg = ((( -2.1687e-16 * p_t + 1.8676e-14 ) * p_t - 4.6206e-13 ) * p_p      &
+         &  + (( 2.7759e-12 * p_t - 1.1351e-10 ) * z_ds + (( - 5.4481e-14 * p_t  &  
+         &  + 8.733e-12 ) * p_t - 6.7795e-10 ) * p_t  + 1.8741e-8)) * p_p        &
+         &  + ( -4.2393e-8 * p_t + 1.8932e-6 ) * z_ds                          &
+         &  + (( 6.6228e-10 * p_t - 6.836e-8 ) * p_t + 8.5258e-6 ) * p_t + 3.5803e-5
+
+   END FUNCTION atg
+      
+   REAL(KIND=wp) FUNCTION theta( p_s, p_t0, p_p0, p_pr )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION theta  ***
+      !!          
+      !! ** Purpose : Compute potential temperature
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: theta(40,40,10000,0) = 36.89073
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_s
+      REAL(KIND=wp), INTENT(IN) :: p_t0
+      REAL(KIND=wp), INTENT(IN) :: p_p0
+      REAL(KIND=wp), INTENT(IN) :: p_pr
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_p
+      REAL(KIND=wp) :: z_t
+      REAL(KIND=wp) :: z_h
+      REAL(KIND=wp) :: z_xk
+      REAL(KIND=wp) :: z_q
+
+      z_p = p_p0
+      z_t = p_t0
+      z_h = p_pr - z_p
+      z_xk = z_h * atg( p_s, z_t, z_p ) 
+      Z_t = z_t + 0.5 * z_xk
+      z_q = z_xk
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 0.29289322 * ( z_xk - z_q )
+      z_q = 0.58578644 * z_xk + 0.121320344 * z_q
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      z_t = z_t + 1.707106781 * ( z_xk - z_q )
+      z_q = 3.414213562 * z_xk - 4.121320244 * z_q
+      z_p = z_p + 0.5 * z_h
+      z_xk = z_h * atg( p_s, z_t, z_p )
+      theta = z_t + ( z_xk - 2.0 * z_q ) / 6.0
+
+   END FUNCTION theta
+
+   REAL(KIND=wp) FUNCTION depth( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION depth  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. 
+      !!
+      !! ** Action  : The code is kept as close to the F77 code as possible
+      !!              Check value: depth(10000,30) = 9712.653
+      !!
+      !! References : N. P. Fotonoff and R.C. Millard jr., 
+      !!              Algoritms for computation of fundamental
+      !!              properties of seawater
+      !!              Unesco technical papers in marine science 44
+      !!              Unesco 1983
+      !!
+      !! History :
+      !!        !  07-05 (K. Mogensen) Original code based on the F77 code.
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p     ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat   ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_gr
+      
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_gr = 9.780318 * ( 1.0 + ( 5.2788e-3 + 2.36e-5 * z_x ) * z_x ) + 1.092e-6 * p_p
+      depth = ((( -1.82e-15 * p_p + 2.279e-10 ) * p_p - 2.2512e-5 ) * p_p + 9.72659 ) * p_p
+      depth = depth / z_gr
+
+   END FUNCTION depth
+
+   REAL(KIND=wp) FUNCTION p_to_dep( p_p, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION p_to_dep  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : A regression formula is used. This version is less
+      !!              accurate the "depth" but invertible.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_p    ! Pressure in decibars
+      REAL(KIND=wp), INTENT(IN) :: p_lat  ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      p_to_dep = (1 - z_c1)  * p_p - z_c2 * p_p * p_p
+
+   END FUNCTION p_to_dep
+
+   REAL(KIND=wp) FUNCTION dep_to_p( p_dep, p_lat )
+      !!----------------------------------------------------------------------
+      !!                    ***  FUNCTION dep_to_p  ***
+      !!          
+      !! ** Purpose : Compute depth from pressure and latitudes
+      !!
+      !! ** Method  : The expression used in p_to_dep is inverted.
+      !!
+      !! ** Action  : 
+      !!
+      !! References : P.M Saunders
+      !!              Pratical conversion of pressure to depth
+      !!              Journal of physical oceanography Vol 11, 1981, pp 573-574
+      !!
+      !! History :
+      !!        !  07-05  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      REAL(KIND=wp), INTENT(IN) :: p_dep    ! Depth in meters
+      REAL(KIND=wp), INTENT(IN) :: p_lat    ! Latitude in degrees
+
+      !! * Local declarations
+      REAL(KIND=wp) :: z_x
+      REAL(KIND=wp) :: z_c1
+      REAL(KIND=wp) :: z_c2
+      REAL(KIND=wp) :: z_d
+
+      z_x = SIN( p_lat / 57.29578 )
+      z_x = z_x * z_x
+      z_c1 = ( 5.92  + 5.25 * z_x ) * 1e-3 
+      z_c2 = 2.21e-6 
+      z_d = ( z_c1 - 1 ) * ( z_c1 - 1  ) - 4 * z_c2 * p_dep
+      dep_to_p = (( 1 - z_c1 ) - SQRT( z_d )) / ( 2 * z_c2 )
+
+   END FUNCTION dep_to_p
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_fbm.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grd_bruteforce.h90	(revision 3437)
@@ -0,0 +1,349 @@
+   SUBROUTINE obs_grd_bruteforce( kpi, kpj, kpiglo, kpjglo,       &
+      &                            kldi, klei, kldj, klej,         &
+      &                            kmyproc, ktotproc,              &
+      &                            pglam, pgphi, pmask,            &
+      &                            kobs, plam, pphi, kobsi, kobsj, &
+      &                                   kproc)
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grd_bruteforce ***
+      !!
+      !! ** Purpose : Search gridpoints to find the grid box containing
+      !!              the observations
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=kmyproc processor only.
+      !!   
+      !! History :
+      !!        !  2001-11  (N. Daget, A. Weaver)
+      !!        !  2006-03  (A. Weaver) NEMOVAR migration.
+      !!        !  2006-05  (K. Mogensen) Moved to to separate routine.
+      !!        !  2007-10  (A. Vidard) Bug fix in wrap around checks; cleanup
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kpi                ! Number of local longitudes
+      INTEGER, INTENT(IN) :: kpj                ! Number of local latitudes
+      INTEGER, INTENT(IN) :: kpiglo             ! Number of global longitudes
+      INTEGER, INTENT(IN) :: kpjglo             ! Number of global latitudes
+      INTEGER, INTENT(IN) :: kldi               ! Start of inner domain in i
+      INTEGER, INTENT(IN) :: klei               ! End of inner domain in i
+      INTEGER, INTENT(IN) :: kldj               ! Start of inner domain in j
+      INTEGER, INTENT(IN) :: klej               ! End of inner domain in j
+      INTEGER, INTENT(IN) :: kmyproc            ! Processor number for MPP
+      INTEGER, INTENT(IN) :: ktotproc           ! Total number of processors
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pglam,   &               ! Grid point longitude
+         & pgphi,   &               ! Grid point latitude
+         & pmask                    ! Grid point mask
+      INTEGER,INTENT(IN) :: kobs                ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam, zpphi
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+
+      !-----------------------------------------------------------------------
+      ! Define grid setup for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = kpiglo
+         jlat     = kpjglo
+         joffset  = kmyproc
+         jostride = ktotproc
+      ELSE
+         jlon     = kpi
+         jlat     = kpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         DO jj = kldj, klej
+            DO ji = kldi, klei
+               zlamg(mig(ji),mjg(jj)) = pglam(ji,jj)
+               zphig(mig(ji),mjg(jj)) = pgphi(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = pmask(ji,jj)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = pglam(ji,jj)
+               zphig(ji,jj) = pgphi(ji,jj)
+               zmskg(ji,jj) = pmask(ji,jj)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes and latitudes
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zplam(kobs), &
+         & zpphi(kobs)  &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+         zpphi(jo) = pphi(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) &
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+
+      DO jo = 1+joffset, kobs, jostride
+
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between 0 and 360
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+         IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Find observations which are on within 1e-6 of a grid point
+         !---------------------------------------------------------------------
+
+         gridloop: DO jj = 1, jlat-1
+            DO ji = 1, jlon-1
+               IF ( ABS( zphig(ji,jj) - zpphi(jo) ) < 1e-6 )  THEN
+                  zlam = zlamg(ji,jj)
+                  IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                  IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                  IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridloop
+                     ENDIF
+                  ENDIF
+               ENDIF
+            END DO
+         END DO gridloop
+         
+         !---------------------------------------------------------------------
+         ! Ensure that all observation longtiudes are between -180 and 180
+         !---------------------------------------------------------------------
+
+         IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+         !---------------------------------------------------------------------
+         ! Do coordinate search using brute force.
+         ! - For land points kproc is set to number of the processor + 1000000
+         !   and we continue the search.
+         ! - For ocean points kproc is set to the number of the processor 
+         !   and we stop the search.
+         !---------------------------------------------------------------------
+
+         IF ( kproc(jo) == -1 ) THEN
+
+            ! Normal case
+            gridpoints : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+                  
+                  IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                  
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+                  
+                  IF ( linquad( zplam(jo), zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints
+                     ENDIF
+                  ENDIF
+                  
+               END DO
+            END DO gridpoints
+
+         ENDIF
+
+         ! In case of failure retry for obs. longtiude + 360.
+         IF ( kproc(jo) == -1 ) THEN
+            gridpoints_greenwich : DO jj = 1, jlat-1
+               DO ji = 1, jlon-1
+
+                  IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                     & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                  IF ( ABS( zpphi(jo) ) < 85 ) THEN
+                     IF ( ( zpphi(jo) > zphitmax(ji,jj) ) .OR. &
+                        & ( zpphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                  ENDIF
+
+                  IF ( linquad( zplam(jo)+360.0_wp, zpphi(jo), &
+                     &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                     IF ( llinvalidcell(ji,jj) ) THEN
+                        kproc(jo) = kmyproc + 1000000
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        CYCLE
+                     ELSE
+                        kproc(jo) = kmyproc
+                        kobsi(jo) = ji + 1
+                        kobsj(jo) = jj + 1
+                        EXIT gridpoints_greenwich
+                     ENDIF
+                  ENDIF
+
+               END DO
+            END DO gridpoints_greenwich
+
+         ENDIF
+      END DO
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam,         &
+         & zpphi          &
+         & )
+
+   END SUBROUTINE obs_grd_bruteforce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_grid.F90	(revision 3437)
@@ -0,0 +1,1180 @@
+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 :: grid_search_res = 0.5    ! Resolution of grid
+   INTEGER, PRIVATE :: gsearch_nlons_def    ! Num of longitudes
+   INTEGER, PRIVATE :: gsearch_nlats_def    ! Num of latitudes
+   REAL(wp), PRIVATE :: gsearch_lonmin_def  ! Min longitude
+   REAL(wp), PRIVATE :: gsearch_latmin_def  ! Min latitude
+   REAL(wp), PRIVATE :: gsearch_dlon_def    ! Lon spacing
+   REAL(wp), PRIVATE :: gsearch_dlat_def    ! Lat spacing
+   !! Variable versions
+   INTEGER, PRIVATE :: nlons     ! Num of longitudes
+   INTEGER, PRIVATE :: nlats     ! Num of latitudes
+   REAL(wp), PRIVATE :: lonmin ! Min longitude
+   REAL(wp), PRIVATE :: latmin ! Min latitude
+   REAL(wp), PRIVATE :: dlon     ! Lon spacing
+   REAL(wp), PRIVATE :: dlat     ! Lat spacing
+   
+   INTEGER, PRIVATE :: maxxdiff, maxydiff ! Max diffs between model points
+   INTEGER, PRIVATE :: limxdiff, limydiff
+   
+   ! Data storage
+   REAL(wp), PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & lons,  &
+      & lats
+   INTEGER, PRIVATE, DIMENSION(:,:), ALLOCATABLE :: &
+      & ixpos, &
+      & iypos, &
+      & iprocn    
+
+   ! Switches
+   LOGICAL, PUBLIC :: ln_grid_search_lookup  ! Use lookup table to speed up grid search
+   LOGICAL, PUBLIC :: ln_grid_global         ! Use global distribution of observations
+   CHARACTER(LEN=44), PUBLIC :: &
+      & grid_search_file    ! file name head for grid search lookup 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_grid_search( kobsin, plam, pphi, kobsi, kobsj, kproc, &
+      &                        cdgrid )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_search ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations calls either
+      !!              obs_grd_bruteforce - the original brute force search
+      !!                     or
+      !!              obs_grd_lookup - uses a lookup table to do a fast 
+      !!search
+      !!History :
+      !!        !  2007-12  (D. Lea) 
+      !!------------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: &
+         & kobsin                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobsin), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobsin), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+      CHARACTER(LEN=1) :: &
+         & cdgrid                   ! Grid to search
+
+      IF(kobsin > 0) THEN
+
+         IF ( ln_grid_search_lookup .AND. ( cdgrid == 'T' ) ) THEN
+            CALL obs_grd_lookup( kobsin, plam, pphi, &
+               &                         kobsi, kobsj, kproc )
+         ELSE
+            IF ( cdgrid == 'T' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamt, gphit, tmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'U' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamu, gphiu, umask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'V' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamv, gphiv, vmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSEIF ( cdgrid == 'F' ) THEN
+               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, &
+                  &                             nldi, nlei,nldj,  nlej,   &
+                  &                             nproc, jpnij,             &
+                  &                             glamf, gphif, fmask,      &
+                  &                             kobsin, plam, pphi,       &
+                  &                             kobsi, kobsj, kproc )
+            ELSE
+               CALL ctl_stop( 'Grid not supported' )
+            ENDIF
+         ENDIF
+         
+      ENDIF
+
+   END SUBROUTINE obs_grid_search
+
+#include "obs_grd_bruteforce.h90"
+   
+   SUBROUTINE obs_grd_lookup( kobs, plam, pphi, kobsi, kobsj, kproc )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_lookup ***
+      !!
+      !! ** Purpose : Search local gridpoints to find the grid box containing
+      !!              the observations (much faster then obs_grd_bruteforce)
+      !!
+      !! ** Method  : Call to linquad
+      !!
+      !! ** Action  : Return kproc holding the observation and kiobsi,kobsj
+      !!              valid on kproc=nproc processor only.
+      !!   
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine based on obs_grid_search
+      !!! updated with fixes from new version of obs_grid_search_bruteforce
+      !!! speeded up where points are not near a "difficult" region like an edge
+      !!----------------------------------------------------------------------
+
+      !! * Arguments
+      INTEGER :: kobs                     ! Size of the observation arrays
+      REAL(KIND=wp), DIMENSION(kobs), INTENT(IN) :: &
+         & plam, &                  ! Longitude of obsrvations 
+         & pphi                     ! Latitude of observations
+      INTEGER, DIMENSION(kobs), INTENT(OUT) :: &
+         & kobsi, &                 ! I-index of observations 
+         & kobsj, &                 ! J-index of observations 
+         & kproc                    ! Processor number of observations
+  
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:), ALLOCATABLE :: &
+         & zplam
+      REAL(wp) :: zlammax
+      REAL(wp) :: zlam
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: isx
+      INTEGER :: isy
+      INTEGER :: jimin
+      INTEGER :: jimax
+      INTEGER :: jjmin
+      INTEGER :: jjmax
+      INTEGER :: jojimin
+      INTEGER :: jojimax
+      INTEGER :: jojjmin
+      INTEGER :: jojjmax
+      INTEGER :: ipx1
+      INTEGER :: ipy1
+      INTEGER :: ip
+      INTEGER :: jp
+      INTEGER :: ipx
+      INTEGER :: ipy
+      INTEGER :: ipmx
+      INTEGER :: jlon
+      INTEGER :: jlat
+      INTEGER :: joffset
+      INTEGER :: jostride
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zlamg, &
+         & zphig, &
+         & zmskg, &
+         & zphitmax,&
+         & zphitmin,&
+         & zlamtmax,&
+         & zlamtmin
+      LOGICAL, DIMENSION(:,:), ALLOCATABLE :: &
+         & llinvalidcell
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zlamtm,  &
+         & zphitm
+      LOGICAL :: llfourflag
+      INTEGER :: ifourflagcountt
+      INTEGER :: ifourflagcountf
+      INTEGER, DIMENSION(5) :: ifourflagcountr
+
+      !-----------------------------------------------------------------------
+      ! Define grid for grid search
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         jlon     = jpiglo
+         jlat     = jpjglo
+         joffset  = nproc
+         jostride = jpnij
+      ELSE
+         jlon     = jpi
+         jlat     = jpj
+         joffset  = 0
+         jostride = 1
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Set up data for grid search
+      !-----------------------------------------------------------------------
+      ALLOCATE( &
+         & zlamg(jlon,jlat),             &
+         & zphig(jlon,jlat),             &
+         & zmskg(jlon,jlat),             &
+         & zphitmax(jlon-1,jlat-1),      &
+         & zphitmin(jlon-1,jlat-1),      &
+         & zlamtmax(jlon-1,jlat-1),      &
+         & zlamtmin(jlon-1,jlat-1),      &
+         & llinvalidcell(jlon-1,jlat-1), &
+         & zlamtm(4,jlon-1,jlat-1),      &
+         & zphitm(4,jlon-1,jlat-1)       &
+         & )
+      !-----------------------------------------------------------------------
+      ! Copy data to local arrays
+      !-----------------------------------------------------------------------
+      IF (ln_grid_global) THEN
+         zlamg(:,:) = -1.e+10
+         zphig(:,:) = -1.e+10
+         zmskg(:,:) = -1.e+10
+         ! Add various grids here.
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+               zlamg(mig(ji),mjg(jj)) = glamt(ji,jj)
+               zphig(mig(ji),mjg(jj)) = gphit(ji,jj)
+               zmskg(mig(ji),mjg(jj)) = tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL mpp_global_max( zlamg )
+         CALL mpp_global_max( zphig )
+         CALL mpp_global_max( zmskg )
+      ELSE
+         ! Add various grids here.
+         DO jj = 1, jlat
+            DO ji = 1, jlon
+               zlamg(ji,jj) = glamt(ji,jj)
+               zphig(ji,jj) = gphit(ji,jj)
+               zmskg(ji,jj) = tmask(ji,jj,1)
+            END DO
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Copy longitudes
+      !----------------------------------------------------------------------- 
+      ALLOCATE( &
+         & zplam(kobs) &
+         & )
+      DO jo = 1, kobs
+         zplam(jo) = plam(jo)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Set default values for output
+      !-----------------------------------------------------------------------
+      kproc(:) = -1
+      kobsi(:) = -1
+      kobsj(:) = -1
+      !-----------------------------------------------------------------------
+      ! Copy grid positions to temporary arrays and renormalize to 0 to 360.
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlamtm(1,ji,jj) = zlamg(ji  ,jj  )
+            zphitm(1,ji,jj) = zphig(ji  ,jj  )
+            zlamtm(2,ji,jj) = zlamg(ji+1,jj  )
+            zphitm(2,ji,jj) = zphig(ji+1,jj  )
+            zlamtm(3,ji,jj) = zlamg(ji+1,jj+1)
+            zphitm(3,ji,jj) = zphig(ji+1,jj+1)
+            zlamtm(4,ji,jj) = zlamg(ji  ,jj+1)
+            zphitm(4,ji,jj) = zphig(ji  ,jj+1)
+         END DO
+      END DO
+      WHERE ( zlamtm(:,:,:) < 0.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) + 360.0_wp
+      END WHERE
+      WHERE ( zlamtm(:,:,:) > 360.0_wp )
+         zlamtm(:,:,:) = zlamtm(:,:,:) - 360.0_wp
+      END WHERE
+      !-----------------------------------------------------------------------
+      ! Handle case of the wraparound; beware, not working with orca180
+      !-----------------------------------------------------------------------
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            zlammax = MAXVAL( zlamtm(:,ji,jj) )
+            WHERE (zlammax - zlamtm(:, ji, jj) > 180 ) & 
+               & zlamtm(:,ji,jj) = zlamtm(:,ji,jj) + 360._wp
+            zphitmax(ji,jj) = MAXVAL(zphitm(:,ji,jj))
+            zphitmin(ji,jj) = MINVAL(zphitm(:,ji,jj))
+            zlamtmax(ji,jj) = MAXVAL(zlamtm(:,ji,jj))
+            zlamtmin(ji,jj) = MINVAL(zlamtm(:,ji,jj))
+         END DO
+      END DO
+      !-----------------------------------------------------------------------
+      ! Search for boxes with only land points mark them invalid
+      !-----------------------------------------------------------------------
+      llinvalidcell(:,:) = .FALSE.
+      DO jj = 1, jlat-1
+         DO ji = 1, jlon-1
+            llinvalidcell(ji,jj) =               &
+               & zmskg(ji  ,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj  ) == 0.0_wp .AND. &
+               & zmskg(ji+1,jj+1) == 0.0_wp .AND. &
+               & zmskg(ji  ,jj+1) == 0.0_wp
+         END DO
+      END DO
+
+      if(lwp) WRITE(numout,*) 'obs_grid_lookup do coordinate search using lookup table'
+
+      !-----------------------------------------------------------------------
+      ! Do coordinate search using lookup table with local searches.
+      ! - For land points kproc is set to number of the processor + 1000000
+      !   and we continue the search.
+      ! - For ocean points kproc is set to the number of the processor 
+      !   and we stop the search.
+      !-----------------------------------------------------------------------
+      ifourflagcountt = 0
+      ifourflagcountf = 0
+      ifourflagcountr(:) = 0
+
+      !------------------------------------------------------------------------
+      ! Master loop for grid search
+      !------------------------------------------------------------------------
+         
+      gpkobs: DO jo = 1+joffset, kobs, jostride
+         ! Normal case
+         !        specify 4 points which surround the lat lon of interest
+         !                          x i,j+1  x i+1, j+1
+         !
+         !
+         !                             * lon,lat
+         !                          x i,j    x i+1,j
+
+         ! bottom corner point
+         ipx1 = INT( ( zplam(jo)  - lonmin ) / dlon + 1.0 ) 
+         ipy1 = INT( ( pphi (jo)  - latmin ) / dlat + 1.0 )  
+         
+         ipx = ipx1 + 1
+         ipy = ipy1 + 1
+
+         ! flag for searching around four points separately
+         ! default to false
+         llfourflag = .FALSE.
+         
+         ! check for point fully outside of region
+         IF ( (ipx1 > nlons) .OR. (ipy1 > nlats) .OR. &
+            & (ipx < 1) .OR. (ipy < 1) ) THEN
+            CYCLE
+         ENDIF
+         ! check wrap around
+         IF ( (ipx > nlons) .OR. (ipy > nlats) .OR. &
+            & (ipx1 < 1) .OR. (ipy1 < 1) ) THEN
+            llfourflag=.TRUE.
+            ifourflagcountr(1) = ifourflagcountr(1) + 1
+         ENDIF
+
+         IF (MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) == -1) CYCLE! cycle if no lookup points found
+         
+         jimin = 0
+         jimax = 0
+         jjmin = 0
+         jjmax = 0
+         
+         IF (.NOT. llfourflag) THEN 
+
+            ! calculate points range
+            ! define a square region encompassing the four corner points
+            ! do I need the -1 points?
+
+            jojimin = MINVAL(ixpos(ipx1:ipx,ipy1:ipy)) - 1
+            jojimax = MAXVAL(ixpos(ipx1:ipx,ipy1:ipy)) + 1
+            jojjmin = MINVAL(iypos(ipx1:ipx,ipy1:ipy)) - 1
+            jojjmax = MAXVAL(iypos(ipx1:ipx,ipy1:ipy)) + 1
+
+            jimin = jojimin - 1
+            jimax = jojimax + 1
+            jjmin = jojjmin - 1
+            jjmax = jojjmax + 1
+            
+            IF ( jojimin < 0 .OR. jojjmin < 0) THEN 
+               llfourflag = .TRUE.
+               ifourflagcountr(2) = ifourflagcountr(2) + 1
+            ENDIF
+            IF ( jojimax - jojimin > maxxdiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(3) = ifourflagcountr(3) + 1
+            ENDIF
+            IF ( jojjmax - jojjmin > maxydiff) THEN
+               llfourflag = .TRUE.
+               ifourflagcountr(4) = ifourflagcountr(4) + 1
+            ENDIF
+            
+         ENDIF
+
+         ipmx = 0
+         IF (llfourflag) ipmx = 1
+
+         IF (llfourflag) THEN 
+            ifourflagcountt = ifourflagcountt + 1
+         ELSE
+            ifourflagcountf = ifourflagcountf + 1
+         ENDIF
+
+         gridpointsn : DO ip = 0, ipmx
+            DO jp = 0, ipmx
+               
+               IF ( kproc(jo) /= -1 ) EXIT gridpointsn
+        
+               ipx = ipx1 + ip
+               ipy = ipy1 + jp
+               
+               IF (llfourflag) THEN
+
+                  ! deal with wrap around
+                  IF ( ipx > nlons ) ipx = 1
+                  IF ( ipy > nlats ) ipy = 1
+                  IF ( ipx < 1     ) ipx = nlons
+                  IF ( ipy < 1     ) ipy = nlats
+
+                  ! get i,j 
+                  isx = ixpos(ipx,ipy)
+                  isy = iypos(ipx,ipy)
+                  
+                  ! estimate appropriate search region (use max/min values)
+                  jimin = isx - maxxdiff - 1
+                  jimax = isx + maxxdiff + 1
+                  jjmin = isy - maxydiff - 1
+                  jjmax = isy + maxydiff + 1
+
+               ENDIF
+
+               IF ( jimin < 1      ) jimin = 1
+               IF ( jimax > jlon-1 ) jimax = jlon-1
+               IF ( jjmin < 1      ) jjmin = 1
+               IF ( jjmax > jlat-1 ) jjmax = jlat-1
+               
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between 0 and 360 
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) <   0.0_wp ) zplam(jo) = zplam(jo) + 360.0_wp
+               IF ( zplam(jo) > 360.0_wp ) zplam(jo) = zplam(jo) - 360.0_wp
+      
+               !---------------------------------------------------------------
+               ! Find observations which are on within 1e-6 of a grid point
+               !---------------------------------------------------------------
+
+               gridloop: DO jj = jjmin, jjmax
+                  DO ji = jimin, jimax
+                     IF ( ABS( zphig(ji,jj) - pphi(jo) ) < 1e-6 )  THEN
+                        zlam = zlamg(ji,jj)
+                        IF ( zlam <   0.0_wp ) zlam = zlam + 360.0_wp
+                        IF ( zlam > 360.0_wp ) zlam = zlam - 360.0_wp
+                        IF ( ABS( zlam - zplam(jo) ) < 1e-6 ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridloop
+                           ENDIF
+                        ENDIF
+                     ENDIF
+                  END DO
+               END DO gridloop
+
+               !---------------------------------------------------------------
+               ! Ensure that all observation longtiudes are between -180/180
+               !---------------------------------------------------------------
+
+               IF ( zplam(jo) > 180 ) zplam(jo) = zplam(jo) - 360.0_wp
+
+               IF ( kproc(jo) == -1 ) THEN
+                  
+                  ! Normal case 
+                  gridpoints : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+
+
+                        IF ( ( zplam(jo) > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo) < zlamtmin(ji,jj) ) ) CYCLE
+                        
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+                        
+                        IF ( linquad( zplam(jo), pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints
+               ENDIF
+
+               ! In case of failure retry for obs. longtiude + 360.
+               IF ( kproc(jo) == -1 ) THEN
+                  gridpoints_greenwich : DO jj = jjmin, jjmax
+                     DO ji = jimin, jimax
+                        
+                        IF ( ( zplam(jo)+360.0_wp > zlamtmax(ji,jj) ) .OR. &
+                           & ( zplam(jo)+360.0_wp < zlamtmin(ji,jj) ) ) CYCLE
+
+                        IF ( ABS( pphi(jo) ) < 85 ) THEN
+                           IF ( ( pphi(jo) > zphitmax(ji,jj) ) .OR. &
+                              & ( pphi(jo) < zphitmin(ji,jj) ) ) CYCLE
+                        ENDIF
+
+                        IF ( linquad( zplam(jo)+360.0_wp, pphi(jo), &
+                           &          zlamtm(:,ji,jj), zphitm(:,ji,jj) ) ) THEN
+                           IF ( llinvalidcell(ji,jj) ) THEN
+                              kproc(jo) = nproc + 1000000
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              CYCLE
+                           ELSE
+                              kproc(jo) = nproc
+                              kobsi(jo) = ji + 1
+                              kobsj(jo) = jj + 1
+                              EXIT gridpoints_greenwich
+                           ENDIF
+                        ENDIF
+                        
+                     END DO
+                  END DO gridpoints_greenwich
+                  
+               ENDIF   ! kproc
+               
+            END DO
+         END DO gridpointsn
+      END DO gpkobs  ! kobs
+
+      !----------------------------------------------------------------------
+      ! Synchronize kproc on all processors
+      !----------------------------------------------------------------------
+      IF ( ln_grid_global ) THEN
+         CALL obs_mpp_max_integer( kproc, kobs )
+         CALL obs_mpp_max_integer( kobsi, kobs )
+         CALL obs_mpp_max_integer( kobsj, kobs )
+      ELSE
+         CALL obs_mpp_find_obs_proc( kproc, kobsi, kobsj, kobs )
+      ENDIF
+
+      WHERE( kproc(:) >= 1000000 )
+         kproc(:) = kproc(:) - 1000000
+      END WHERE
+
+      DEALLOCATE( &
+         & zlamg,         &
+         & zphig,         &
+         & zmskg,         &
+         & zphitmax,      &
+         & zphitmin,      &
+         & zlamtmax,      &
+         & zlamtmin,      &
+         & llinvalidcell, &
+         & zlamtm,        &
+         & zphitm,        &
+         & zplam          &
+         & )
+      
+   END SUBROUTINE obs_grd_lookup
+
+
+   SUBROUTINE obs_grid_setup
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Setup a lookup table to reduce the searching required
+      !!              for converting lat lons to grid point location
+      !!              produces or reads in a preexisting file for use in 
+      !!              obs_grid_search_lookup_local
+      !!
+      !! ** Method : calls obs_grid_search_bruteforce_local with a array 
+      !!             of lats and lons
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!----------------------------------------------------------------------
+      
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: &
+         & cpname = 'obs_grid_setup'
+      CHARACTER(LEN=40) :: cfname      
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jo
+      INTEGER :: idfile, idny, idnx, idxpos, idypos
+      INTEGER :: idlat, idlon, fileexist
+      INTEGER, DIMENSION(2) :: incdim
+      CHARACTER(LEN=20) :: datestr=" ",timestr=" "
+      REAL(wp) :: tmpx1, tmpx2, tmpy1, tmpy2
+      REAL(wp) :: meanxdiff, meanydiff
+      REAL(wp) :: meanxdiff1, meanydiff1
+      REAL(wp) :: meanxdiff2, meanydiff2
+      INTEGER :: numx1, numx2, numy1, numy2, df
+      INTEGER :: jimin, jimax, jjmin, jjmax
+      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & lonsi,     &
+         & latsi
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &  
+         & ixposi,    &
+         & iyposi,    & 
+         & iproci    
+      INTEGER, PARAMETER :: histsize=90
+      INTEGER, DIMENSION(histsize) :: &
+         & histx1, histx2, histy1, histy2
+      REAL, DIMENSION(histsize) :: &
+         & fhistx1, fhistx2, fhisty1, fhisty2
+      REAL(wp) :: histtol
+      
+      IF (ln_grid_search_lookup) THEN
+         
+         WRITE(numout,*) 'Calling obs_grid_setup'
+         
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*)'Grid search resolution : ', grid_search_res
+         
+         gsearch_nlons_def  = NINT( 360.0_wp / grid_search_res ) 
+         gsearch_nlats_def  = NINT( 180.0_wp / grid_search_res )
+         gsearch_lonmin_def = -180.0_wp + 0.5_wp * grid_search_res
+         gsearch_latmin_def =  -90.0_wp + 0.5_wp * grid_search_res
+         gsearch_dlon_def   = grid_search_res
+         gsearch_dlat_def   = grid_search_res
+         
+         IF (lwp) THEN
+            WRITE(numout,*)'Grid search gsearch_nlons_def  = ',gsearch_nlons_def
+            WRITE(numout,*)'Grid search gsearch_nlats_def  = ',gsearch_nlats_def
+            WRITE(numout,*)'Grid search gsearch_lonmin_def = ',gsearch_lonmin_def
+            WRITE(numout,*)'Grid search gsearch_latmin_def = ',gsearch_latmin_def
+            WRITE(numout,*)'Grid search gsearch_dlon_def   = ',gsearch_dlon_def
+            WRITE(numout,*)'Grid search gsearch_dlat_def   = ',gsearch_dlat_def
+         ENDIF
+
+         IF ( ln_grid_global ) THEN
+            WRITE(cfname, FMT="(A,'_',A)") &
+               &          TRIM(grid_search_file), 'global.nc'
+         ELSE
+            WRITE(cfname, FMT="(A,'_',I4.4,'of',I4.4,'by',I4.4,'.nc')") &
+               &          TRIM(grid_search_file), nproc, jpni, jpnj
+         ENDIF
+
+         fileexist=nf90_open( TRIM( cfname ), nf90_nowrite, &
+            &                  idfile )
+         
+         IF ( fileexist == nf90_noerr ) THEN
+            
+            ! read data
+            ! initially assume size is as defined (to be fixed)
+            
+            WRITE(numout,*) 'Reading: ',cfname
+            
+            CALL chkerr( nf90_open( TRIM( cfname ), nf90_nowrite, idfile ), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxxdiff', maxxdiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'maxydiff', maxydiff ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlon', dlon ), &
+            &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'dlat', dlat ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'lonmin', lonmin ), &
+               &         cpname, __LINE__ )        
+            CALL chkerr( nf90_get_att( idfile, nf90_global, 'latmin', latmin ), &
+               &         cpname, __LINE__ )        
+            
+            CALL chkerr( nf90_inq_dimid(idfile, 'nx'  , idnx), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idnx, len = nlons ),     &
+               &         cpname, __LINE__ ) 
+            CALL chkerr( nf90_inq_dimid(idfile, 'ny'  , idny), &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inquire_dimension( idfile, idny, len = nlats ),     &
+               &         cpname, __LINE__ ) 
+            
+            ALLOCATE( &
+               & lons(nlons,nlats),  &
+               & lats(nlons,nlats),  &
+               & ixpos(nlons,nlats), &
+               & iypos(nlons,nlats), &
+               & iprocn(nlons,nlats)  &
+               & )
+            
+            CALL chkerr( nf90_inq_varid( idfile, 'XPOS', idxpos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idxpos, ixpos),   &
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_inq_varid( idfile, 'YPOS', idypos ), & 
+               &         cpname, __LINE__ )
+            CALL chkerr( nf90_get_var  ( idfile, idypos, iypos),   &
+               &         cpname, __LINE__ )
+            
+            CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+            
+            ! setup arrays
+            
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lons(ji,jj) = lonmin + (ji-1) * dlon
+                  lats(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            ! if we are not reading the file we need to create it
+            ! create new obs grid search lookup file
+            
+         ELSE 
+            
+            ! call obs_grid_search
+            
+            IF (lwp) THEN
+               WRITE(numout,*) 'creating: ',cfname
+               WRITE(numout,*) 'calling obs_grid_search: ',nlons*nlats
+            ENDIF
+
+            ! set parameters from default values
+            nlons  = gsearch_nlons_def
+            nlats  = gsearch_nlats_def
+            lonmin = gsearch_lonmin_def
+            latmin = gsearch_latmin_def
+            dlon   = gsearch_dlon_def
+            dlat   = gsearch_dlat_def
+            
+            ! setup arrays
+            
+            ALLOCATE( &
+               & lonsi(nlons,nlats),   &
+               & latsi(nlons,nlats),   &
+               & ixposi(nlons,nlats),  &
+               & iyposi(nlons,nlats),  &
+               & iproci(nlons,nlats)   &
+               & )
+         
+            DO ji = 1, nlons
+               DO jj = 1, nlats
+                  lonsi(ji,jj) = lonmin + (ji-1) * dlon
+                  latsi(ji,jj) = latmin + (jj-1) * dlat
+               END DO
+            END DO
+            
+            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,  &
+               &                     nldi, nlei,nldj,  nlej,    &
+               &                     nproc, jpnij,              &
+               &                     glamt, gphit, tmask,       &
+               &                     nlons*nlats, lonsi, latsi, &
+               &                     ixposi, iyposi, iproci )
+            
+            ! minimise file size by removing regions with no data from xypos file
+            ! should be able to just use xpos (ypos will have the same areas of missing data)
+         
+            jimin=1
+            jimax=nlons
+            jjmin=1
+            jjmax=nlats
+
+            minlon_xpos: DO ji= 1, nlons
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimin=ji
+                  EXIT minlon_xpos
+               ENDIF
+            END DO minlon_xpos
+
+            maxlon_xpos: DO ji= nlons, 1, -1
+               IF (COUNT(ixposi(ji,:) >= 0) > 0) THEN
+                  jimax=ji
+                  EXIT maxlon_xpos
+               ENDIF
+            END DO maxlon_xpos
+
+            minlat_xpos: DO jj= 1, nlats
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN
+                  jjmin=jj
+                  EXIT minlat_xpos
+               ENDIF
+            END DO minlat_xpos
+
+            maxlat_xpos: DO jj= nlats, 1, -1
+               IF (COUNT(ixposi(:,jj) >= 0) > 0) THEN 
+                  jjmax=jj
+                  EXIT maxlat_xpos
+               ENDIF
+            END DO maxlat_xpos
+
+            lonmin = lonsi(jimin,jjmin)
+            latmin = latsi(jimin,jjmin)
+            nlons  = jimax-jimin+1
+            nlats  = jjmax-jjmin+1
+
+            ! construct new arrays
+
+            ALLOCATE( &
+               & lons(nlons,nlats),    &
+               & lats(nlons,nlats),    &
+               & ixpos(nlons,nlats),   &
+               & iypos(nlons,nlats),   &
+               & iprocn(nlons,nlats)    &
+               & )
+
+            lons(:,:) = lonsi(jimin:jimax,jjmin:jjmax)
+            lats(:,:) = latsi(jimin:jimax,jjmin:jjmax)
+            ixpos(:,:) = ixposi(jimin:jimax,jjmin:jjmax)
+            iypos(:,:) = iyposi(jimin:jimax,jjmin:jjmax)
+            iprocn(:,:) = iproci(jimin:jimax,jjmin:jjmax)
+
+            DEALLOCATE(lonsi,latsi,ixposi,iyposi,iproci)
+
+            ! calculate (estimate) maxxdiff, maxydiff
+            ! this is to help define the search area for obs_grid_search_lookup
+
+            maxxdiff = 1
+            maxydiff = 1
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0 
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            ! calculate the mean absolute xdiff and ydiff
+            ! also calculate a histogram
+            ! note the reason why looking for xdiff and ydiff in both directions
+            ! is to allow for rotated grids
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj) - ixpos(ji,jj) )
+                        tmpx1 = tmpx1+df
+                        numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = tmpx2 + df
+                        numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = tmpy1 + df
+                        numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF ( iypos(ji,jj+1) > 0 ) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = tmpy2 + df
+                        numy2 = numy2 + 1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1) + 1
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'histx1'
+               WRITE(numout,*) histx1
+               WRITE(numout,*) 'histx2'
+               WRITE(numout,*) histx2
+               WRITE(numout,*) 'histy1'
+               WRITE(numout,*) histy1
+               WRITE(numout,*) 'histy2'
+               WRITE(numout,*) histy2
+            ENDIF
+
+            meanxdiff1 = tmpx1 / numx1
+            meanydiff1 = tmpy1 / numy1
+            meanxdiff2 = tmpx2 / numx2
+            meanydiff2 = tmpy2 / numy2
+
+            meanxdiff = MAXVAL((/ meanxdiff1, meanxdiff2 /))
+            meanydiff = MAXVAL((/ meanydiff1, meanydiff2 /))
+
+            IF (lwp) THEN
+               WRITE(numout,*) tmpx1, tmpx2, tmpy1, tmpy2
+               WRITE(numout,*) numx1, numx2, numy1, numy2
+               WRITE(numout,*) 'meanxdiff: ',meanxdiff, meanxdiff1, meanxdiff2
+               WRITE(numout,*) 'meanydiff: ',meanydiff, meanydiff1, meanydiff2
+            ENDIF
+
+            tmpx1 = 0
+            tmpx2 = 0
+            tmpy1 = 0
+            tmpy2 = 0
+
+            numx1 = 0
+            numx2 = 0
+            numy1 = 0
+            numy2 = 0
+
+            histx1(:) = 0
+            histx2(:) = 0
+            histy1(:) = 0
+            histy2(:) = 0
+
+            limxdiff = meanxdiff * 4! limit the difference to avoid picking up wraparound
+            limydiff = meanydiff * 4
+
+            DO ji = 1, nlons-1
+               DO jj = 1, nlats-1
+                  IF ( ixpos(ji,jj) > 0 .AND. iypos(ji,jj) > 0 ) THEN
+
+                     IF ( ixpos(ji+1,jj) > 0 ) THEN
+                        df = ABS( ixpos(ji+1,jj)-ixpos(ji,jj) )
+                        tmpx1 = df
+                        IF ( df < limxdiff ) numx1 = numx1+1
+                        IF ( df < histsize ) histx1(df+1) = histx1(df+1) + 1
+                     ENDIF
+                     IF ( ixpos(ji,jj+1) > 0 ) THEN
+                        df = ABS( ixpos(ji,jj+1) - ixpos(ji,jj) )
+                        tmpx2 = df
+                        IF ( df < limxdiff ) numx2 = numx2 + 1
+                        IF ( df < histsize ) histx2(df+1) = histx2(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji+1,jj) > 0) THEN
+                        df = ABS( iypos(ji+1,jj) - iypos(ji,jj) )
+                        tmpy1 = df
+                        IF ( df < limxdiff ) numy1 = numy1 + 1
+                        IF ( df < histsize ) histy1(df+1) = histy1(df+1) + 1
+                     ENDIF
+                     IF (iypos(ji,jj+1) > 0) THEN
+                        df = ABS( iypos(ji,jj+1) - iypos(ji,jj) )
+                        tmpy2 = df
+                        IF ( df < limxdiff ) numy2 = numy2+1
+                        IF ( df < histsize ) histy2(df+1) = histy2(df+1)+1
+                     ENDIF
+
+                     IF ( maxxdiff < tmpx1 .AND. tmpx1 < limxdiff ) &
+                        & maxxdiff = tmpx1
+                     IF ( maxxdiff < tmpx2 .AND. tmpx2 < limxdiff ) &
+                        & maxxdiff = tmpx2
+                     IF ( maxydiff < tmpy1 .AND. tmpy1 < limydiff ) &
+                        & maxydiff = tmpy1
+                     IF ( maxydiff < tmpy2 .AND. tmpy2 < limydiff ) &
+                        & maxydiff = tmpy2
+
+                  ENDIF
+               END DO
+            END DO
+
+            ! cumulative histograms
+
+            DO ji = 1, histsize - 1
+               histx1(ji+1) = histx1(ji+1) + histx1(ji)
+               histx2(ji+1) = histx2(ji+1) + histx2(ji)
+               histy1(ji+1) = histy1(ji+1) + histy1(ji)
+               histy2(ji+1) = histy2(ji+1) + histy2(ji)
+            END DO
+
+            fhistx1(:) = histx1(:) * 1.0 / numx1
+            fhistx2(:) = histx2(:) * 1.0 / numx2
+            fhisty1(:) = histy1(:) * 1.0 / numy1
+            fhisty2(:) = histy2(:) * 1.0 / numy2
+
+            ! output new histograms
+
+            IF (lwp) THEN
+               WRITE(numout,*) 'cumulative histograms'
+               WRITE(numout,*) '0   1   2   3   4   5   6   7   8   9   10 ...'
+               WRITE(numout,*) 'fhistx1'
+               WRITE(numout,*) fhistx1
+               WRITE(numout,*) 'fhistx2'
+               WRITE(numout,*) fhistx2
+               WRITE(numout,*) 'fhisty1'
+               WRITE(numout,*) fhisty1
+               WRITE(numout,*) 'fhisty2'
+               WRITE(numout,*) fhisty2
+            ENDIF
+
+            ! calculate maxxdiff and maxydiff based on cumulative histograms
+            ! where > 0.999 of points are
+
+            ! maxval just converts 1x1 vector return from maxloc to a scalar 
+
+            histtol = 0.999
+            tmpx1 = MAXVAL( MAXLOC( fhistx1(:), mask = ( fhistx1(:) <= histtol ) ) )
+            tmpx2 = MAXVAL( MAXLOC( fhistx2(:), mask = ( fhistx2(:) <= histtol ) ) )
+            tmpy1 = MAXVAL( MAXLOC( fhisty1(:), mask = ( fhisty1(:) <= histtol ) ) )
+            tmpy2 = MAXVAL( MAXLOC( fhisty2(:), mask = ( fhisty2(:) <= histtol ) ) )
+
+            maxxdiff = MAXVAL( (/ tmpx1, tmpx2 /) ) + 1
+            maxydiff = MAXVAL( (/ tmpy1, tmpy2 /) ) + 1
+
+            ! Write out data
+
+            IF ( ( .NOT. ln_grid_global ) .OR. &
+               & ( ( ln_grid_global ) .AND. ( nproc==0 ) ) ) THEN
+
+               CALL chkerr( nf90_create (TRIM(cfname), nf90_clobber, idfile), &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'title',       &
+                  &         'Mapping file from lon/lat to model grid point' ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxxdiff',    &
+                  &                       maxxdiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'maxydiff',    &
+                  &                       maxydiff ),                         &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlon', dlon ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'dlat', dlat ),&
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'lonmin',      &
+                  &                       lonmin ),                           &
+                  &         cpname,__LINE__ ) 
+               CALL chkerr( nf90_put_att( idfile, nf90_global, 'latmin',      &
+                  &                       latmin ),                           &
+                  &         cpname,__LINE__ ) 
+
+               CALL chkerr( nf90_def_dim(idfile, 'nx'  , nlons, idnx),        &
+                  &         cpname,__LINE__ )
+               CALL chkerr( nf90_def_dim(idfile, 'ny'  , nlats, idny),        &
+                  &         cpname,__LINE__ )
+
+               incdim(1) = idnx
+               incdim(2) = idny
+               
+               CALL chkerr( nf90_def_var( idfile, 'LON', nf90_float, incdim,  &
+                  &                       idlon ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlon, 'long_name',         &
+                  &                       'longitude' ),                      &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_def_var( idfile, 'LAT', nf90_float, incdim,  &
+                  &                       idlat ),                            &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idlat, 'long_name',         &
+                  &                       'latitude' ),                       &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'XPOS', nf90_int, incdim,   &
+                  &                       idxpos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, 'long_name',        &
+                  &                       'x position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idxpos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_def_var( idfile, 'YPOS', nf90_int, incdim,   &
+                  &                       idypos ),                           &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, 'long_name',        &
+                  &                       'y position' ),                     &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_att( idfile, idypos, '_FillValue', -1 ), &
+                  &         cpname, __LINE__ )
+
+               CALL chkerr( nf90_enddef( idfile ), cpname, __LINE__ )
+               
+               CALL chkerr( nf90_put_var( idfile, idlon, lons),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idlat, lats),               &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idxpos, ixpos),             &
+                  &         cpname, __LINE__ )
+               CALL chkerr( nf90_put_var( idfile, idypos, iypos),             &
+                  &         cpname, __LINE__ )
+               
+               CALL chkerr( nf90_close( idfile ), cpname, __LINE__ )
+               
+               ! should also output max i, max j spacing for use in 
+               ! obs_grid_search_lookup
+               
+            ENDIF
+
+         ENDIF
+
+      ENDIF
+
+   END SUBROUTINE obs_grid_setup
+   
+   SUBROUTINE obs_grid_deallocate( )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE obs_grid_setup ***
+      !!
+      !! ** Purpose : Deallocate arrays setup by obs_grid_setup
+      !!
+      !! History :
+      !!        !  2007-12 (D. Lea) new routine
+      !!-----------------------------------------------------------------------
+
+      IF (ln_grid_search_lookup) THEN
+         DEALLOCATE( lons, lats, ixpos, iypos, iprocn )
+      ENDIF
+      
+   END SUBROUTINE obs_grid_deallocate
+
+#include "obs_level_search.h90"
+
+#include "linquad.h90"
+
+#include "maxdist.h90"
+
+#include "find_obs_proc.h90"
+
+END MODULE obs_grid
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_h2d.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_sup.F90	(revision 3437)
@@ -0,0 +1,385 @@
+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, kpk, kgrdi, kgrdj, &
+      &                        pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil
+      !!
+      !! ** Method  : Either on-demand communication with 
+      !!              obs_int_comm_3d_global 
+      !!              or local memory with
+      !!              obs_int_comm_3D_local
+      !!              depending on ln_global_grid
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      
+      IF (ln_grid_global) THEN
+         
+         IF (PRESENT(kproc)) THEN
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval, kproc=kproc )
+
+         ELSE
+
+            CALL obs_int_comm_3d_global( kptsi, kptsj, kobs, kpk, kgrdi, &
+               &                         kgrdj, pval, pgval )
+
+         ENDIF
+
+      ELSE
+
+         CALL obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+            &                        pval, pgval )
+
+      ENDIF
+
+   END SUBROUTINE obs_int_comm_3d
+
+   SUBROUTINE obs_int_comm_2d( kptsi, kptsj, kobs, kgrdi, kgrdj, pval, pgval, &
+      &                        kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_2d  ***
+      !!          
+      !! ** Purpose : Get 2D interpolation stencil
+      !!
+      !! ** Method  : Call to obs_int_comm_3d
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !!
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs          ! Local number of observations
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj), INTENT(IN) ::&
+         & pval             ! Local 3D array to extra data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), 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, 1, kgrdi, kgrdj, zval, &
+            &                  zgval, kproc=kproc )
+      ELSE
+
+         CALL obs_int_comm_3d( kptsi, kptsj, kobs, 1, kgrdi, kgrdj, zval, &
+            &                  zgval )
+
+      ENDIF
+
+      ! Copy "3D" data back to 2D
+
+      pgval(:,:,:) = zgval(:,:,1,:)
+
+      ! '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, kpk, kgrdi, kgrdj, &
+      &                               pval, pgval, kproc )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi     ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj     ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs      ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk       ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      INTEGER, OPTIONAL, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kproc            ! Precomputed processor for each i,j,iobs points
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zsend, &
+         & zrecv
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & igrdij_send, &
+         & igrdij_recv
+      INTEGER, DIMENSION(kptsi,kptsj,kobs) :: &
+         & iorder, &
+         & iproc
+      INTEGER :: nplocal(jpnij)
+      INTEGER :: npglobal(jpnij)
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jp
+      INTEGER :: jobs
+      INTEGER :: it
+      INTEGER :: itot
+      INTEGER :: ii
+      INTEGER :: ij
+
+      ! Check valid points
+      
+      IF ( ( MAXVAL(kgrdi) > jpiglo ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpjglo ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_global', &
+            &           'Point outside global domain' )
+         
+      ENDIF
+
+      ! Count number of points on each processors
+
+      nplocal(:) = 0
+      IF (PRESENT(kproc)) THEN 
+         iproc(:,:,:) = kproc(:,:,:)
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ELSE
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  iproc(ji,jj,jobs) = mppmap(kgrdi(ji,jj,jobs),&
+                     &                       kgrdj(ji,jj,jobs))
+                  nplocal(iproc(ji,jj,jobs)) = nplocal(iproc(ji,jj,jobs)) + 1
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Send local number of points and receive points on current domain
+
+      CALL mpp_alltoall_int( 1, nplocal, npglobal )
+
+      ! Allocate message parsing workspace
+
+      itot = SUM(npglobal)
+
+      ALLOCATE( &
+         & igrdij_send(kptsi*kptsj*kobs*2), &
+         & igrdij_recv(itot*2),             &
+         & zsend(kpk,itot),                 &
+         & zrecv(kpk,kptsi*kptsj*kobs)      &
+         & )
+
+      ! Pack buffers for list of points
+
+      it = 0
+      DO jp = 1, jpnij 
+         DO jobs = 1, kobs
+            DO jj = 1, kptsj
+               DO ji = 1, kptsi
+                  IF ( iproc(ji,jj,jobs) == jp ) THEN
+                     it = it + 1
+                     iorder(ji,jj,jobs) = it
+                     igrdij_send(2*it-1) = kgrdi(ji,jj,jobs)
+                     igrdij_send(2*it  ) = kgrdj(ji,jj,jobs)
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Send and recieve buffers for list of points
+
+      CALL mpp_alltoallv_int( igrdij_send, kptsi*kptsj*kobs*2, nplocal(:)*2, &
+         &                    igrdij_recv, itot*2, npglobal(:)*2 )
+
+      ! Pack interpolation data to be sent
+
+      DO ji = 1, itot
+         ii = mi1(igrdij_recv(2*ji-1))
+         ij = mj1(igrdij_recv(2*ji))
+         DO jk = 1, kpk
+            zsend(jk,ji) = pval(ii,ij,jk)
+         END DO
+      END DO
+
+      ! Re-adjust sizes
+
+      nplocal(:)  = kpk*nplocal(:)
+      npglobal(:) = kpk*npglobal(:)
+
+
+      ! Send and receive data for interpolation stencil
+
+      CALL mpp_alltoallv_real( zsend, kpk*itot,             npglobal, &
+         &                     zrecv, kpk*kptsi*kptsj*kobs, nplocal )
+
+      ! Copy the received data into output data structure
+      
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               it = iorder(ji,jj,jobs)  
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = zrecv(jk,it)
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Deallocate message parsing workspace
+
+      DEALLOCATE( &
+         & igrdij_send, &
+         & igrdij_recv, &
+         & zsend,       &
+         & zrecv        &
+         & )
+
+   END SUBROUTINE obs_int_comm_3d_global
+   
+   SUBROUTINE obs_int_comm_3d_local( kptsi, kptsj, kobs, kpk, kgrdi, kgrdj, &
+      &                              pval, pgval )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_int_comm_3d_global  ***
+      !!          
+      !! ** Purpose : Get 3D interpolation stencil (global version)
+      !!
+      !! ** Method  : On-demand communication where each processor send its
+      !!              list of (i,j) of points to all processors and receive 
+      !!              the corresponding values
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kptsi        ! Number of i horizontal points per stencil 
+      INTEGER, INTENT(IN) :: kptsj        ! Number of j horizontal points per stencil
+      INTEGER, INTENT(IN) :: kobs         ! Local number of observations
+      INTEGER, INTENT(IN) :: kpk          ! Number of levels
+      INTEGER, DIMENSION(kptsi,kptsj,kobs), INTENT(IN) :: &
+         & kgrdi, &         ! i,j indicies for each stencil
+         & kgrdj
+      REAL(KIND=wp), DIMENSION(jpi,jpj,kpk), INTENT(IN) ::&
+         & pval             ! Local 3D array to extract data from
+      REAL(KIND=wp), DIMENSION(kptsi,kptsj,kpk,kobs), INTENT(OUT) ::&
+         & pgval            ! Stencil at each point
+      !! * Local declarations
+      INTEGER ::  ji
+      INTEGER ::  jj
+      INTEGER ::  jk
+      INTEGER ::  jobs
+
+      ! Check valid points
+
+      IF ( ( MAXVAL(kgrdi) > jpi ) .OR. ( MINVAL(kgrdi) < 1 ) .OR. &
+         & ( MAXVAL(kgrdj) > jpj ) .OR. ( MINVAL(kgrdj) < 1 ) ) THEN
+         
+         CALL ctl_stop( 'Error in obs_int_comm_3d_local', &
+            &           'Point outside local domain' )
+         
+      ENDIF
+
+      ! Copy local data
+
+      DO jobs = 1, kobs
+         DO jj = 1, kptsj
+            DO ji = 1, kptsi
+               DO jk = 1, kpk
+                  pgval(ji,jj,jk,jobs) = &
+                     &            pval(kgrdi(ji,jj,jobs),kgrdj(ji,jj,jobs),jk)
+               END DO
+            END DO
+         END DO
+      END DO
+
+   END SUBROUTINE obs_int_comm_3d_local
+
+END MODULE obs_inter_sup
+ 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_inter_z1d.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_level_search.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_mpp.F90	(revision 3437)
@@ -0,0 +1,498 @@
+MODULE obs_mpp
+   !!======================================================================
+   !!                       ***  MODULE obs_mpp  ***
+   !! Observation diagnostics: Various MPP support routines
+   !!======================================================================
+   !! History :  2.0  ! 2006-03  (K. Mogensen)  Original code
+   !!             -   ! 2006-05  (K. Mogensen)  Reformatted
+   !!             -   ! 2008-01  (K. Mogensen)  add mpp_global_max
+   !!----------------------------------------------------------------------
+#  define mpivar mpi_double_precision
+   !!----------------------------------------------------------------------
+   !! obs_mpp_bcast_integer : Broadcast an integer array from a processor to all processors
+   !! obs_mpp_max_integer   : Find maximum on all processors of each value in an integer on all processors
+   !! obs_mpp_find_obs_proc : Find processors which should hold the observations
+   !! obs_mpp_sum_integers  : Sum an integer array from all processors
+   !! obs_mpp_sum_integer   : Sum an integer from all processors
+   !!----------------------------------------------------------------------
+   USE dom_oce, ONLY :   nproc, mig, mjg   ! Ocean space and time domain variables
+   USE mpp_map, ONLY :   mppmap
+   USE in_out_manager
+#if defined key_mpp_mpi
+   USE lib_mpp, ONLY :   mpi_comm_opa      ! MPP library
+#endif
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC obs_mpp_bcast_integer, & !: Broadcast an integer array from a proc to all procs
+      &   obs_mpp_max_integer,   & !: Find maximum across processors in an integer array
+      &   obs_mpp_find_obs_proc, & !: Find processors which should hold the observations
+      &   obs_mpp_sum_integers,  & !: Sum an integer array from all processors
+      &   obs_mpp_sum_integer,   & !: Sum an integer from all processors
+      &   mpp_alltoall_int,      &
+      &   mpp_alltoallv_int,     &
+      &   mpp_alltoallv_real,    &
+      &   mpp_global_max
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obs_mpp_bcast_integer( kvals, kno, kroot )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Send array kvals to all processors
+      !!
+      !! ** Method  : MPI broadcast
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array
+      INTEGER                , INTENT(in   ) ::   kroot   ! Processor to send data
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr 
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      ! Call the MPI library to broadcast data
+      CALL mpi_bcast( kvals, kno, mpi_integer,  &
+         &            kroot, mpi_comm_opa, ierr )
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE obs_mpp_bcast_integer
+
+  
+   SUBROUTINE obs_mpp_max_integer( kvals, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_bcast_integer ***
+      !!          
+      !! ** Purpose : Find maximum across processors in an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!              MPI_COMM_OPA needs to be replace for OASIS4.!
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno     ! Number of elements in array
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kvals   ! Array to send on kroot, receive for non-kroot  
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr 
+      INTEGER, DIMENSION(kno) ::   ivals
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      ! Call the MPI library to find the maximum across processors
+      CALL mpi_allreduce( kvals, ivals, kno, mpi_integer,   &
+         &                mpi_max, mpi_comm_opa, ierr )
+      kvals(:) = ivals(:)
+#else
+      ! no MPI: empty routine
+#endif
+   END SUBROUTINE obs_mpp_max_integer
+
+
+   SUBROUTINE obs_mpp_find_obs_proc( kobsp, kobsi, kobsj, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_find_obs_proc ***
+      !!          
+      !! ** Purpose : From the array kobsp containing the results of the grid
+      !!              grid search on each processor the processor return a
+      !!              decision of which processors should hold the observation.
+      !!
+      !! ** Method  : A temporary 2D array holding all the decisions is
+      !!              constructed using mpi_allgather on each processor.
+      !!              If more than one processor has found the observation
+      !!              with the observation in the inner domain gets it
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) ::   kno
+      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kobsi, kobsj
+      INTEGER, DIMENSION(kno), INTENT(inout) ::   kobsp
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: size
+      INTEGER :: ierr
+      INTEGER :: iobsip
+      INTEGER :: iobsjp
+      INTEGER :: num_sus_obs
+      INTEGER, DIMENSION(kno) ::   iobsig, iobsjg
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iobsp, iobsi, iobsj
+      !!
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the maximum accross processors
+      !-----------------------------------------------------------------------
+      CALL mpi_comm_size( mpi_comm_opa, size, ierr )
+      !-----------------------------------------------------------------------
+      ! Convert local grids points to global grid points
+      !-----------------------------------------------------------------------
+      DO ji = 1, kno
+         IF ( ( kobsi(ji) >= 1 ) .AND. ( kobsi(ji) <= jpi ) .AND. &
+            & ( kobsj(ji) >= 1 ) .AND. ( kobsj(ji) <= jpj ) ) THEN
+            iobsig(ji) = mig( kobsi(ji) )
+            iobsjg(ji) = mjg( kobsj(ji) )
+         ELSE
+            iobsig(ji) = -1
+            iobsjg(ji) = -1
+         ENDIF
+      END DO
+      !-----------------------------------------------------------------------
+      ! Get the decisions from all processors
+      !-----------------------------------------------------------------------
+      ALLOCATE( iobsp(kno,size) )
+      ALLOCATE( iobsi(kno,size) )
+      ALLOCATE( iobsj(kno,size) )
+      CALL mpi_allgather( kobsp, kno, mpi_integer, &
+         &                iobsp, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsig, kno, mpi_integer, &
+         &                iobsi, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+      CALL mpi_allgather( iobsjg, kno, mpi_integer, &
+         &                iobsj, kno, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+
+      !-----------------------------------------------------------------------
+      ! Find the processor with observations from the lowest processor 
+      ! number among processors holding the observation.
+      !-----------------------------------------------------------------------
+      kobsp(:) = -1
+      num_sus_obs = 0
+      DO ji = 1, kno
+         DO jj = 1, size
+            IF ( ( kobsp(ji) == -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               kobsp(ji) = iobsp(ji,jj)
+               iobsip = iobsi(ji,jj)
+               iobsjp = iobsj(ji,jj)
+            ENDIF
+            IF ( ( kobsp(ji) /= -1 ) .AND. ( iobsp(ji,jj) /= -1 ) ) THEN
+               IF ( ( iobsip /= iobsi(ji,jj) ) .OR. &
+                  & ( iobsjp /= iobsj(ji,jj) ) ) THEN
+                  IF ( ( kobsp(ji) < 1000000 ) .AND. &
+                     & ( iobsp(ji,jj) < 1000000 ) ) THEN
+                     num_sus_obs=num_sus_obs+1
+                  ENDIF
+               ENDIF
+               IF ( mppmap(iobsip,iobsjp) /= ( kobsp(ji)+1 ) ) THEN
+                  IF ( ( iobsi(ji,jj) /= -1 ) .AND. &
+                     & ( iobsj(ji,jj) /= -1 ) ) THEN
+                     IF ((mppmap(iobsi(ji,jj),iobsj(ji,jj)) == (iobsp(ji,jj)+1))&
+                        & .OR. ( iobsp(ji,jj) < kobsp(ji) ) ) THEN
+                        kobsp(ji) = iobsp(ji,jj)
+                        iobsip = iobsi(ji,jj)
+                        iobsjp = iobsj(ji,jj)
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+      IF (lwp) WRITE(numout,*) 'Number of suspicious observations: ',num_sus_obs
+
+      DEALLOCATE( iobsj )
+      DEALLOCATE( iobsi )
+      DEALLOCATE( iobsp )
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE obs_mpp_find_obs_proc
+
+
+   SUBROUTINE obs_mpp_sum_integers( kvalsin, kvalsout, kno )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum an integer array.
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                , INTENT(in   ) :: kno
+      INTEGER, DIMENSION(kno), INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(kno), INTENT(  out) ::   kvalsout
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalsin, kvalsout, kno, mpi_integer, &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout(:) = kvalsin(:)
+#endif
+      !
+   END SUBROUTINE obs_mpp_sum_integers
+
+
+   SUBROUTINE obs_mpp_sum_integer( kvalin, kvalout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE obs_mpp_sum_integers ***
+      !!          
+      !! ** Purpose : Sum a single integer
+      !!
+      !! ** Method  : MPI all reduce.
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kvalin
+      INTEGER, INTENT(  out) ::   kvalout
+      !
+#if defined key_mpp_mpi
+      !
+      INTEGER :: ierr
+      !
+INCLUDE 'mpif.h'
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to find the sum across processors
+      !-----------------------------------------------------------------------
+      CALL mpi_allreduce( kvalin, kvalout, 1, mpi_integer,   &
+         &                mpi_sum, mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalout = kvalin
+#endif
+      !
+   END SUBROUTINE obs_mpp_sum_integer
+
+
+   SUBROUTINE mpp_global_max( pval )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_global_or ***
+      !!          
+      !! ** Purpose : Get the maximum value across processors for a global 
+      !!              real array
+      !!
+      !! ** Method  : MPI allreduce
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      REAL(KIND=wp), DIMENSION(jpiglo,jpjglo), INTENT(inout) ::   pval
+      !
+      INTEGER :: ierr
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      REAL(KIND=wp), DIMENSION(:,:), ALLOCATABLE ::   zcp
+      !!----------------------------------------------------------------------
+
+      ! Copy data for input to MPI
+
+      ALLOCATE( &
+         & zcp(jpiglo,jpjglo) &
+         & )
+      zcp(:,:) = pval(:,:)
+
+      ! Call the MPI library to find the coast lines globally
+
+      CALL mpi_allreduce( zcp, pval, jpiglo*jpjglo, mpivar, &
+         &                mpi_max, mpi_comm_opa, ierr )
+
+      DEALLOCATE( &
+         & zcp &
+         & )
+
+#else
+      ! no MPI: empty routine
+#endif
+      !
+   END SUBROUTINE mpp_global_max
+
+
+   SUBROUTINE mpp_alltoall_int( kno, kvalsin, kvalsout )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_allgatherv ***
+      !!          
+      !! ** Purpose : all to all.
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                      , INTENT(in   ) ::   kno
+      INTEGER, DIMENSION(kno*jpnij), INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(kno*jpnij), INTENT(  out) ::   kvalsout
+      !!
+      INTEGER :: ierr
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoall( kvalsin,  kno, mpi_integer, &
+         &               kvalsout, kno, mpi_integer, &
+         &               mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoall_int
+
+
+   SUBROUTINE mpp_alltoallv_int( kvalsin, knoin , kinv , kvalsout,   &
+      &                                   knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_int ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                   , INTENT(in) :: knoin
+      INTEGER                   , INTENT(in) :: knoout
+      INTEGER, DIMENSION(jpnij)                 ::   kinv, koutv
+      INTEGER, DIMENSION(knoin) , INTENT(in   ) ::   kvalsin
+      INTEGER, DIMENSION(knoout), INTENT(  out) ::   kvalsout
+      !!
+      INTEGER :: ierr
+      INTEGER :: jproc
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( kvalsin,  kinv,  isdsp, mpi_integer, &
+         &                kvalsout, koutv, irdsp, mpi_integer, &
+         &                mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      kvalsout = kvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoallv_int
+
+
+   SUBROUTINE mpp_alltoallv_real( pvalsin, knoin , kinv , pvalsout,   &
+      &                                    knoout, koutv )
+      !!----------------------------------------------------------------------
+      !!               ***  ROUTINE mpp_alltoallv_real ***
+      !!          
+      !! ** Purpose : all to all (integer version).
+      !!
+      !! ** Method  : MPI alltoall
+      !!
+      !! ** Action  : This does only work for MPI. 
+      !!              It does not work for SHMEM.
+      !!
+      !! References : http://www.mpi-forum.org
+      !!----------------------------------------------------------------------
+      INTEGER                    , INTENT(in   ) :: knoin
+      INTEGER                    , INTENT(in   ) :: knoout
+      INTEGER , DIMENSION(jpnij)                 ::   kinv, koutv
+      REAL(wp), DIMENSION(knoin) , INTENT(in   ) ::   pvalsin
+      REAL(wp), DIMENSION(knoout), INTENT(  out) ::   pvalsout
+      !!
+      INTEGER :: ierr
+      INTEGER :: jproc
+      !
+#if defined key_mpp_mpi
+      !
+INCLUDE 'mpif.h'
+      INTEGER, DIMENSION(jpnij) ::   irdsp, isdsp
+      !!----------------------------------------------------------------------
+      !
+      !-----------------------------------------------------------------------
+      ! Compute displacements
+      !-----------------------------------------------------------------------
+      irdsp(1) = 0
+      isdsp(1) = 0
+      DO jproc = 2, jpnij
+         isdsp(jproc) = isdsp(jproc-1) + kinv(jproc-1)
+         irdsp(jproc) = irdsp(jproc-1) + koutv(jproc-1)
+      END DO
+      !-----------------------------------------------------------------------
+      ! Call the MPI library to do the all to all operation of the data
+      !-----------------------------------------------------------------------
+      CALL mpi_alltoallv( pvalsin,  kinv,  isdsp, mpivar, &
+         &                pvalsout, koutv, irdsp, mpivar, &
+         &                mpi_comm_opa, ierr )
+#else
+      !-----------------------------------------------------------------------
+      ! For no-MPP just return input values
+      !-----------------------------------------------------------------------
+      pvalsout = pvalsin
+#endif
+      !
+   END SUBROUTINE mpp_alltoallv_real
+
+   !!======================================================================
+END MODULE obs_mpp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_oper.F90	(revision 3437)
@@ -0,0 +1,1333 @@
+MODULE obs_oper
+   !!======================================================================
+   !!                       ***  MODULE obs_oper  ***
+   !! Observation diagnostics: Observation operators for various observation
+   !!                          types
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_pro_opt :    Compute the model counterpart of temperature and
+   !!                    salinity observations from profiles
+   !!   obs_sla_opt :    Compute the model counterpart of sea level anomaly
+   !!                    observations
+   !!   obs_sst_opt :    Compute the model counterpart of sea surface temperature
+   !!                    observations
+   !!   obs_sss_opt :    Compute the model counterpart of sea surface salinity
+   !!                    observations
+   !!   obs_seaice_opt : Compute the model counterpart of sea ice concentration
+   !!                    observations
+   !!
+   !!   obs_vel_opt :    Compute the model counterpart of zonal and meridional
+   !!                    components of velocity from observations.
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind, ONLY : &         ! Precision variables
+      & wp
+   USE in_out_manager             ! I/O manager
+   USE obs_inter_sup              ! Interpolation support
+   USE obs_inter_h2d, ONLY : &    ! Horizontal interpolation to the observation pt
+      & obs_int_h2d, &
+      & obs_int_h2d_init
+   USE obs_inter_z1d, ONLY : &    ! Vertical interpolation to the observation pt
+      & obs_int_z1d,    &
+      & obs_int_z1d_spl
+   USE obs_const,  ONLY :     &
+      & obfillflt		  ! Fillvalue   
+   USE dom_oce,       ONLY : &
+      & glamt, glamu, glamv, &
+      & gphit, gphiu, gphiv
+   USE lib_mpp,       ONLY : &
+      & ctl_warn, ctl_stop
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_pro_opt, &  ! Compute the model counterpart of profile observations
+      &   obs_sla_opt, &  ! Compute the model counterpart of SLA observations
+      &   obs_sst_opt, &  ! Compute the model counterpart of SST observations
+      &   obs_sss_opt, &  ! Compute the model counterpart of SSS observations
+      &   obs_seaice_opt, &
+      &   obs_vel_opt     ! Compute the model counterpart of velocity profile data
+
+   INTEGER, PARAMETER, PUBLIC :: imaxavtypes = 20 ! Max number of daily avgd obs types
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_pro_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    ptn, psn, pgdept, ptmask, k1dint, k2dint, &
+      &                    kdailyavtypes )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_pro_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of profiles
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    First, a vertical profile of horizontally interpolated model
+      !!    now temperatures is computed at the obs (lon, lat) point.
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!    Next, the vertical temperature profile is interpolated to the
+      !!    data depth points. Two vertical interpolation schemes are
+      !!    available:
+      !!        - linear       (k1dint = 0)
+      !!        - Cubic spline (k1dint = 1)
+      !!
+      !!    For the cubic spline the 2nd derivative of the interpolating 
+      !!    polynomial is computed before entering the vertical interpolation 
+      !!    routine.
+      !!
+      !!    For ENACT moored buoy data (e.g., TAO), the model equivalent is
+      !!    a daily mean model temperature field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !!    Note: the in situ temperature observations must be converted
+      !!    to potential temperature (the model variable) prior to
+      !!    assimilation. 
+      !!??????????????????????????????????????????????????????????????
+      !!    INCLUDE POTENTIAL TEMP -> IN SITU TEMP IN OBS OPERATOR???
+      !!??????????????????????????????????????????????????????????????
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 97-11 (A. Weaver, S. Ricci, N. Daget)
+      !!      ! 06-03 (G. Smith) NEMOVAR migration
+      !!      ! 06-10 (A. Weaver) Cleanup
+      !!      ! 07-01 (K. Mogensen) Merge of temperature and salinity
+      !!      ! 07-03 (K. Mogensen) General handling of profiles
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc  ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & ptn,    &    ! Model temperature field
+         & psn,    &    ! Model salinity field
+         & ptmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations
+      INTEGER ::   ji
+      INTEGER ::   jj
+      INTEGER ::   jk
+      INTEGER ::   jobs
+      INTEGER ::   inrc
+      INTEGER ::   ipro
+      INTEGER ::   idayend
+      INTEGER ::   ista
+      INTEGER ::   iend
+      INTEGER ::   iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmask, &
+         & zobsk,    &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zintt, &
+         & zints, &
+         & zinmt, &
+         & zinms
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+ 
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = 0.0
+                  prodatqc%vdmean(ji,jj,jk,2) = 0.0
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ! Increment the temperature field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                  &                        + ptn(ji,jj,jk)
+               ! Increment the salinity field for computing daily mean
+               prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                        + psn(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  prodatqc%vdmean(ji,jj,jk,1) = prodatqc%vdmean(ji,jj,jk,1) &
+                     &                        * zdaystp
+                  prodatqc%vdmean(ji,jj,jk,2) = prodatqc%vdmean(ji,jj,jk,2) &
+                  &                           * zdaystp
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdi(2,2,ipro),      &
+         & igrdj(2,2,ipro),      &
+         & zglam(2,2,ipro),      &
+         & zgphi(2,2,ipro),      &
+         & zmask(2,2,kpk,ipro),  &
+         & zintt(2,2,kpk,ipro),  &
+         & zints(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdi(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdj(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdi(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdi(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdj(2,2,iobs) = prodatqc%mj(jobs,1)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptmask,zmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, ptn,   zintt )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, psn,   zints )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmt(2,2,kpk,ipro),  &
+            & zinms(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmt )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdi, igrdj, &
+            &                  prodatqc%vdmean(:,:,:,2), zinms )
+
+      ENDIF
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+         
+         ! Horizontal weights and vertical mask
+
+         IF ( ( prodatqc%npvend(jobs,1) > 0 ) .OR. &
+            & ( prodatqc%npvend(jobs,2) > 0 ) ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+               &                   zmask(:,:,:,iobs), zweig, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinmt(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile T BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zintt(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ANY (idailyavtypes(:) == prodatqc%ntyp(jobs)) ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged moored buoy (MRB) data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweig, zinms(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of profile S BUOY data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweig, zints(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zintt, &
+         & zints  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmt,  &
+            & zinms   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_pro_opt
+
+   SUBROUTINE obs_sla_opt( sladatqc, kt, kpi, kpj, kit000, &
+      &                    psshn, psshmask, k2dint )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sla_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea level anomaly
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SSH is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!  
+      !!    The sea level anomaly at the observation points is then computed 
+      !!    by removing a mean dynamic topography (defined at the obs. point).
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 07-03 (A. Weaver)
+      !!-----------------------------------------------------------------------
+  
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt      ! Time step
+      INTEGER, INTENT(IN) :: kpi     ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psshn,  &    ! Model SSH field
+         & psshmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isla
+      INTEGER :: iobs
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zsshl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isla = sladatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+
+      ALLOCATE( &
+         & igrdi(2,2,isla), &
+         & igrdj(2,2,isla), &
+         & zglam(2,2,isla), &
+         & zgphi(2,2,isla), &
+         & zmask(2,2,isla), &
+         & zsshl(2,2,isla)  &
+         & )
+      
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+         iobs = jobs - sladatqc%nsurfup
+         igrdi(1,1,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sladatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sladatqc%mj(jobs)
+         igrdi(2,1,iobs) = sladatqc%mi(jobs)
+         igrdj(2,1,iobs) = sladatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sladatqc%mi(jobs)
+         igrdj(2,2,iobs) = sladatqc%mj(jobs)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isla, &
+         &                  igrdi, igrdj, psshn, zsshl )
+
+      ! Loop over observations
+
+      DO jobs = sladatqc%nsurfup + 1, sladatqc%nsurfup + isla
+
+         iobs = jobs - sladatqc%nsurfup
+
+         IF ( kt /= sladatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sladatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sladatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sla_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sladatqc%rlam(jobs)
+         zphi = sladatqc%rphi(jobs)
+
+         ! Get weights to interpolate the model SSH to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+
+         ! Interpolate the model SSH to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsshl(:,:,iobs),  zext )
+         
+         sladatqc%rext(jobs,1) = zext(1)
+         ! ... Remove the MDT at the observation point
+         sladatqc%rmod(jobs,1) = sladatqc%rext(jobs,1) - sladatqc%rext(jobs,2)
+
+      END DO
+
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsshl  &
+         & )
+
+      sladatqc%nsurfup = sladatqc%nsurfup + isla
+
+   END SUBROUTINE obs_sla_opt
+
+   SUBROUTINE obs_sst_opt( sstdatqc, kt, kpi, kpj, kit000, &
+      &                    psstn, psstmask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sst_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model SST is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & sstdatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & psstn,  &    ! Model SST field
+         & psstmask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: isst
+      INTEGER :: iobs
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zsstl, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !-----------------------------------------------------------------------
+      ! Local initialization 
+      !-----------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      isst = sstdatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,isst), &
+         & igrdj(2,2,isst), &
+         & zglam(2,2,isst), &
+         & zgphi(2,2,isst), &
+         & zmask(2,2,isst), &
+         & zsstl(2,2,isst)  &
+         & )
+      
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         iobs = jobs - sstdatqc%nsurfup
+         igrdi(1,1,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = sstdatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = sstdatqc%mj(jobs)
+         igrdi(2,1,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,1,iobs) = sstdatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = sstdatqc%mi(jobs)
+         igrdj(2,2,iobs) = sstdatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstmask, zmask )
+      CALL obs_int_comm_2d( 2, 2, isst, &
+         &                  igrdi, igrdj, psstn, zsstl )
+      
+      ! Loop over observations
+
+      DO jobs = sstdatqc%nsurfup + 1, sstdatqc%nsurfup + isst
+         
+         iobs = jobs - sstdatqc%nsurfup
+         
+         IF ( kt /= sstdatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', sstdatqc%mstp(jobs), &
+                  &            ' ntyp    = ', sstdatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_sst_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = sstdatqc%rlam(jobs)
+         zphi = sstdatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model SST to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+            
+         ! Interpolate the model SST to the observation point 
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zsstl(:,:,iobs),  zext )
+         
+         sstdatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi, &
+         & igrdj, &
+         & zglam, &
+         & zgphi, &
+         & zmask, &
+         & zsstl  &
+         & )
+      
+      sstdatqc%nsurfup = sstdatqc%nsurfup + isst
+
+   END SUBROUTINE obs_sst_opt
+
+   SUBROUTINE obs_sss_opt
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_sss_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of sea surface salinity
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! ??-?? 
+      !!-----------------------------------------------------------------------
+
+      IMPLICIT NONE
+
+   END SUBROUTINE obs_sss_opt
+
+   SUBROUTINE obs_seaice_opt( seaicedatqc, kt, kpi, kpj, kit000, &
+      &                    pseaicen, pseaicemask, k2dint )
+
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_seaice_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of surface temperature
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate to each observation point using 
+      !!              the model values at the corners of the surrounding grid box.
+      !!
+      !!    The now model sea ice is first computed at the obs (lon, lat) point.
+      !!
+      !!    Several horizontal interpolation schemes are available:
+      !!        - distance-weighted (great circle) (k2dint = 0)
+      !!        - distance-weighted (small angle)  (k2dint = 1)
+      !!        - bilinear (geographical grid)     (k2dint = 2)
+      !!        - bilinear (quadrilateral grid)    (k2dint = 3)
+      !!        - polynomial (quadrilateral grid)  (k2dint = 4)
+      !!
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  07-07  (S. Ricci ) : Original
+      !!      
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      USE obs_surf_def  ! Definition of storage space for surface observations
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc     ! Subset of surface data not failing screening
+      INTEGER, INTENT(IN) :: kt       ! Time step
+      INTEGER, INTENT(IN) :: kpi      ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kit000   ! Number of the first time step 
+                                      !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k2dint   ! Horizontal interpolation type (see header)
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj) :: &
+         & pseaicen,  &    ! Model sea ice field
+         & pseaicemask     ! Land-sea mask
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: iseaice
+      INTEGER :: iobs
+       
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zext(1), zobsmask(1)
+      REAL(kind=wp), DIMENSION(2,2,1) :: &
+         & zweig
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zmask, &
+         & zseaicel, &
+         & zglam, &
+         & zgphi
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdi, &
+         & igrdj
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      iseaice = seaicedatqc%nsstp(inrc)
+
+      ! Get the data for interpolation
+      
+      ALLOCATE( &
+         & igrdi(2,2,iseaice), &
+         & igrdj(2,2,iseaice), &
+         & zglam(2,2,iseaice), &
+         & zgphi(2,2,iseaice), &
+         & zmask(2,2,iseaice), &
+         & zseaicel(2,2,iseaice)  &
+         & )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         iobs = jobs - seaicedatqc%nsurfup
+         igrdi(1,1,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(1,2,iobs) = seaicedatqc%mi(jobs)-1
+         igrdj(1,2,iobs) = seaicedatqc%mj(jobs)
+         igrdi(2,1,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,1,iobs) = seaicedatqc%mj(jobs)-1
+         igrdi(2,2,iobs) = seaicedatqc%mi(jobs)
+         igrdj(2,2,iobs) = seaicedatqc%mj(jobs)
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, glamt, zglam )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, gphit, zgphi )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicemask, zmask )
+      CALL obs_int_comm_2d( 2, 2, iseaice, &
+         &                  igrdi, igrdj, pseaicen, zseaicel )
+      
+      DO jobs = seaicedatqc%nsurfup + 1, seaicedatqc%nsurfup + iseaice
+         
+         iobs = jobs - seaicedatqc%nsurfup
+         
+         IF ( kt /= seaicedatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                &
+                  &            ' kt      = ', kt,                  &
+                  &            ' mstp    = ', seaicedatqc%mstp(jobs), &
+                  &            ' ntyp    = ', seaicedatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_seaice_opt', 'Inconsistent time' )
+            
+         ENDIF
+         
+         zlam = seaicedatqc%rlam(jobs)
+         zphi = seaicedatqc%rphi(jobs)
+         
+         ! Get weights to interpolate the model sea ice to the observation point
+         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+            &                   zglam(:,:,iobs), zgphi(:,:,iobs), &
+            &                   zmask(:,:,iobs), zweig, zobsmask )
+         
+         ! ... Interpolate the model sea ice to the observation point
+         CALL obs_int_h2d( 1, 1,      &
+            &              zweig, zseaicel(:,:,iobs),  zext )
+         
+         seaicedatqc%rmod(jobs,1) = zext(1)
+         
+      END DO
+      
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdi,    &
+         & igrdj,    &
+         & zglam,    &
+         & zgphi,    &
+         & zmask,    &
+         & zseaicel  &
+         & )
+      
+      seaicedatqc%nsurfup = seaicedatqc%nsurfup + iseaice
+
+   END SUBROUTINE obs_seaice_opt
+
+   SUBROUTINE obs_vel_opt( prodatqc, kt, kpi, kpj, kpk, kit000, kdaystp, &
+      &                    pun, pvn, pgdept, pumask, pvmask, k1dint, k2dint, &
+      &                    ld_dailyav )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE obs_vel_opt  ***
+      !!
+      !! ** Purpose : Compute the model counterpart of velocity profile
+      !!              data by interpolating from the model grid to the 
+      !!              observation point.
+      !!
+      !! ** Method  : Linearly interpolate zonal and meridional components of velocity 
+      !!              to each observation point using the model values at the corners of 
+      !!              the surrounding grid box. The model velocity components are on a 
+      !!              staggered C- grid.
+      !!
+      !!    For velocity data from the TAO array, the model equivalent is
+      !!    a daily mean velocity field. So, we first compute
+      !!    the mean, then interpolate only at the end of the day.
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!    ! 07-03 (K. Mogensen)      : Temperature and Salinity profiles
+      !!    ! 08-10 (Maria Valdivieso) : Velocity component (U,V) profiles
+      !!-----------------------------------------------------------------------
+    
+      !! * Modules used
+      USE obs_profiles_def ! Definition of storage space for profile obs.
+
+      IMPLICIT NONE
+
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prodatqc        ! Subset of profile data not failing screening
+      INTEGER, INTENT(IN) :: kt        ! Time step
+      INTEGER, INTENT(IN) :: kpi       ! Model grid parameters
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk 
+      INTEGER, INTENT(IN) :: kit000    ! Number of the first time step 
+                                       !   (kit000-1 = restart time)
+      INTEGER, INTENT(IN) :: k1dint    ! Vertical interpolation type (see header)
+      INTEGER, INTENT(IN) :: k2dint    ! Horizontal interpolation type (see header)
+      INTEGER, INTENT(IN) :: kdaystp   ! Number of time steps per day                    
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpi,kpj,kpk) :: &
+         & pun,    &    ! Model zonal component of velocity
+         & pvn,    &    ! Model meridional component of velocity
+         & pumask, &    ! Land-sea mask
+         & pvmask       ! Land-sea mask
+      REAL(KIND=wp), INTENT(IN), DIMENSION(kpk) :: &
+         & pgdept       ! Model array of depth levels
+      LOGICAL, INTENT(IN) :: ld_dailyav
+         
+      !! * Local declarations
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: inrc
+      INTEGER :: ipro
+      INTEGER :: idayend
+      INTEGER :: ista
+      INTEGER :: iend
+      INTEGER :: iobs
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(KIND=wp) :: zlam
+      REAL(KIND=wp) :: zphi
+      REAL(KIND=wp) :: zdaystp
+      REAL(KIND=wp), DIMENSION(kpk) :: &
+         & zobsmasku, &
+         & zobsmaskv, &
+         & zobsmask,  &
+         & zobsk,     &
+         & zobs2k
+      REAL(KIND=wp), DIMENSION(2,2,kpk) :: &
+         & zweigu,zweigv
+      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv, &
+         & zinmu, &
+         & zinmv
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv
+      INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv
+
+      !------------------------------------------------------------------------
+      ! Local initialization 
+      !------------------------------------------------------------------------
+      ! ... Record and data counters
+      inrc = kt - kit000 + 2
+      ipro = prodatqc%npstp(inrc)
+
+      ! Initialize daily mean for first timestep
+      idayend = MOD( kt - kit000 + 1, kdaystp )
+
+      ! Added kt == 0 test to catch restart case 
+      IF ( idayend == 1 .OR. kt == 0) THEN
+         IF (lwp) WRITE(numout,*) 'Reset prodatqc%vdmean on time-step: ',kt
+         prodatqc%vdmean(:,:,:,1) = 0.0
+         prodatqc%vdmean(:,:,:,2) = 0.0
+      ENDIF
+
+      ! Increment the zonal velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) + pun(:,:,:)
+      ! Increment the meridional velocity field for computing daily mean
+      prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) + pvn(:,:,:)
+   
+      ! Compute the daily mean at the end of day
+      zdaystp = 1.0 / REAL( kdaystp )
+      IF ( idayend == 0 ) THEN
+         prodatqc%vdmean(:,:,:,1) = prodatqc%vdmean(:,:,:,1) * zdaystp
+         prodatqc%vdmean(:,:,:,2) = prodatqc%vdmean(:,:,:,2) * zdaystp
+      ENDIF
+
+      ! Get the data for interpolation
+      ALLOCATE( &
+         & igrdiu(2,2,ipro),      &
+         & igrdju(2,2,ipro),      &
+         & igrdiv(2,2,ipro),      &
+         & igrdjv(2,2,ipro),      &
+         & zglamu(2,2,ipro), zglamv(2,2,ipro), &
+         & zgphiu(2,2,ipro), zgphiv(2,2,ipro), &
+         & zumask(2,2,kpk,ipro), zvmask(2,2,kpk,ipro), &
+         & zintu(2,2,kpk,ipro),  &
+         & zintv(2,2,kpk,ipro)   &
+         & )
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+         iobs = jobs - prodatqc%nprofup
+         igrdiu(1,1,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(1,2,iobs) = prodatqc%mi(jobs,1)-1
+         igrdju(1,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiu(2,1,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,1,iobs) = prodatqc%mj(jobs,1)-1
+         igrdiu(2,2,iobs) = prodatqc%mi(jobs,1)
+         igrdju(2,2,iobs) = prodatqc%mj(jobs,1)
+         igrdiv(1,1,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(1,2,iobs) = prodatqc%mi(jobs,2)-1
+         igrdjv(1,2,iobs) = prodatqc%mj(jobs,2)
+         igrdiv(2,1,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,1,iobs) = prodatqc%mj(jobs,2)-1
+         igrdiv(2,2,iobs) = prodatqc%mi(jobs,2)
+         igrdjv(2,2,iobs) = prodatqc%mj(jobs,2)
+      END DO
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiu, igrdju, gphiu, zgphiu )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pumask, zumask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, pun, zintu )
+
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, ipro, igrdiv, igrdjv, gphiv, zgphiv )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvmask, zvmask )
+      CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, pvn, zintv )
+
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+
+         ALLOCATE( &
+            & zinmu(2,2,kpk,ipro),  &
+            & zinmv(2,2,kpk,ipro)   &
+            & )
+
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiu, igrdju, &
+            &                  prodatqc%vdmean(:,:,:,1), zinmu )
+         CALL obs_int_comm_3d( 2, 2, ipro, kpk, igrdiv, igrdjv, &
+            &                  prodatqc%vdmean(:,:,:,2), zinmv )
+
+      ENDIF
+
+! loop over observations
+
+      DO jobs = prodatqc%nprofup + 1, prodatqc%nprofup + ipro
+
+         iobs = jobs - prodatqc%nprofup
+
+         IF ( kt /= prodatqc%mstp(jobs) ) THEN
+            
+            IF(lwp) THEN
+               WRITE(numout,*)
+               WRITE(numout,*) ' E R R O R : Observation',              &
+                  &            ' time step is not consistent with the', &
+                  &            ' model time step'
+               WRITE(numout,*) ' ========='
+               WRITE(numout,*)
+               WRITE(numout,*) ' Record  = ', jobs,                    &
+                  &            ' kt      = ', kt,                      &
+                  &            ' mstp    = ', prodatqc%mstp(jobs), &
+                  &            ' ntyp    = ', prodatqc%ntyp(jobs)
+            ENDIF
+            CALL ctl_stop( 'obs_pro_opt', 'Inconsistent time' )
+         ENDIF
+         
+         zlam = prodatqc%rlam(jobs)
+         zphi = prodatqc%rphi(jobs)
+
+         ! Initialize observation masks
+
+         zobsmasku(:) = 0.0
+         zobsmaskv(:) = 0.0
+         
+         ! Horizontal weights and vertical mask
+
+         IF  ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamu(:,:,iobs), zgphiu(:,:,iobs), &
+               &                   zumask(:,:,:,iobs), zweigu, zobsmasku )
+
+         ENDIF
+
+         
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            CALL obs_int_h2d_init( kpk, kpk, k2dint, zlam, zphi,     &
+               &                   zglamv(:,:,iobs), zgphiv(:,:,iobs), &
+               &                   zvmask(:,:,:,iobs), zweigv, zobsmasku )
+
+         ENDIF
+
+         ! Ensure that the vertical mask on u and v are consistent.
+
+         zobsmask(:) = MIN( zobsmasku(:), zobsmaskv(:) )
+
+         IF ( prodatqc%npvend(jobs,1) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+	    IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+                  
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigu, zinmu(:,:,:,iobs), zobsk )
+                  
+                  
+               ELSE
+               
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of U profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+	       
+            ELSE 
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigu, zintu(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k,   &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !-----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !-----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,1)
+            iend = prodatqc%npvend(jobs,1)
+            CALL obs_int_z1d( kpk,                &
+               & prodatqc%var(1)%mvk(ista:iend),  &
+               & k1dint, iend - ista + 1,         &
+               & prodatqc%var(1)%vdep(ista:iend), &
+               & zobsk, zobs2k,                   &
+               & prodatqc%var(1)%vmod(ista:iend), &
+               & pgdept, zobsmask )
+
+         ENDIF
+
+         IF ( prodatqc%npvend(jobs,2) > 0 ) THEN
+
+            zobsk(:) = obfillflt
+
+            IF ( ld_dailyav ) THEN
+
+               IF ( idayend == 0 )  THEN
+
+                  ! Daily averaged data
+                  
+                  CALL obs_int_h2d( kpk, kpk,      &
+                     &              zweigv, zinmv(:,:,:,iobs), zobsk )
+                  
+               ELSE
+
+                  CALL ctl_stop( ' A nonzero' //     &
+                     &           ' number of V profile data should' // &
+                     &           ' only occur at the end of a given day' )
+
+               ENDIF
+
+            ELSE
+               
+               ! Point data
+
+               CALL obs_int_h2d( kpk, kpk,      &
+                  &              zweigv, zintv(:,:,:,iobs), zobsk )
+
+            ENDIF
+
+
+            !-------------------------------------------------------------
+            ! Compute vertical second-derivative of the interpolating 
+            ! polynomial at obs points
+            !-------------------------------------------------------------
+            
+            IF ( k1dint == 1 ) THEN
+               CALL obs_int_z1d_spl( kpk, zobsk, zobs2k, &
+                  &                  pgdept, zobsmask )
+            ENDIF
+            
+            !----------------------------------------------------------------
+            !  Vertical interpolation to the observation point
+            !----------------------------------------------------------------
+            ista = prodatqc%npvsta(jobs,2)
+            iend = prodatqc%npvend(jobs,2)
+            CALL obs_int_z1d( kpk, &
+               & prodatqc%var(2)%mvk(ista:iend),&
+               & k1dint, iend - ista + 1, &
+               & prodatqc%var(2)%vdep(ista:iend),&
+               & zobsk, zobs2k, &
+               & prodatqc%var(2)%vmod(ista:iend),&
+               & pgdept, zobsmask )
+
+         ENDIF
+
+      END DO
+ 
+      ! Deallocate the data for interpolation
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamu, zglamv, &
+         & zgphiu, zgphiv, &
+         & zumask, zvmask, &
+         & zintu, &
+         & zintv  &
+         & )
+      ! At the end of the day also get interpolated means
+      IF ( idayend == 0 ) THEN
+         DEALLOCATE( &
+            & zinmu,  &
+            & zinmv   &
+            & )
+      ENDIF
+
+      prodatqc%nprofup = prodatqc%nprofup + ipro 
+      
+   END SUBROUTINE obs_vel_opt
+
+END MODULE obs_oper
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90	(revision 3437)
@@ -0,0 +1,1973 @@
+MODULE obs_prep
+   !!=====================================================================
+   !!                       ***  MODULE  obs_prep  ***
+   !! Observation diagnostics: Prepare observation arrays: screening, 
+   !!                          sorting, coordinate search
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !!   obs_pre_pro  : First level check and screening of T/S profiles
+   !!   obs_pre_sla  : First level check and screening of SLA observations
+   !!   obs_pre_sst  : First level check and screening of SLA observations
+   !!   obs_pre_seaice : First level check and screening of sea ice observations
+   !!   obs_pre_vel  : First level check and screening of velocity obs.
+   !!   obs_scr      : Basic screening of the observations
+   !!   obs_coo_tim  : Compute number of time steps to the observation time
+   !!   obs_sor      : Sort the observation arrays
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp   
+   USE in_out_manager     ! I/O manager
+   USE obs_profiles_def   ! Definitions for storage arrays for profiles
+   USE obs_surf_def       ! Definitions for storage arrays for surface data
+   USE obs_mpp, ONLY : &  ! MPP support routines for observation diagnostics
+      & obs_mpp_sum_integer, &
+      & obs_mpp_sum_integers
+   USE obs_inter_sup      ! Interpolation support
+   USE obs_oper           ! Observation operators
+   USE lib_mpp, ONLY : &
+      & ctl_warn, ctl_stop
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_pre_pro, &    ! First level check and screening of profiles
+      & obs_pre_sla, &    ! First level check and screening of SLA data
+      & obs_pre_sst, &    ! First level check and screening of SLA data
+      & obs_pre_seaice, & ! First level check and screening of sea ice data
+      & obs_pre_vel, &     ! First level check and screening of velocity profiles
+      & calc_month_len     ! Calculate the number of days in the months of a year  
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_pre_pro( profdata, prodatqc, ld_t3d, ld_s3d, ld_nea, &
+      &                    kdailyavtypes )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_pro  ***
+      !!
+      !! ** Purpose : First level check and screening of T and S profiles
+      !!
+      !! ** Method  : First level check and screening of T and S profiles
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Merge of obs_pre_t3d and obs_pre_s3d 
+      !!        !  2007-03  (K. Mogensen) General handling of profiles
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & gdept_0, &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc     ! Subset of profile data not failing screening
+      LOGICAL, INTENT(IN) :: ld_t3d         ! Switch for temperature
+      LOGICAL, INTENT(IN) :: ld_s3d         ! Switch for salinity
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes! Types for daily averages
+      !! * Local declarations   
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0
+      INTEGER :: imin0
+      INTEGER :: icycle        ! Current assimilation cycle
+                               ! Counters for observations that
+      INTEGER :: iotdobs       !  - outside time domain
+      INTEGER :: iosdtobs      !  - outside space domain (temperature)
+      INTEGER :: iosdsobs      !  - outside space domain (salinity)
+      INTEGER :: ilantobs      !  - within a model land cell (temperature)
+      INTEGER :: ilansobs      !  - within a model land cell (salinity)
+      INTEGER :: inlatobs      !  - close to land (temperature)
+      INTEGER :: inlasobs      !  - close to land (salinity)
+      INTEGER :: igrdobs       !  - fail the grid search
+                               ! Global counters for observations that
+      INTEGER :: iotdobsmpp    !  - outside time domain
+      INTEGER :: iosdtobsmpp   !  - outside space domain (temperature)
+      INTEGER :: iosdsobsmpp   !  - outside space domain (salinity)
+      INTEGER :: ilantobsmpp   !  - within a model land cell (temperature)
+      INTEGER :: ilansobsmpp   !  - within a model land cell (salinity)
+      INTEGER :: inlatobsmpp   !  - close to land (temperature)
+      INTEGER :: inlasobsmpp   !  - close to land (salinity)
+      INTEGER :: igrdobsmpp    !  - fail the grid search
+      TYPE(obs_prof_valid) ::  llvalid     ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid            ! T,S selection 
+      INTEGER :: jvar          ! Variable loop variable
+      INTEGER :: jobs          ! Obs. loop variable
+      INTEGER :: jstp          ! Time loop variable
+      INTEGER :: inrc          ! Time index variable
+      
+      IF(lwp) WRITE(numout,*)'obs_pre_pro : Preparing the profile observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdtobs = 0
+      iosdsobs = 0
+      ilantobs = 0
+      ilansobs = 0
+      inlatobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs, kdailyavtypes = kdailyavtypes        )
+      ELSE
+         CALL obs_coo_tim_prof( icycle, &
+            &                iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+            &                profdata%nprof,   profdata%nyea, profdata%nmon, &
+            &                profdata%nday,    profdata%nhou, profdata%nmin, &
+            &                profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+            &                iotdobs )
+      ENDIF
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi, profdata%mj, &
+         &              profdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Temperature
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosdtobs,              ilantobs,             &
+         &                 inlatobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdtobs, iosdtobsmpp )
+      CALL obs_mpp_sum_integer( ilantobs, ilantobsmpp )
+      CALL obs_mpp_sum_integer( inlatobs, inlatobsmpp )
+
+      ! Salinity
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamt,                 gphit,                &
+         &                 gdept_0,               tmask,                &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdsobs,              ilansobs,             &
+         &                 inlasobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags <= 10
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_pro :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining T data outside space domain       = ', &
+            &            iosdtobsmpp
+         WRITE(numout,*) ' Remaining T data at land points             = ', &
+            &            ilantobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining T data near land points (removed) = ',&
+               &            inlatobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining T data near land points (kept)    = ',&
+               &            inlatobsmpp
+         ENDIF
+         WRITE(numout,*) ' T data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining S data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining S data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining S data near land points (removed) = ',&
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining S data near land points (kept)    = ',&
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' S data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Temperature',5X,'Salinity')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'--------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+      
+   END SUBROUTINE obs_pre_pro
+
+   SUBROUTINE obs_pre_sla( sladata, sladatqc, ld_sla, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sla  ***
+      !!
+      !! ** Purpose : First level check and screening of SLA observations
+      !!
+      !! ** Method  : First level check and screening of SLA observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen) Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! Full set of SLA data
+      TYPE(obs_surf), INTENT(INOUT) :: sladatqc   ! Subset of SLA data not failing screening
+      LOGICAL, INTENT(IN) :: ld_sla         ! Switch for SLA data
+      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp     !  - outside time domain
+      INTEGER :: iosdsobsmpp    !  - outside space domain
+      INTEGER :: ilansobsmpp    !  - within a model land cell
+      INTEGER :: inlasobsmpp    !  - close to land
+      INTEGER :: igrdobsmpp     !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SLA data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sla : Preparing the SLA observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SLA data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sladata%nsurf,   sladata%nyea, sladata%nmon, &
+         &              sladata%nday,    sladata%nhou, sladata%nmin, &
+         &              sladata%nqc,     sladata%mstp, iotdobs        )
+
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for SLA data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sladata%nsurf,   sladata%mi, sladata%mj, &
+         &              sladata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sladata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sladata%mi,   sladata%mj,   & 
+         &                 sladata%rlam, sladata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sladata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sladata data structure to
+      ! the sladatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sladata%nsurf) )
+      
+      ! We want all data which has qc flags <= 10
+
+      llvalid(:)  = ( sladata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sladata,     sladatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sla :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SLA data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SLA data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SLA data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SLA data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SLA data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SLA data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SLA data accepted                             = ', &
+            &            sladatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sladatqc%nsurf
+         inrc = sladatqc%mstp(jobs) + 2 - nit000
+         sladatqc%nsstp(inrc)  = sladatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sladatqc%nsstp, sladatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sladatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea level anomaly')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+
+   END SUBROUTINE obs_pre_sla
+
+   SUBROUTINE obs_pre_sst( sstdata, sstdatqc, ld_sst, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_sst  ***
+      !!
+      !! ** Purpose : First level check and screening of SST observations
+      !!
+      !! ** Method  : First level check and screening of SST observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-03  (S. Ricci) SST data preparation 
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata     ! Full set of SST data
+      TYPE(obs_surf), INTENT(INOUT) :: sstdatqc    ! Subset of SST data not failing screening
+      LOGICAL :: ld_sst             ! Switch for SST data
+      LOGICAL :: ld_nea             ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0   
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! SST data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_sst : Preparing the SST observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for SST data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              sstdata%nsurf,   sstdata%nyea, sstdata%nmon, &
+         &              sstdata%nday,    sstdata%nhou, sstdata%nmin, &
+         &              sstdata%nqc,     sstdata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for SST data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( sstdata%nsurf,   sstdata%mi, sstdata%mj, &
+         &              sstdata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( sstdata%nsurf,              &
+         &                 jpi,          jpj,          &
+         &                 sstdata%mi,   sstdata%mj,   & 
+         &                 sstdata%rlam, sstdata%rphi, &
+         &                 glamt,        gphit,        &
+         &                 tmask(:,:,1), sstdata%nqc,  &
+         &                 iosdsobs,     ilansobs,     &
+         &                 inlasobs,     ld_nea        )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the sstdata data structure to
+      ! the sstdatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(sstdata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( sstdata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( sstdata,     sstdatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_sst :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' SST data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining SST data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining SST data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining SST data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining SST data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining SST data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' SST data accepted                             = ', &
+            &            sstdatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, sstdatqc%nsurf
+         inrc = sstdatqc%mstp(jobs) + 2 - nit000
+         sstdatqc%nsstp(inrc)  = sstdatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( sstdatqc%nsstp, sstdatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, sstdatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea surface temperature')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_sst
+
+   SUBROUTINE obs_pre_seaice( seaicedata, seaicedatqc, ld_seaice, ld_nea )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_seaice  ***
+      !!
+      !! ** Purpose : First level check and screening of Sea Ice observations
+      !!
+      !! ** Method  : First level check and screening of Sea Ice observations
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-11 (D. Lea) based on obs_pre_sst
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt,   &
+         & gphit,   &
+         & tmask,   &
+         & nproc
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata     ! Full set of Sea Ice data
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedatqc    ! Subset of sea ice data not failing screening
+      LOGICAL :: ld_seaice     ! Switch for sea ice data
+      LOGICAL :: ld_nea        ! Switch for rejecting observation near land
+      !! * Local declarations
+      INTEGER :: iyea0         ! Initial date
+      INTEGER :: imon0         !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosdsobs     !  - outside space domain
+      INTEGER :: ilansobs     !  - within a model land cell
+      INTEGER :: inlasobs     !  - close to land
+      INTEGER :: igrdobs      !  - fail the grid search
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosdsobsmpp  !  - outside space domain
+      INTEGER :: ilansobsmpp  !  - within a model land cell
+      INTEGER :: inlasobsmpp  !  - close to land
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: & 
+         & llvalid            ! data selection
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF (lwp) WRITE(numout,*)'obs_pre_seaice : Preparing the sea ice observations...'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosdsobs = 0
+      ilansobs = 0
+      inlasobs = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for sea ice data
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              seaicedata%nsurf,   seaicedata%nyea, seaicedata%nmon, &
+         &              seaicedata%nday,    seaicedata%nhou, seaicedata%nmin, &
+         &              seaicedata%nqc,     seaicedata%mstp, iotdobs        )
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      ! -----------------------------------------------------------------------
+      ! Check for sea ice data failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( seaicedata%nsurf,   seaicedata%mi, seaicedata%mj, &
+         &              seaicedata%nqc,     igrdobs                         )
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. 
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_spc_2d( seaicedata%nsurf,                 &
+         &                 jpi,             jpj,             &
+         &                 seaicedata%mi,   seaicedata%mj,   & 
+         &                 seaicedata%rlam, seaicedata%rphi, &
+         &                 glamt,           gphit,           &
+         &                 tmask(:,:,1),    seaicedata%nqc,  &
+         &                 iosdsobs,        ilansobs,        &
+         &                 inlasobs,        ld_nea           )
+
+      CALL obs_mpp_sum_integer( iosdsobs, iosdsobsmpp )
+      CALL obs_mpp_sum_integer( ilansobs, ilansobsmpp )
+      CALL obs_mpp_sum_integer( inlasobs, inlasobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the seaicedata data structure to
+      ! the seaicedatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid(seaicedata%nsurf) )
+      
+      ! We want all data which has qc flags <= 0
+
+      llvalid(:)  = ( seaicedata%nqc(:)  <= 10 )
+
+      ! The actual copying
+
+      CALL obs_surf_compress( seaicedata,     seaicedatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid )
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_seaice :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Sea ice data outside time domain                  = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data that failed grid search    = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining sea ice data outside space domain       = ', &
+            &            iosdsobsmpp
+         WRITE(numout,*) ' Remaining sea ice data at land points             = ', &
+            &            ilansobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining sea ice data near land points (removed) = ', &
+               &            inlasobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining sea ice data near land points (kept)    = ', &
+               &            inlasobsmpp
+         ENDIF
+         WRITE(numout,*) ' Sea ice data accepted                             = ', &
+            &            seaicedatqc%nsurfmpp
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,1997)
+         WRITE(numout,1998)
+      ENDIF
+      
+      DO jobs = 1, seaicedatqc%nsurf
+         inrc = seaicedatqc%mstp(jobs) + 2 - nit000
+         seaicedatqc%nsstp(inrc)  = seaicedatqc%nsstp(inrc) + 1
+      END DO
+      
+      CALL obs_mpp_sum_integers( seaicedatqc%nsstp, seaicedatqc%nsstpmpp, &
+         &                       nitend - nit000 + 2 )
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,1999) jstp, seaicedatqc%nsstpmpp(inrc)
+         END DO
+      ENDIF
+
+1997  FORMAT(10X,'Time step',5X,'Sea ice data           ')
+1998  FORMAT(10X,'---------',5X,'-----------------')
+1999  FORMAT(10X,I9,5X,I17)
+      
+   END SUBROUTINE obs_pre_seaice
+
+   SUBROUTINE obs_pre_vel( profdata, prodatqc, ld_vel3d, ld_nea, ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pre_taovel  ***
+      !!
+      !! ** Purpose : First level check and screening of U and V profiles
+      !!
+      !! ** Method  : First level check and screening of U and V profiles
+      !!
+      !! History :
+      !!        !  2007-06  (K. Mogensen) original : T and S profile data
+      !!        !  2008-09  (M. Valdivieso) : TAO velocity data
+      !!        !  2009-01  (K. Mogensen) : New feedback strictuer
+      !!
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE domstp              ! Domain: set the time-step
+      USE par_oce             ! Ocean parameters
+      USE dom_oce, ONLY : &   ! Geographical information
+         & glamt, glamu, glamv,    &
+         & gphit, gphiu, gphiv,    &
+         & gdept_0, &
+         & tmask, umask, vmask,  &
+         & nproc
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Full set of profile data
+      TYPE(obs_prof), INTENT(INOUT) :: prodatqc   ! Subset of profile data not failing screening
+      LOGICAL, INTENT(IN) :: ld_vel3d      ! Switch for zonal and meridional velocity components
+      LOGICAL, INTENT(IN) :: ld_nea        ! Switch for rejecting observation near land
+      LOGICAL, INTENT(IN) :: ld_dailyav    ! Switch for daily average data
+      !! * Local declarations
+      INTEGER :: iyea0        ! Initial date
+      INTEGER :: imon0        !  - (year, month, day, hour, minute)
+      INTEGER :: iday0    
+      INTEGER :: ihou0    
+      INTEGER :: imin0
+      INTEGER :: icycle       ! Current assimilation cycle
+                              ! Counters for observations that
+      INTEGER :: iotdobs      !  - outside time domain
+      INTEGER :: iosduobs     !  - outside space domain (zonal velocity component)
+      INTEGER :: iosdvobs     !  - outside space domain (meridional velocity component)
+      INTEGER :: ilanuobs     !  - within a model land cell (zonal velocity component)
+      INTEGER :: ilanvobs     !  - within a model land cell (meridional velocity component)
+      INTEGER :: inlauobs     !  - close to land (zonal velocity component)
+      INTEGER :: inlavobs     !  - close to land (meridional velocity component)
+      INTEGER :: igrdobs      !  - fail the grid search
+      INTEGER :: iuvchku      !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkv      !
+                              ! Global counters for observations that
+      INTEGER :: iotdobsmpp   !  - outside time domain
+      INTEGER :: iosduobsmpp  !  - outside space domain (zonal velocity component)
+      INTEGER :: iosdvobsmpp  !  - outside space domain (meridional velocity component)
+      INTEGER :: ilanuobsmpp  !  - within a model land cell (zonal velocity component)
+      INTEGER :: ilanvobsmpp  !  - within a model land cell (meridional velocity component)
+      INTEGER :: inlauobsmpp  !  - close to land (zonal velocity component)
+      INTEGER :: inlavobsmpp  !  - close to land (meridional velocity component)
+      INTEGER :: igrdobsmpp   !  - fail the grid search
+      INTEGER :: iuvchkumpp   !  - reject u if v rejected and vice versa
+      INTEGER :: iuvchkvmpp   !
+      TYPE(obs_prof_valid) ::  llvalid      ! Profile selection 
+      TYPE(obs_prof_valid), DIMENSION(profdata%nvar) :: &
+         & llvvalid           ! U,V selection 
+      INTEGER :: jvar         ! Variable loop variable
+      INTEGER :: jobs         ! Obs. loop variable
+      INTEGER :: jstp         ! Time loop variable
+      INTEGER :: inrc         ! Time index variable
+
+      IF(lwp) WRITE(numout,*)'obs_pre_vel: Preparing the velocity profile data'
+
+      ! Initial date initialization (year, month, day, hour, minute)
+      iyea0 =   ndate0 / 10000
+      imon0 = ( ndate0 - iyea0 * 10000 ) / 100
+      iday0 =   ndate0 - iyea0 * 10000 - imon0 * 100
+      ihou0 = 0
+      imin0 = 0
+
+      icycle = no     ! Assimilation cycle
+
+      ! Diagnotics counters for various failures.
+
+      iotdobs  = 0
+      igrdobs  = 0
+      iosduobs = 0
+      iosdvobs = 0
+      ilanuobs = 0
+      ilanvobs = 0
+      inlauobs = 0
+      inlavobs = 0
+      iuvchku  = 0
+      iuvchkv = 0
+
+      ! -----------------------------------------------------------------------
+      ! Find time coordinate for profiles
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_tim_prof( icycle, &
+         &              iyea0,   imon0,   iday0,   ihou0,   imin0,      &
+         &              profdata%nprof,   profdata%nyea, profdata%nmon, &
+         &              profdata%nday,    profdata%nhou, profdata%nmin, &
+         &              profdata%ntyp,    profdata%nqc,  profdata%mstp, &
+         &              iotdobs, ld_dailyav = ld_dailyav        )
+	 
+      CALL obs_mpp_sum_integer( iotdobs, iotdobsmpp )
+      
+      ! -----------------------------------------------------------------------
+      ! Check for profiles failing the grid search
+      ! -----------------------------------------------------------------------
+
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,1), profdata%mj(:,1), &
+         &              profdata%nqc,     igrdobs                         )
+      CALL obs_coo_grd( profdata%nprof,   profdata%mi(:,2), profdata%mj(:,2), &
+         &              profdata%nqc,     igrdobs                         )
+
+      CALL obs_mpp_sum_integer( igrdobs, igrdobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject all observations for profiles with nqc > 10
+      ! -----------------------------------------------------------------------
+
+      CALL obs_pro_rej( profdata )
+
+      ! -----------------------------------------------------------------------
+      ! Check for land points. This includes points below the model
+      ! bathymetry so this is done for every point in the profile
+      ! -----------------------------------------------------------------------
+
+      ! Zonal Velocity Component
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(1),   &
+         &                 profdata%npvsta(:,1),  profdata%npvend(:,1), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(1)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(1)%vdep,                        &
+         &                 glamu,                 gphiu,                &
+         &                 gdept_0,               umask,                &
+         &                 profdata%nqc,          profdata%var(1)%nvqc, &
+         &                 iosduobs,              ilanuobs,             &
+         &                 inlauobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosduobs, iosduobsmpp )
+      CALL obs_mpp_sum_integer( ilanuobs, ilanuobsmpp )
+      CALL obs_mpp_sum_integer( inlauobs, inlauobsmpp )
+
+      ! Meridional Velocity Component
+
+      CALL obs_coo_spc_3d( profdata%nprof,        profdata%nvprot(2),   &
+         &                 profdata%npvsta(:,2),  profdata%npvend(:,2), &
+         &                 jpi,                   jpj,                  &
+         &                 jpk,                                         &
+         &                 profdata%mi,           profdata%mj,          & 
+         &                 profdata%var(2)%mvk,                         &
+         &                 profdata%rlam,         profdata%rphi,        &
+         &                 profdata%var(2)%vdep,                        &
+         &                 glamv,                 gphiv,                &
+         &                 gdept_0,               vmask,                &
+         &                 profdata%nqc,          profdata%var(2)%nvqc, &
+         &                 iosdvobs,              ilanvobs,             &
+         &                 inlavobs,              ld_nea                )
+
+      CALL obs_mpp_sum_integer( iosdvobs, iosdvobsmpp )
+      CALL obs_mpp_sum_integer( ilanvobs, ilanvobsmpp )
+      CALL obs_mpp_sum_integer( inlavobs, inlavobsmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Reject u if v is rejected and vice versa
+      ! -----------------------------------------------------------------------
+
+      CALL obs_uv_rej( profdata, iuvchku, iuvchkv )
+      CALL obs_mpp_sum_integer( iuvchku, iuvchkumpp )
+      CALL obs_mpp_sum_integer( iuvchkv, iuvchkvmpp )
+
+      ! -----------------------------------------------------------------------
+      ! Copy useful data from the profdata data structure to
+      ! the prodatqc data structure 
+      ! -----------------------------------------------------------------------
+
+      ! Allocate the selection arrays
+
+      ALLOCATE( llvalid%luse(profdata%nprof) )
+      DO jvar = 1,profdata%nvar
+         ALLOCATE( llvvalid(jvar)%luse(profdata%nvprot(jvar)) )
+      END DO
+
+      ! We want all data which has qc flags = 0
+
+      llvalid%luse(:) = ( profdata%nqc(:)  <= 10 )
+      DO jvar = 1,profdata%nvar
+         llvvalid(jvar)%luse(:) = ( profdata%var(jvar)%nvqc(:) <= 10 )
+      END DO
+
+      ! The actual copying
+
+      CALL obs_prof_compress( profdata,     prodatqc,       .TRUE.,  numout, &
+         &                    lvalid=llvalid, lvvalid=llvvalid )
+
+      ! Dellocate the selection arrays
+      DEALLOCATE( llvalid%luse )
+      DO jvar = 1,profdata%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+
+      ! -----------------------------------------------------------------------
+      ! Print information about what observations are left after qc
+      ! -----------------------------------------------------------------------
+
+      ! Update the total observation counter array
+      
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'obs_pre_vel :'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*)
+         WRITE(numout,*) ' Profiles outside time domain                = ', &
+            &            iotdobsmpp
+         WRITE(numout,*) ' Remaining profiles that failed grid search  = ', &
+            &            igrdobsmpp
+         WRITE(numout,*) ' Remaining U data outside space domain       = ', &
+            &            iosduobsmpp
+         WRITE(numout,*) ' Remaining U data at land points             = ', &
+            &            ilanuobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining U data near land points (removed) = ',&
+               &            inlauobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining U data near land points (kept)    = ',&
+               &            inlauobsmpp
+         ENDIF
+         WRITE(numout,*) ' U observation rejected since V rejected     = ', &
+            &            iuvchku     
+         WRITE(numout,*) ' U data accepted                             = ', &
+            &            prodatqc%nvprotmpp(1)
+         WRITE(numout,*) ' Remaining V data outside space domain       = ', &
+            &            iosdvobsmpp
+         WRITE(numout,*) ' Remaining V data at land points             = ', &
+            &            ilanvobsmpp
+         IF (ld_nea) THEN
+            WRITE(numout,*) ' Remaining V data near land points (removed) = ',&
+               &            inlavobsmpp
+         ELSE
+            WRITE(numout,*) ' Remaining V data near land points (kept)    = ',&
+               &            inlavobsmpp
+         ENDIF
+         WRITE(numout,*) ' V observation rejected since U rejected     = ', &
+            &            iuvchkv     
+         WRITE(numout,*) ' V data accepted                             = ', &
+            &            prodatqc%nvprotmpp(2)
+
+         WRITE(numout,*)
+         WRITE(numout,*) ' Number of observations per time step :'
+         WRITE(numout,*)
+         WRITE(numout,997)
+         WRITE(numout,998)
+      ENDIF
+      
+      DO jobs = 1, prodatqc%nprof
+         inrc = prodatqc%mstp(jobs) + 2 - nit000
+         prodatqc%npstp(inrc)  = prodatqc%npstp(inrc) + 1
+         DO jvar = 1, prodatqc%nvar
+            IF ( prodatqc%npvend(jobs,jvar) > 0 ) THEN
+               prodatqc%nvstp(inrc,jvar) = prodatqc%nvstp(inrc,jvar) + &
+                  &                      ( prodatqc%npvend(jobs,jvar) - &
+                  &                        prodatqc%npvsta(jobs,jvar) + 1 )
+            ENDIF
+         END DO
+      END DO
+      
+      
+      CALL obs_mpp_sum_integers( prodatqc%npstp, prodatqc%npstpmpp, &
+         &                       nitend - nit000 + 2 )
+      DO jvar = 1, prodatqc%nvar
+         CALL obs_mpp_sum_integers( prodatqc%nvstp(:,jvar), &
+            &                       prodatqc%nvstpmpp(:,jvar), &
+            &                       nitend - nit000 + 2 )
+      END DO
+
+      IF ( lwp ) THEN
+         DO jstp = nit000 - 1, nitend
+            inrc = jstp - nit000 + 2
+            WRITE(numout,999) jstp, prodatqc%npstpmpp(inrc), &
+               &                    prodatqc%nvstpmpp(inrc,1), &
+               &                    prodatqc%nvstpmpp(inrc,2)
+         END DO
+      ENDIF
+
+997   FORMAT(10X,'Time step',5X,'Profiles',5X,'Zonal Comp.',5X,'Meridional Comp.')
+998   FORMAT(10X,'---------',5X,'--------',5X,'-----------',5X,'----------------')
+999   FORMAT(10X,I9,5X,I8,5X,I11,5X,I8)
+
+   END SUBROUTINE obs_pre_vel
+
+   SUBROUTINE obs_coo_tim( kcycle, &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    kobsqc,  kobsstp, kotdobs                      )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!        !  2010-05  (D. Lea) Fix in leap year calculation for NEMO vn3.2
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &  ! Geographical information
+         & rdt
+      USE phycst, ONLY : &   ! Physical constants
+         & rday,  &             
+         & rmmss, &             
+         & rhhmm                        
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle     ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0      ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0 
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno     ! Number of observations
+      INTEGER, INTENT(INOUT) :: kotdobs   ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+
+      !! * Local declarations
+      INTEGER :: jyea
+      INTEGER :: jmon
+      INTEGER :: jday
+      INTEGER :: jobs
+      INTEGER :: iyeastr
+      INTEGER :: iyeaend
+      INTEGER :: imonstr
+      INTEGER :: imonend
+      INTEGER :: idaystr
+      INTEGER :: idayend 
+      INTEGER :: iskip
+      INTEGER :: idaystp
+      REAL(KIND=wp) :: zminstp
+      REAL(KIND=wp) :: zhoustp
+      REAL(KIND=wp) :: zobsstp 
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+ 
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      ! Intialize the number of time steps per day
+      idaystp = NINT( rday / rdt )
+
+      !---------------------------------------------------------------------
+      ! Locate the model time coordinates for interpolation
+      !---------------------------------------------------------------------
+
+      DO jobs = 1, kobsno
+
+         ! Initialize the time step counter
+         kobsstp(jobs) = nit000 - 1
+
+         ! Flag if observation date is less than the initial date
+
+         IF ( ( kobsyea(jobs) < kyea0 )                   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) <  kmon0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) <  kday0 ) )   &
+            & .OR. ( ( kobsyea(jobs) == kyea0 )           &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )     &
+            &        .AND. ( kobshou(jobs) <  khou0 ) )   &
+            &  .OR. ( ( kobsyea(jobs) == kyea0 )          &
+            &        .AND. ( kobsmon(jobs) == kmon0 )     &
+            &        .AND. ( kobsday(jobs) == kday0 )          &
+            &        .AND. ( kobshou(jobs) == khou0 )          &
+            &        .AND. ( kobsmin(jobs) <= kmin0 ) ) ) THEN
+            kobsstp(jobs) = -1
+            kobsqc(jobs)  = kobsqc(jobs) + 11
+            kotdobs       = kotdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Compute the number of time steps to the observation day
+         iyeastr = kyea0
+         iyeaend = kobsyea(jobs)
+         
+         !---------------------------------------------------------------------
+         ! Year loop
+         !---------------------------------------------------------------------
+         DO jyea = iyeastr, iyeaend
+
+            CALL calc_month_len( jyea, imonth_len )
+            
+            imonstr = 1
+            IF ( jyea == kyea0         ) imonstr = kmon0
+            imonend = 12
+            IF ( jyea == kobsyea(jobs) ) imonend = kobsmon(jobs)
+            
+            ! Month loop
+            DO jmon = imonstr, imonend
+               
+               idaystr = 1
+               IF (       ( jmon == kmon0   ) &
+                  & .AND. ( jyea == kyea0   ) ) idaystr = kday0
+               idayend = imonth_len(jmon)
+               IF (       ( jmon == kobsmon(jobs) ) &
+                  & .AND. ( jyea == kobsyea(jobs) ) ) idayend = kobsday(jobs) - 1
+               
+               ! Day loop
+               DO jday = idaystr, idayend
+                  kobsstp(jobs) = kobsstp(jobs) + idaystp
+               END DO
+               
+            END DO
+
+         END DO
+
+         ! Add in the number of time steps to the observation minute
+         zminstp = rmmss / rdt
+         zhoustp = rhhmm * zminstp
+
+         zobsstp =   REAL( kobsmin(jobs) - kmin0, KIND=wp ) * zminstp &
+            &      + REAL( kobshou(jobs) - khou0, KIND=wp ) * zhoustp
+         kobsstp(jobs) = kobsstp(jobs) + NINT( zobsstp )
+
+         ! Flag if observation step outside the time window
+         IF ( ( kobsstp(jobs) < ( nit000 - 1 ) ) &
+            & .OR.( kobsstp(jobs) > nitend ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 12
+            kotdobs = kotdobs + 1
+            CYCLE
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_coo_tim
+
+   SUBROUTINE calc_month_len( iyear, imonth_len )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE calc_month_len  ***
+      !!          
+      !! ** Purpose : Compute the number of days in a months given a year.
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! History :
+      !!        !  10-05  (D. Lea)   New routine based on day_init 
+      !!----------------------------------------------------------------------
+
+      INTEGER, DIMENSION(12) ::   imonth_len    !: length in days of the months of the current year
+      INTEGER :: iyear         !: year
+      
+      ! length of the month of the current year (from nleapy, read in namelist)
+      IF ( nleapy < 2 ) THEN 
+         imonth_len(:) = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
+         IF ( nleapy == 1 ) THEN   ! we are using calendar with leap years
+            IF ( MOD(iyear, 4) == 0 .AND. ( MOD(iyear, 400) == 0 .OR. MOD(iyear, 100) /= 0 ) ) THEN
+               imonth_len(2) = 29
+            ENDIF
+         ENDIF
+      ELSE
+         imonth_len(:) = nleapy   ! all months with nleapy days per year
+      ENDIF
+
+   END SUBROUTINE
+
+   SUBROUTINE obs_coo_tim_prof( kcycle,                                   &
+      &                    kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+      &                    kobsno,                                        &
+      &                    kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+      &                    ktyp,    kobsqc,  kobsstp, kotdobs, kdailyavtypes, &
+      &                    ld_dailyav )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_tim ***
+      !!
+      !! ** Purpose : Compute the number of time steps to the observation time.
+      !!
+      !! ** Method  : For time coordinates ( yea_obs, mon_obs, day_obs, 
+      !!              hou_obs, min_obs ), this routine locates the time step 
+      !!              that is closest to this time.
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  1997-07  (A. Weaver) Original
+      !!        !  2006-08  (A. Weaver) NEMOVAR migration
+      !!        !  2006-10  (A. Weaver) Cleanup
+      !!        !  2007-01  (K. Mogensen) Rewritten with loop
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kcycle      ! Current cycle
+      INTEGER, INTENT(IN) :: kyea0       ! Initial date coordinates
+      INTEGER, INTENT(IN) :: kmon0
+      INTEGER, INTENT(IN) :: kday0
+      INTEGER, INTENT(IN) :: khou0
+      INTEGER, INTENT(IN) :: kmin0
+      INTEGER, INTENT(IN) :: kobsno      ! Number of observations
+      INTEGER, INTENT(INOUT) ::  kotdobs    ! Number of observations failing time check
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsyea,  &      ! Observation time coordinates
+         & kobsmon,  &
+         & kobsday,  & 
+         & kobshou,  &
+         & kobsmin,  &
+         & ktyp             ! Observation type.
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+      INTEGER, DIMENSION(kobsno), INTENT(OUT) :: &
+         & kobsstp          ! Number of time steps up to the 
+                            ! observation time
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes    ! Types for daily averages
+      LOGICAL, OPTIONAL :: ld_dailyav    ! All types are daily averages
+      !! * Local declarations
+      INTEGER :: jobs
+
+      !-----------------------------------------------------------------------
+      ! Call standard obs_coo_tim
+      !-----------------------------------------------------------------------
+
+      CALL obs_coo_tim( kcycle, &
+         &              kyea0,   kmon0,   kday0,   khou0,   kmin0,     &
+         &              kobsno,                                        &
+         &              kobsyea, kobsmon, kobsday, kobshou, kobsmin,   &
+         &              kobsqc,  kobsstp, kotdobs                      )
+
+      !------------------------------------------------------------------------
+      ! Always reject daily averaged data (e.g. MRB data (820)) at initial time
+      !------------------------------------------------------------------------
+
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         DO jobs = 1, kobsno
+            
+            IF ( kobsqc(jobs) <= 10 ) THEN
+               
+               IF ( ( kobsstp(jobs) == (nit000 - 1) ).AND.&
+                  & ( ANY (kdailyavtypes(:) == ktyp(jobs)) ) ) THEN
+                  kobsqc(jobs) = kobsqc(jobs) + 14
+                  kotdobs      = kotdobs + 1
+                  CYCLE
+               ENDIF
+               
+            ENDIF
+         END DO
+      ENDIF
+
+      !------------------------------------------------------------------------
+      ! If ld_dailyav is set then all data assumed to be daily averaged
+      !------------------------------------------------------------------------
+      
+      IF ( PRESENT( ld_dailyav) ) THEN
+         IF (ld_dailyav) THEN
+            DO jobs = 1, kobsno
+               
+               IF ( kobsqc(jobs) <= 10 ) THEN
+                  
+                  IF ( kobsstp(jobs) == (nit000 - 1) ) THEN
+                     kobsqc(jobs) = kobsqc(jobs) + 14
+                     kotdobs      = kotdobs + 1
+                     CYCLE
+                  ENDIF
+                  
+               ENDIF
+            END DO
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE obs_coo_tim_prof
+
+   SUBROUTINE obs_coo_grd( kobsno, kobsi, kobsj, kobsqc, kgrdobs )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_grd ***
+      !!
+      !! ** Purpose : Verify that the grid search has not failed
+      !!
+      !! ** Method  : The previously computed i,j indeces are checked  
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen)  Original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno        ! Number of observations
+      INTEGER, DIMENSION(kobsno), INTENT(IN ) :: &
+         & kobsi, &         ! i,j indeces previously computed
+         & kobsj
+      INTEGER, INTENT(INOUT) ::  kgrdobs   ! Number of observations failing the check
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc           ! Quality control flag
+
+      !! * Local declarations
+      INTEGER :: jobs       ! Loop variable
+
+      ! Flag if the grid search failed
+
+      DO jobs = 1, kobsno
+         IF ( ( kobsi(jobs) <= 0 ) .AND. ( kobsj(jobs) <= 0 ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 18
+            kgrdobs = kgrdobs + 1
+         ENDIF
+      END DO
+      
+   END SUBROUTINE obs_coo_grd
+
+   SUBROUTINE obs_coo_spc_2d( kobsno, kpi,     kpj,              &
+      &                       kobsi,  kobsj,   pobslam, pobsphi, & 
+      &                       plam,   pphi,    pmask,            &
+      &                       kobsqc, kosdobs, klanobs,          &
+      &                       knlaobs,ld_nea                     )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_2d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-03  (A. Weaver, K. Mogensen)  Original
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kobsno    ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi       ! Number of grid points in (i,j)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs   ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs   ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs   ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea       ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kobsno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kobsno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, ji, jj
+      
+      ! Get grid point indices
+
+      DO jobs = 1, kobsno
+         
+         ! For invalid points use 2,2
+
+         IF ( kobsqc(jobs) >= 10 ) THEN
+
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+
+         ELSE
+
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+
+         ENDIF
+
+      END DO
+      
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kobsno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kobsno
+
+         ! Skip bad observations
+         IF ( kobsqc(jobs) >= 10 ) CYCLE
+
+         ! Flag if the observation falls outside the model spatial domain
+         IF (       ( pobslam(jobs) < -180. ) &
+            &  .OR. ( pobslam(jobs) >  180. ) &
+            &  .OR. ( pobsphi(jobs) <  -90. ) &
+            &  .OR. ( pobsphi(jobs) >   90. ) ) THEN
+            kobsqc(jobs) = kobsqc(jobs) + 11
+            kosdobs = kosdobs + 1
+            CYCLE
+         ENDIF
+
+         ! Flag if the observation falls with a model land cell
+         IF ( SUM( zgmsk(1:2,1:2,jobs) ) == 0.0_wp ) THEN
+            kobsqc(jobs) = kobsqc(jobs)  + 12
+            klanobs = klanobs + 1
+            CYCLE
+         ENDIF
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+  
+         ! For observations on the grid reject them if their are at
+         ! a masked point
+         
+         IF (lgridobs) THEN
+            IF (zgmsk(iig,ijg,jobs) == 0.0_wp ) THEN
+               kobsqc(jobs) = kobsqc(jobs) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+         ENDIF
+                      
+         ! Flag if the observation falls is close to land
+         IF ( MINVAL( zgmsk(1:2,1:2,jobs) ) == 0.0_wp) THEN
+            IF (ld_nea) kobsqc(jobs) = kobsqc(jobs) + 14
+            knlaobs = knlaobs + 1
+            CYCLE
+         ENDIF
+            
+      END DO
+
+   END SUBROUTINE obs_coo_spc_2d
+
+   SUBROUTINE obs_coo_spc_3d( kprofno, kobsno,  kpstart, kpend, &
+      &                       kpi,     kpj,     kpk,            &
+      &                       kobsi,   kobsj,   kobsk,          &
+      &                       pobslam, pobsphi, pobsdep,        &
+      &                       plam,    pphi,    pdep,    pmask, &
+      &                       kpobsqc, kobsqc,  kosdobs,        &
+      &                       klanobs, knlaobs, ld_nea          )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_coo_spc_3d  ***
+      !!
+      !! ** Purpose : Check for points outside the domain and land points
+      !!              Reset depth of observation above highest model level
+      !!              to the value of highest model level
+      !!
+      !! ** Method  : Remove the observations that are outside the model space
+      !!              and time domain or located within model land cells.
+      !!
+      !!              NB. T and S profile observations lying between the ocean
+      !!              surface and the depth of the first model T point are 
+      !!              assigned a depth equal to that of the first model T pt.
+      !!
+      !! ** Action  : 
+      !!   
+      !! History :
+      !!        !  2007-01  (K. Mogensen) Rewrite of parts of obs_scr
+      !!        !  2007-06  (K. Mogensen et al) Reject obs. near land.
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE dom_oce, ONLY : &       ! Geographical information
+         & gdepw_0                        
+
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kprofno      ! Number of profiles
+      INTEGER, INTENT(IN) :: kobsno       ! Total number of observations
+      INTEGER, INTENT(IN) :: kpi          ! Number of grid points in (i,j,k)
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk    
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kpstart, &         ! Start of individual profiles
+         & kpend              ! End of individual profiles
+      INTEGER, DIMENSION(kprofno), INTENT(IN) :: &
+         & kobsi, &           ! Observation (i,j) coordinates
+         & kobsj
+      INTEGER, DIMENSION(kobsno), INTENT(IN) :: &
+         & kobsk              ! Observation k coordinate
+      REAL(KIND=wp), DIMENSION(kprofno), INTENT(IN) :: &
+         & pobslam, &         ! Observation (lon,lat) coordinates
+         & pobsphi
+      REAL(KIND=wp), DIMENSION(kobsno), INTENT(INOUT) :: &
+         & pobsdep            ! Observation depths  
+      REAL(KIND=wp), DIMENSION(kpi,kpj), INTENT(IN) :: &
+         & plam, pphi         ! Model (lon,lat) coordinates
+      REAL(KIND=wp), DIMENSION(kpk), INTENT(IN) :: &
+         & pdep               ! Model depth coordinates
+      REAL(KIND=wp), DIMENSION(kpi,kpj,kpk), INTENT(IN) :: &
+         & pmask              ! Land mask array
+      INTEGER, DIMENSION(kprofno), INTENT(INOUT) :: &
+         & kpobsqc             ! Profile quality control
+      INTEGER, DIMENSION(kobsno), INTENT(INOUT) :: &
+         & kobsqc             ! Observation quality control
+      INTEGER, INTENT(INOUT) :: kosdobs     ! Observations outside space domain
+      INTEGER, INTENT(INOUT) :: klanobs     ! Observations within a model land cell
+      INTEGER, INTENT(INOUT) :: knlaobs     ! Observations near land
+      LOGICAL, INTENT(IN) :: ld_nea         ! Flag observations near land
+      !! * Local declarations
+      REAL(KIND=wp), DIMENSION(2,2,kpk,kprofno) :: &
+         & zgmsk              ! Grid mask
+      REAL(KIND=wp), DIMENSION(2,2,kprofno) :: &
+         & zglam, &           ! Model longitude at grid points
+         & zgphi              ! Model latitude at grid points
+      INTEGER, DIMENSION(2,2,kprofno) :: &
+         & igrdi, &           ! Grid i,j
+         & igrdj
+      LOGICAL :: lgridobs           ! Is observation on a model grid point.
+      INTEGER :: iig, ijg           ! i,j of observation on model grid point.
+      INTEGER :: jobs, jobsp, jk, ji, jj
+
+      ! Get grid point indices
+      
+      DO jobs = 1, kprofno
+
+         ! For invalid points use 2,2
+
+         IF ( kpobsqc(jobs) >= 10 ) THEN
+            
+            igrdi(1,1,jobs) = 1
+            igrdj(1,1,jobs) = 1
+            igrdi(1,2,jobs) = 1
+            igrdj(1,2,jobs) = 2
+            igrdi(2,1,jobs) = 2
+            igrdj(2,1,jobs) = 1
+            igrdi(2,2,jobs) = 2
+            igrdj(2,2,jobs) = 2
+            
+         ELSE
+            
+            igrdi(1,1,jobs) = kobsi(jobs)-1
+            igrdj(1,1,jobs) = kobsj(jobs)-1
+            igrdi(1,2,jobs) = kobsi(jobs)-1
+            igrdj(1,2,jobs) = kobsj(jobs)
+            igrdi(2,1,jobs) = kobsi(jobs)
+            igrdj(2,1,jobs) = kobsj(jobs)-1
+            igrdi(2,2,jobs) = kobsi(jobs)
+            igrdj(2,2,jobs) = kobsj(jobs)
+            
+         ENDIF
+         
+      END DO
+      
+      CALL obs_int_comm_3d( 2, 2, kprofno, kpk, igrdi, igrdj, pmask, zgmsk )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, plam, zglam )
+      CALL obs_int_comm_2d( 2, 2, kprofno, igrdi, igrdj, pphi, zgphi )
+
+      DO jobs = 1, kprofno
+
+         ! Skip bad profiles
+         IF ( kpobsqc(jobs) >= 10 ) CYCLE
+
+         ! Check if this observation is on a grid point
+
+         lgridobs = .FALSE.
+         iig = -1
+         ijg = -1
+         DO jj = 1, 2
+            DO ji = 1, 2
+               IF ( ( ABS( zgphi(ji,jj,jobs) - pobsphi(jobs) ) < 1.0e-6_wp ) &
+                  & .AND. &
+                  & ( ABS( zglam(ji,jj,jobs) - pobslam(jobs) ) < 1.0e-6_wp ) &
+                  & ) THEN
+                  lgridobs = .TRUE.
+                  iig = ji
+                  ijg = jj
+               ENDIF
+            END DO
+         END DO
+
+         ! Reject observations
+
+         DO jobsp = kpstart(jobs), kpend(jobs)
+
+            ! Flag if the observation falls outside the model spatial domain
+            IF (       ( pobslam(jobs) < -180.         )       &
+               &  .OR. ( pobslam(jobs) >  180.         )       &
+               &  .OR. ( pobsphi(jobs) <  -90.         )       &
+               &  .OR. ( pobsphi(jobs) >   90.         )       &
+               &  .OR. ( pobsdep(jobsp) < 0.0          )       &
+               &  .OR. ( pobsdep(jobsp) > gdepw_0(kpk) ) ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 11
+               kosdobs = kosdobs + 1
+               CYCLE
+            ENDIF
+
+            ! Flag if the observation falls with a model land cell
+            IF ( SUM( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) &
+               &  == 0.0_wp ) THEN
+               kobsqc(jobsp) = kobsqc(jobsp) + 12
+               klanobs = klanobs + 1
+               CYCLE
+            ENDIF
+
+            ! For observations on the grid reject them if their are at
+            ! a masked point
+            
+            IF (lgridobs) THEN
+               IF (zgmsk(iig,ijg,kobsk(jobsp)-1,jobs) == 0.0_wp ) THEN
+                  kobsqc(jobsp) = kobsqc(jobsp) + 12
+                  klanobs = klanobs + 1
+                  CYCLE
+               ENDIF
+            ENDIF
+            
+            ! Flag if the observation falls is close to land
+            IF ( MINVAL( zgmsk(1:2,1:2,kobsk(jobsp)-1:kobsk(jobsp),jobs) ) == &
+               &  0.0_wp) THEN
+               IF (ld_nea) kobsqc(jobsp) = kobsqc(jobsp) + 14
+               knlaobs = knlaobs + 1
+            ENDIF
+
+            ! Set observation depth equal to that of the first model depth
+            IF ( pobsdep(jobsp) <= pdep(1) ) THEN
+               pobsdep(jobsp) = pdep(1)  
+            ENDIF
+            
+         END DO
+      END DO
+
+   END SUBROUTINE obs_coo_spc_3d
+
+   SUBROUTINE obs_pro_rej( profdata )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_pro_rej ***
+      !!
+      !! ** Purpose : Reject all data within a rejected profile
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2007-10  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Profile data
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( profdata%nqc(jprof) > 10 ) THEN
+            
+            DO jvar = 1, profdata%nvar
+
+               DO jobs = profdata%npvsta(jprof,jvar),  &
+                  &      profdata%npvend(jprof,jvar)
+                  
+                  profdata%var(jvar)%nvqc(jobs) = &
+                     & profdata%var(jvar)%nvqc(jobs) + 26
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+   END SUBROUTINE obs_pro_rej
+
+   SUBROUTINE obs_uv_rej( profdata, knumu, knumv )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE obs_uv_rej ***
+      !!
+      !! ** Purpose : Reject u if v is rejected and vice versa
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!   
+      !! History :
+      !!        !  2009-2  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: profdata   ! Profile data
+      INTEGER, INTENT(INOUT) :: knumu             ! Number of u rejected
+      INTEGER, INTENT(INOUT) :: knumv             ! Number of v rejected
+      !! * Local declarations
+      INTEGER :: jprof
+      INTEGER :: jvar
+      INTEGER :: jobs
+      
+      ! Loop over profiles
+
+      DO jprof = 1, profdata%nprof
+
+         IF ( ( profdata%npvsta(jprof,1) /= profdata%npvsta(jprof,2) ) .OR. &
+            & ( profdata%npvend(jprof,1) /= profdata%npvend(jprof,2) ) ) THEN
+
+            CALL ctl_stop('U,V profiles inconsistent in obs_uv_rej')
+            RETURN
+
+         ENDIF
+
+         DO jobs = profdata%npvsta(jprof,1), profdata%npvend(jprof,1)
+            
+            IF ( ( profdata%var(1)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(2)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(2)%nvqc(jobs) = profdata%var(2)%nvqc(jobs) + 42
+               knumv = knumv + 1
+            ENDIF
+            IF ( ( profdata%var(2)%nvqc(jobs) > 10 ) .AND. &
+               & ( profdata%var(1)%nvqc(jobs) <= 10) ) THEN
+               profdata%var(1)%nvqc(jobs) = profdata%var(1)%nvqc(jobs) + 42
+               knumu = knumu + 1
+            ENDIF
+            
+         END DO
+            
+      END DO
+
+   END SUBROUTINE obs_uv_rej
+
+END MODULE obs_prep
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prof_io.F90	(revision 3437)
@@ -0,0 +1,32 @@
+MODULE obs_prof_io
+   !!======================================================================
+   !!                       ***  MODULE obs_prof_io  ***
+   !! Observation operators : I/O for ENACT and Coriolis files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an ENACT file.
+   !!   read_coriofile    :  Read a obfbdata structure from an Coriolis file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsprof_io.h90"
+
+END MODULE obs_prof_io
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_profiles_def.F90	(revision 3437)
@@ -0,0 +1,921 @@
+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
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nvprot,   &    !: Local total number of profile T data
+         & nvprotmpp      !: Global total number of profile T data
+      
+      ! Arrays with size equal to the number of profiles
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npidx,&        !: Profile number
+         & npfil,&        !: Profile number in file
+         & nyea, &        !: Year of profile
+         & nmon, &        !: Month of profile
+         & nday, &        !: Day of profile
+         & nhou, &        !: Hour of profile
+         & nmin, &        !: Minute of profile
+         & mstp, &        !: Time step nearest to profile
+         & nqc,  &        !: Profile QC
+         & ntyp, &        !: Type of profile product (WMO table 1770)
+         & ipqc, &        !: Position QC
+         & itqc           !: Time QC
+
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of profile data
+         & rphi           !: Latitude coordinate of profile data
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: Profile WMO indentifier
+      
+      ! Arrays with size equal to the number of profiles times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & npvsta, &      !: Start of each variable profile in full arrays
+         & npvend, &      !: End of each variable profile in full arrays
+         & mi,     &      !: i-th grid coord. for interpolating to profile T data
+         & mj,     &      !: j-th grid coord. for interpolating to profile T data
+         & ivqc           !: QC flags for all levels for a variable
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nqcf,  &       !: Observation QC flags
+         & ipqcf, &       !: Position QC flags
+         & itqcf          !: Time QC flags
+
+      ! Arrays with size equal to idefnqcf
+      ! the number of profiles times number of variables
+      INTEGER, POINTER, DIMENSION(:,:,:) :: &
+         & ivqcf
+
+      ! Arrays of variables
+
+      TYPE(obs_prof_var), POINTER, DIMENSION(:) :: var
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npstp,    &    !: Total number of profiles
+         & npstpmpp       !: Total number of profiles
+
+      ! Arrays with size equal to the number of time steps in the window times
+      ! number of variables
+
+      INTEGER, POINTER, DIMENSION(:,:) :: &
+         & nvstp,    &    !: Local total num. of profile data each time step 
+         & nvstpmpp       !: Global total num. of profile data each time step
+      
+      ! Arrays with size equal to the number of grid points times number of
+      ! variables
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:,:,:) :: &
+         & vdmean        !: Daily averaged model field
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_prof derived types
+      
+      ! Array with size nprof
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & npind         !: Source indices of profile data in compressed data
+
+   END TYPE obs_prof
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE obs_prof_alloc( prof,  kvar, kext, kprof,  &
+      &                       ko3dt, kstp, kpi, kpj, kpk )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!        !  07-03  (K. Mogensen) Generalized profiles
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof      ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kprof  ! Number of profiles
+      INTEGER, INTENT(IN) :: kvar   ! Number of variables
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN), DIMENSION(kvar) :: &
+         & ko3dt     ! Number of observations per variables
+      INTEGER, INTENT(IN) :: kstp   ! Number of time steps
+      INTEGER, INTENT(IN) :: kpi    ! Number of 3D grid points
+      INTEGER, INTENT(IN) :: kpj
+      INTEGER, INTENT(IN) :: kpk
+
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      prof%nvar      = kvar
+      prof%next      = kext
+      prof%nprof     = kprof
+
+      prof%nstp      = kstp
+      prof%npi       = kpi
+      prof%npj       = kpj
+      prof%npk       = kpk
+
+      ! Allocate arrays of size number of variables
+
+      ALLOCATE( &
+         & prof%nvprot(kvar),   &
+         & prof%nvprotmpp(kvar) &
+         )
+         
+      DO jvar = 1, kvar
+         prof%nvprot   (jvar) = ko3dt(jvar)
+         prof%nvprotmpp(jvar) = 0
+      END DO
+
+      ! Allocate arrays of size number of profiles
+      ! times number of variables
+      
+      ALLOCATE( &
+         & prof%npvsta(kprof,kvar), &  
+         & prof%npvend(kprof,kvar), &
+         & prof%mi(kprof,kvar),     &
+         & prof%mj(kprof,kvar),     &
+         & prof%ivqc(kprof,kvar)    &
+         )
+
+      ! Allocate arrays of size iqcfdef times number of profiles
+      ! times number of variables
+
+      ALLOCATE( &
+         & prof%ivqcf(idefnqcf,kprof,kvar) &
+         & )
+
+      ! Allocate arrays of size number of profiles
+
+      ALLOCATE( &
+         & prof%npidx(kprof),   &
+         & prof%npfil(kprof),   &
+         & prof%nyea(kprof),    &
+         & prof%nmon(kprof),    &
+         & prof%nday(kprof),    &
+         & prof%nhou(kprof),    &
+         & prof%nmin(kprof),    &
+         & prof%mstp(kprof),    &
+         & prof%nqc(kprof),     &
+         & prof%ipqc(kprof),    &
+         & prof%itqc(kprof),    &
+         & prof%ntyp(kprof),    &
+         & prof%rlam(kprof),    &
+         & prof%rphi(kprof),    &
+         & prof%cwmo(kprof),    &
+         & prof%npind(kprof)    &
+         & )
+
+      ! Allocate arrays of size idefnqcf times number of profiles
+
+      ALLOCATE( &
+         & prof%nqcf(idefnqcf,kprof),  &
+         & prof%ipqcf(idefnqcf,kprof), &
+         & prof%itqcf(idefnqcf,kprof)  &
+         & )
+
+      ! Allocate obs_prof_var type
+      ALLOCATE( &
+         & prof%var(kvar) &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, kvar
+
+         IF ( ko3dt(jvar) >= 0 ) THEN
+            CALL obs_prof_alloc_var( prof, jvar, kext, ko3dt(jvar) )
+         ENDIF
+         
+      END DO
+
+      ! Allocate arrays of size number of time step size
+
+      ALLOCATE( &
+         & prof%npstp(kstp),   &
+         & prof%npstpmpp(kstp) &
+         & )
+
+      ! Allocate arrays of size number of time step size times 
+      ! number of variables
+      
+      ALLOCATE( &
+         & prof%nvstp(kstp,kvar),   &
+         & prof%nvstpmpp(kstp,kvar) &
+         & )
+
+      ! Allocate arrays of size number of grid points size times
+      ! number of variables
+
+      ALLOCATE( &
+         & prof%vdmean(kpi,kpj,kpk,kvar) &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, kprof
+         prof%npind(ji) = ji
+      END DO
+
+      DO jvar = 1, kvar
+         DO ji = 1, ko3dt(jvar)
+            prof%var(jvar)%nvind(ji) = ji
+         END DO
+      END DO
+
+      ! Set defaults for number of observations per time step
+
+      prof%npstp(:)      = 0
+      prof%npstpmpp(:)   = 0
+      prof%nvstp(:,:)    = 0
+      prof%nvstpmpp(:,:) = 0
+      
+      ! Set the observation counter used in obs_oper
+
+      prof%nprofup     = 0
+
+   END SUBROUTINE obs_prof_alloc
+
+   SUBROUTINE obs_prof_dealloc( prof )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: &
+         & prof      ! Profile data to be deallocated
+
+      !!* Local variables
+      INTEGER :: &
+         & jvar
+
+      ! Deallocate arrays of size number of profiles
+      ! times number of variables
+      
+      DEALLOCATE( &
+         & prof%npvsta, &  
+         & prof%npvend  &
+         )
+
+      ! Dellocate arrays of size number of profiles size
+
+      DEALLOCATE( &
+         & prof%mi,      &
+         & prof%mj,      &
+         & prof%ivqc,    &
+         & prof%ivqcf,   &
+         & prof%npidx,   &
+         & prof%npfil,   &
+         & prof%nyea,    &
+         & prof%nmon,    &
+         & prof%nday,    &
+         & prof%nhou,    &
+         & prof%nmin,    &
+         & prof%mstp,    &
+         & prof%nqc,     &
+         & prof%ipqc,    &
+         & prof%itqc,    &
+         & prof%nqcf,    &
+         & prof%ipqcf,   &
+         & prof%itqcf,   &
+         & prof%ntyp,    &
+         & prof%rlam,    &
+         & prof%rphi,    &
+         & prof%cwmo,    &
+         & prof%npind    &
+         & )
+
+      ! For each variables allocate arrays of size number of observations
+
+      DO jvar = 1, prof%nvar
+
+         IF ( prof%nvprot(jvar) >= 0 ) THEN
+
+            CALL obs_prof_dealloc_var( prof, jvar )
+
+         ENDIF
+         
+      END DO
+
+      ! Dellocate obs_prof_var type
+      DEALLOCATE( &
+         & prof%var &
+         & )
+
+      ! Deallocate arrays of size number of time step size
+
+      DEALLOCATE( &
+         & prof%npstp,   &
+         & prof%npstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of time step size times 
+      ! number of variables
+      
+      DEALLOCATE( &
+         & prof%nvstp,   &
+         & prof%nvstpmpp &
+         & )
+
+      ! Deallocate arrays of size number of grid points size times
+      ! number of variables
+
+      DEALLOCATE( &
+         & prof%vdmean &
+         & )
+
+      ! Dellocate arrays of size number of variables
+
+      DEALLOCATE( &
+         & prof%nvprot,  &
+         & prof%nvprotmpp &
+         )
+
+
+   END SUBROUTINE obs_prof_dealloc
+
+
+   SUBROUTINE obs_prof_alloc_var( prof, kvar, kext, kobs )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar   ! Variable number
+      INTEGER, INTENT(IN) :: kext   ! Number of extra fields within each variable
+      INTEGER, INTENT(IN) :: kobs   ! Number of observations
+      
+      ALLOCATE( & 
+         & prof%var(kvar)%mvk(kobs),       &
+         & prof%var(kvar)%nvpidx(kobs),    &
+         & prof%var(kvar)%nvlidx(kobs),    &
+         & prof%var(kvar)%nvqc(kobs),      &
+         & prof%var(kvar)%idqc(kobs),      &
+         & prof%var(kvar)%vdep(kobs),      &
+         & prof%var(kvar)%vobs(kobs),      &
+         & prof%var(kvar)%vmod(kobs),      &
+         & prof%var(kvar)%nvind(kobs)      &
+         & )
+      ALLOCATE( & 
+         & prof%var(kvar)%idqcf(idefnqcf,kobs), &
+         & prof%var(kvar)%nvqcf(idefnqcf,kobs)  &
+         & )
+      IF (kext>0) THEN
+         ALLOCATE( & 
+            & prof%var(kvar)%vext(kobs,kext) &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_alloc_var
+
+   SUBROUTINE obs_prof_dealloc_var( prof, kvar )
+
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_alloc_var  ***
+      !!                      
+      !! ** Purpose : - Allocate data for variable data in profile arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen) Original code
+      !! * Arguments
+      TYPE(obs_prof), INTENT(INOUT) :: prof   ! Profile data to be allocated
+      INTEGER, INTENT(IN) :: kvar      ! Variable number
+      
+      DEALLOCATE( & 
+         & prof%var(kvar)%mvk,    &
+         & prof%var(kvar)%nvpidx, &
+         & prof%var(kvar)%nvlidx, &
+         & prof%var(kvar)%nvqc,   &
+         & prof%var(kvar)%idqc,   &
+         & prof%var(kvar)%vdep,   &
+         & prof%var(kvar)%vobs,   &
+         & prof%var(kvar)%vmod,   &
+         & prof%var(kvar)%nvind,  &
+         & prof%var(kvar)%idqcf,  &
+         & prof%var(kvar)%nvqcf   &
+         & )
+      IF (prof%next>0) THEN
+         DEALLOCATE( & 
+            & prof%var(kvar)%vext  &
+            & )
+      ENDIF
+
+   END SUBROUTINE obs_prof_dealloc_var
+
+   SUBROUTINE obs_prof_compress( prof,   newprof, lallocate, &
+      &                          kumout, lvalid,   lvvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_prof type
+      !!                into a new obs_prof type
+      !! 
+      !! ** Method  : - The data is copied from prof to new prof.
+      !!                In the case of lvalid and lvvalid both being
+      !!                present only the selected data will be copied.
+      !!                If lallocate is true the data in the newprof is 
+      !!                allocated either with the same number of elements
+      !!                as prof or with only the subset of elements defined
+      !!                by the optional selection in lvalid and lvvalid
+      !!
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof), INTENT(IN)    :: prof      ! Original profile
+      TYPE(obs_prof), INTENT(INOUT) :: newprof   ! New profile with the copy of the data
+      LOGICAL :: lallocate                ! Allocate newprof data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in) :: &
+         & lvalid        ! Valid profiles
+      TYPE(obs_prof_valid), OPTIONAL, INTENT(in), DIMENSION(prof%nvar) :: &
+         & lvvalid       ! Valid data within the profiles
+      
+      !!* Local variables
+      INTEGER :: inprof
+      INTEGER, DIMENSION(prof%nvar) :: &
+         & invpro
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj 
+      LOGICAL :: lfirst
+      TYPE(obs_prof_valid) :: &
+         & llvalid
+      TYPE(obs_prof_valid), DIMENSION(prof%nvar) :: &
+         & llvvalid
+      LOGICAL :: lallpresent
+      LOGICAL :: lnonepresent
+
+      ! Check that either all or none of the masks are persent.
+
+      lallpresent  = .FALSE.
+      lnonepresent = .FALSE.
+      IF ( PRESENT(lvalid) .AND. PRESENT(lvvalid) ) THEN
+         lallpresent =  .TRUE.
+      ELSEIF ( ( .NOT. PRESENT(lvalid)  ) .AND. &
+         &     ( .NOT. PRESENT(lvvalid) ) ) THEN
+         lnonepresent = .TRUE.
+      ELSE
+         CALL ctl_stop('Error in obs_prof_compress:', &
+            &          'Either all selection variables should be set', &
+            &          'or no selection variable should be set' )
+      ENDIF
+      
+      ! Count how many elements there should be in the new data structure
+
+      IF ( lallpresent ) THEN
+         inprof = 0
+         invpro(:) = 0
+         DO ji = 1, prof%nprof
+            IF ( lvalid%luse(ji) ) THEN
+               inprof=inprof+1
+               DO jvar = 1, prof%nvar
+                  DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                     IF ( lvvalid(jvar)%luse(jj) ) &
+                        &           invpro(jvar) = invpro(jvar) +1
+                  END DO
+               END DO
+            ENDIF
+         END DO
+      ELSE
+         inprof    = prof%nprof
+         invpro(:) = prof%nvprot(:)
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_prof_alloc( newprof,   prof%nvar, &
+            &                 prof%next,            &
+            &                 inprof,    invpro,    &
+            &                 prof%nstp, prof%npi,  &
+            &                 prof%npj,  prof%npk )
+      ENDIF
+
+      ! Allocate temporary mask array to unify the code for both cases
+
+      ALLOCATE( llvalid%luse(prof%nprof) )
+      DO jvar = 1, prof%nvar
+         ALLOCATE( llvvalid(jvar)%luse(prof%nvprot(jvar)) )
+      END DO
+      IF ( lallpresent ) THEN
+         llvalid%luse(:) = lvalid%luse(:)
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = lvvalid(jvar)%luse(:)
+         END DO
+      ELSE
+         llvalid%luse(:) = .TRUE.
+         DO jvar = 1, prof%nvar
+            llvvalid(jvar)%luse(:) = .TRUE.
+         END DO
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      inprof    = 0
+      invpro(:) = 0
+
+      newprof%npvsta(:,:) =  0
+      newprof%npvend(:,:) = -1
+      
+      ! Loop over source profiles
+
+      DO ji = 1, prof%nprof
+
+         IF ( llvalid%luse(ji) ) THEN
+
+            ! Copy the header information
+
+            inprof = inprof + 1
+
+            newprof%mi(inprof,:)  = prof%mi(ji,:)
+            newprof%mj(inprof,:) = prof%mj(ji,:)
+            newprof%npidx(inprof) = prof%npidx(ji)
+            newprof%npfil(inprof) = prof%npfil(ji)
+            newprof%nyea(inprof)  = prof%nyea(ji)
+            newprof%nmon(inprof)  = prof%nmon(ji)
+            newprof%nday(inprof)  = prof%nday(ji)
+            newprof%nhou(inprof)  = prof%nhou(ji)
+            newprof%nmin(inprof)  = prof%nmin(ji)
+            newprof%mstp(inprof)  = prof%mstp(ji)
+            newprof%nqc(inprof)   = prof%nqc(ji)
+            newprof%ipqc(inprof)  = prof%ipqc(ji)
+            newprof%itqc(inprof)  = prof%itqc(ji)
+            newprof%ivqc(inprof,:)= prof%ivqc(ji,:)
+            newprof%ntyp(inprof)  = prof%ntyp(ji)
+            newprof%rlam(inprof)  = prof%rlam(ji)
+            newprof%rphi(inprof)  = prof%rphi(ji)
+            newprof%cwmo(inprof)  = prof%cwmo(ji)
+            
+            ! QC info
+
+            newprof%nqcf(:,inprof)    = prof%nqcf(:,ji)
+            newprof%ipqcf(:,inprof)   = prof%ipqcf(:,ji)
+            newprof%itqcf(:,inprof)   = prof%itqcf(:,ji)
+            newprof%ivqcf(:,inprof,:) = prof%ivqcf(:,ji,:)
+            
+            ! npind is the index of the original profile
+            
+            newprof%npind(inprof) = ji
+
+            ! Copy the variable information
+
+            DO jvar = 1, prof%nvar
+
+               lfirst = .TRUE.
+               
+               DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+                  
+                  IF ( llvvalid(jvar)%luse(jj) ) THEN
+
+                     invpro(jvar) = invpro(jvar) + 1
+                  
+                     ! Book keeping information
+                                    
+                     IF ( lfirst ) THEN
+                        lfirst = .FALSE.
+                        newprof%npvsta(inprof,jvar) = invpro(jvar)
+                     ENDIF
+                     newprof%npvend(inprof,jvar) = invpro(jvar)
+
+                     ! Variable data
+                     
+                     newprof%var(jvar)%mvk(invpro(jvar))    = &
+                        &                           prof%var(jvar)%mvk(jj)
+                     newprof%var(jvar)%nvpidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvpidx(jj)
+                     newprof%var(jvar)%nvlidx(invpro(jvar)) = &
+                        &                           prof%var(jvar)%nvlidx(jj)
+                     newprof%var(jvar)%nvqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%nvqc(jj)
+                     newprof%var(jvar)%idqc(invpro(jvar))   = &
+                        &                           prof%var(jvar)%idqc(jj)
+                     newprof%var(jvar)%idqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%idqcf(:,jj)
+                     newprof%var(jvar)%nvqcf(:,invpro(jvar))= &
+                        &                           prof%var(jvar)%nvqcf(:,jj)
+                     newprof%var(jvar)%vdep(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vdep(jj)
+                     newprof%var(jvar)%vobs(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vobs(jj)
+                     newprof%var(jvar)%vmod(invpro(jvar))   = &
+                        &                           prof%var(jvar)%vmod(jj)
+                     DO jext = 1, prof%next
+                        newprof%var(jvar)%vext(invpro(jvar),jext) = &
+                           &                      prof%var(jvar)%vext(jj,jext)
+                     END DO
+                  
+                     ! nvind is the index of the original variable data
+                     
+                     newprof%var(jvar)%nvind(invpro(jvar))  = jj
+                     
+                  ENDIF
+
+               END DO
+
+            END DO
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      DO jvar = 1, prof%nvar
+         newprof%nvprot(jvar) = invpro(jvar)
+      END DO
+      CALL obs_mpp_sum_integers ( newprof%nvprot, newprof%nvprotmpp,&
+         &                        prof%nvar )
+      
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newprof%nvar     = prof%nvar
+      newprof%next     = prof%next
+      newprof%nstp     = prof%nstp
+      newprof%npi      = prof%npi
+      newprof%npj      = prof%npj
+      newprof%npk      = prof%npk
+ 
+      ! Deallocate temporary data
+
+      DO jvar = 1, prof%nvar
+         DEALLOCATE( llvvalid(jvar)%luse )
+      END DO
+ 
+      DEALLOCATE( llvalid%luse )
+     
+   END SUBROUTINE obs_prof_compress
+
+   SUBROUTINE obs_prof_decompress( prof, oldprof, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original profile type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed profile type into the original
+      !!                profile data and optionally deallocate the prof
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-01  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof      ! Updated profile data
+      TYPE(obs_prof),INTENT(INOUT) :: oldprof   ! Original profile data
+      LOGICAL :: ldeallocate         ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout   ! Output unit
+      
+      !!* Local variables
+      INTEGER :: jvar
+      INTEGER :: jext
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: jl
+
+      DO ji = 1, prof%nprof
+
+         ! Copy header information
+         
+         jk = prof%npind(ji)
+      
+         oldprof%mi(jk,:)  = prof%mi(ji,:)
+         oldprof%mj(jk,:)  = prof%mj(ji,:)
+         oldprof%npidx(jk) = prof%npidx(ji)
+         oldprof%npfil(jk) = prof%npfil(ji)
+         oldprof%nyea(jk)  = prof%nyea(ji)
+         oldprof%nmon(jk)  = prof%nmon(ji)
+         oldprof%nday(jk)  = prof%nday(ji)
+         oldprof%nhou(jk)  = prof%nhou(ji)
+         oldprof%nmin(jk)  = prof%nmin(ji)
+         oldprof%mstp(jk)  = prof%mstp(ji)
+         oldprof%nqc(jk)   = prof%nqc(ji)
+         oldprof%ipqc(jk)  = prof%ipqc(ji)
+         oldprof%itqc(jk)  = prof%itqc(ji)
+         oldprof%ivqc(jk,:)= prof%ivqc(ji,:)
+         oldprof%ntyp(jk)  = prof%ntyp(ji)
+         oldprof%rlam(jk)  = prof%rlam(ji)
+         oldprof%rphi(jk)  = prof%rphi(ji)
+         oldprof%cwmo(jk)  = prof%cwmo(ji)
+         
+         ! QC info
+
+         oldprof%nqcf(:,jk)    = prof%nqcf(:,ji)
+         oldprof%ipqcf(:,jk)   = prof%ipqcf(:,ji)
+         oldprof%itqcf(:,jk)   = prof%itqcf(:,ji)
+         oldprof%ivqcf(:,jk,:) = prof%ivqcf(:,ji,:)
+
+         ! Copy the variable information
+
+         DO jvar = 1, prof%nvar
+
+            DO jj = prof%npvsta(ji,jvar), prof%npvend(ji,jvar)
+               
+               jl = prof%var(jvar)%nvind(jj)
+
+               oldprof%var(jvar)%mvk(jl)    = prof%var(jvar)%mvk(jj)
+               oldprof%var(jvar)%nvpidx(jl) = prof%var(jvar)%nvpidx(jj)
+               oldprof%var(jvar)%nvlidx(jl) = prof%var(jvar)%nvlidx(jj)
+               oldprof%var(jvar)%nvqc(jl)   = prof%var(jvar)%nvqc(jj)
+               oldprof%var(jvar)%idqc(jl)   = prof%var(jvar)%idqc(jj)
+               oldprof%var(jvar)%vdep(jl)   = prof%var(jvar)%vdep(jj)
+               oldprof%var(jvar)%vobs(jl)   = prof%var(jvar)%vobs(jj)
+               oldprof%var(jvar)%vmod(jl)   = prof%var(jvar)%vmod(jj)
+               oldprof%var(jvar)%idqcf(:,jl) = prof%var(jvar)%idqcf(:,jj)
+               oldprof%var(jvar)%nvqcf(:,jl) = prof%var(jvar)%nvqcf(:,jj)
+               DO jext = 1, prof%next
+                  oldprof%var(jvar)%vext(jl,jext) = &
+                     &                        prof%var(jvar)%vext(jj,jext)
+               END DO
+               
+            END DO
+
+         END DO
+         
+      END DO
+
+      ! Optionally deallocate the updated profile data
+
+      IF ( ldeallocate ) CALL obs_prof_dealloc( prof )
+      
+   END SUBROUTINE obs_prof_decompress
+
+   SUBROUTINE obs_prof_staend( prof, kvarno )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_prof_decompress  ***
+      !!                      
+      !! ** Purpose : - Set npvsta and npvend of a variable within 
+      !!                an obs_prof_var type
+      !!
+      !! ** Method  : - Find the start and stop of a profile by searching 
+      !!                through the data
+      !! 
+      !! History :
+      !!        !  07-04  (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_prof),INTENT(INOUT) :: prof     ! Profile data
+      INTEGER,INTENT(IN) :: kvarno     ! Variable number
+
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: iprofno
+
+      !-----------------------------------------------------------------------
+      ! Compute start and end bookkeeping arrays
+      !-----------------------------------------------------------------------
+
+      prof%npvsta(:,kvarno) = prof%nvprot(kvarno) + 1
+      prof%npvend(:,kvarno) = -1
+      DO ji = 1, prof%nvprot(kvarno)
+         iprofno = prof%var(kvarno)%nvpidx(ji)
+         prof%npvsta(iprofno,kvarno) = &
+            & MIN( ji, prof%npvsta(iprofno,kvarno) )
+         prof%npvend(iprofno,kvarno) = &
+            & MAX( ji, prof%npvend(iprofno,kvarno) )
+      END DO
+
+      DO ji = 1, prof%nprof
+         IF ( prof%npvsta(ji,kvarno) == ( prof%nvprot(kvarno) + 1 ) ) &
+            & prof%npvsta(ji,kvarno) = 0
+      END DO
+
+   END SUBROUTINE obs_prof_staend
+   
+END MODULE obs_profiles_def
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_altbias.F90	(revision 3437)
@@ -0,0 +1,216 @@
+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( kslano, sladata, k2dint, bias_file )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_altbias ***
+      !!
+      !! ** Purpose : Read from file the bias data 
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References :
+      !!
+      !! History :  
+      !!      ! :  2008-02 (D. Lea) Initial version
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE iom
+      !
+      !! * Arguments
+      INTEGER, INTENT(IN) :: kslano      ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(INOUT) :: &
+         & sladata       ! SLA data
+      INTEGER, INTENT(IN) :: k2dint
+      CHARACTER(LEN=128) :: bias_file
+
+      !! * Local declarations
+
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_rea_altbias'
+
+      INTEGER :: jslano       ! Data set loop variable
+      INTEGER :: jobs         ! Obs loop variable
+      INTEGER :: jpialtbias   ! Number of grid point in latitude for the bias
+      INTEGER :: jpjaltbias   ! Number of grid point in longitude for the bias
+      INTEGER :: iico         ! Grid point indicies
+      INTEGER :: ijco
+      INTEGER :: i_nx_id      ! Index to read the NetCDF file
+      INTEGER :: i_ny_id      ! 
+      INTEGER :: i_file_id    ! 
+      INTEGER :: i_var_id
+
+      REAL(wp), DIMENSION(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
+  
+      DO jslano = 1, kslano
+
+         ALLOCATE( &
+            & igrdi(2,2,sladata(jslano)%nsurf), &
+            & igrdj(2,2,sladata(jslano)%nsurf), &
+            & zglam(2,2,sladata(jslano)%nsurf), &
+            & zgphi(2,2,sladata(jslano)%nsurf), &
+            & zmask(2,2,sladata(jslano)%nsurf), &
+            & zbias(2,2,sladata(jslano)%nsurf)  &
+            & )
+         
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
+            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
+
+         END DO
+
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, glamt, zglam )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, gphit, zgphi )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, tmask(:,:,1), zmask )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, &
+            &                  igrdi, igrdj, z_altbias, zbias )
+
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            zlam = sladata(jslano)%rlam(jobs)
+            zphi = sladata(jslano)%rphi(jobs)
+            iico = sladata(jslano)%mi(jobs)
+            ijco = sladata(jslano)%mj(jobs)
+            
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+               &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+            CALL obs_int_h2d( 1, 1,      &
+               &              zweig, zbias(:,:,jobs),  zext )
+
+            ! adjust mdt with bias field
+            sladata(jslano)%rext(jobs,2) = &
+               sladata(jslano)%rext(jobs,2) - zext(1)
+            
+         END DO
+
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zbias  &
+            & )
+         
+      END DO
+
+      CALL wrk_dealloc(jpi,jpj,z_altbias) 
+
+   END SUBROUTINE obs_rea_altbias
+
+
+ 
+END MODULE obs_read_altbias
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90	(revision 3437)
@@ -0,0 +1,828 @@
+MODULE obs_read_prof
+   !!======================================================================
+   !!                       ***  MODULE obs_read_prof  ***
+   !! Observation diagnostics: Read the T and S profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_pro_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_prof_io              ! Profile files I/O (non-FB files)
+   USE lib_mpp                  ! For ctl_warn/stop
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_pro_dri  ! Read the profile observations 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_pro_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldt3d, lds3d, ldignmis, ldsatt, ldavtimset, &
+      &                        ldmod, kdailyavtypes )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-09 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER ::  kformat    ! Format of input data
+      !                      ! 1: ENACT
+      !                      ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) ::  profdata     ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles)  ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldt3d       ! Observed variables switches
+      LOGICAL, INTENT(IN) :: lds3d
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldsatt      ! Compute salinity at all temperature points
+      LOGICAL, INTENT(IN) :: ldavtimset  ! Correct time for daily averaged data
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, DIMENSION(imaxavtypes), OPTIONAL :: &
+         & kdailyavtypes
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_pro_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypt,    &
+         & ityptmpp, &
+         & ityps,    &
+         & itypsmpp 
+      INTEGER :: it3dtmpp
+      INTEGER :: is3dtmpp
+      INTEGER :: ip3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      INTEGER, DIMENSION(imaxavtypes) :: &
+         & idailyavtypes
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: it3dt0
+      INTEGER :: is3dt0
+      INTEGER :: it3dt
+      INTEGER :: is3dt
+      INTEGER :: ip3dt
+      INTEGER, DIMENSION(kvars) :: &
+         & iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      it3dt0 = 0
+      is3dt0 = 0
+      ip3dt = 0
+
+      ! Daily average types
+      IF ( PRESENT(kdailyavtypes) ) THEN
+         idailyavtypes(:) = kdailyavtypes(:)
+      ELSE
+         idailyavtypes(:) = -1
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_pro_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 2 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'POTM' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(2)) /= 'PSAL' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_enactfile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSEIF ( kformat == 2 ) THEN
+               CALL read_coriofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data for example
+                  !  MRB data (itype==820) force the time
+                  !  to be the  end of the day
+                  !
+                  READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+                  IF ( ANY (idailyavtypes == itype ) ) THEN
+                     inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+                  ENDIF
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+                  & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ldt3d ) THEN
+                     loop_t_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           it3dt0 = it3dt0 + 1
+                        ENDIF
+                     END DO loop_t_count
+                  ENDIF
+                  IF ( lds3d ) THEN
+                     loop_s_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           is3dt0 = is3dt0 + 1
+                        ENDIF
+                     END DO loop_s_count
+                  ENDIF
+                  loop_p_count : DO ij = 1,inpfiles(jj)%nlev
+                     IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                        & CYCLE
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) THEN
+                        ip3dt = ip3dt + 1
+                        llvalprof = .TRUE.
+                     ENDIF
+                  END DO loop_p_count
+
+                  IF ( llvalprof ) iprof = iprof + 1
+
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO prof_files
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      IF (ldsatt) THEN
+         iv3dt(1) = ip3dt
+         iv3dt(2) = ip3dt
+      ELSE
+         iv3dt(1) = it3dt0
+         iv3dt(2) = is3dt0
+      ENDIF
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+      
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+
+      iprof = 0
+
+      ip3dt = 0
+      it3dt = 0
+      is3dt = 0
+      itypt   (:) = 0
+      ityptmpp(:) = 0
+      
+      ityps   (:) = 0
+      itypsmpp(:) = 0
+      
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+            & ( inpfiles(jj)%ivqc(ji,2) > 2 )) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+
+            IF ( ( inpfiles(jj)%ivqc(ji,1) > 2 ) .AND. &
+               & ( inpfiles(jj)%ivqc(ji,2) > 2 ) ) CYCLE
+
+            loop_prof : DO ij = 1, inpfiles(jj)%nlev
+               
+               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                  & CYCLE
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                  
+                  llvalprof = .TRUE. 
+                  EXIT loop_prof
+                  
+               ENDIF
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                  
+                  llvalprof = .TRUE. 
+                  EXIT loop_prof
+                  
+               ENDIF
+               
+            END DO loop_prof
+            
+            ! Set profile information
+            
+            IF ( llvalprof ) THEN
+               
+               iprof = iprof + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,:) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,:) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_p : DO ij = 1, inpfiles(jj)%nlev            
+                  
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF (ldsatt) THEN
+
+                     IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     ldt3d ) .OR. &
+                        & ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                        &     lds3d ) ) THEN
+                        ip3dt = ip3dt + 1
+                     ELSE
+                        CYCLE
+                     ENDIF
+                     
+                  ENDIF
+
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     &     ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &       ldt3d ) .OR. ldsatt ) THEN
+                     
+                     IF (ldsatt) THEN
+
+                        it3dt = ip3dt
+
+                     ELSE
+
+                        it3dt = it3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of T observation
+                     profdata%var(1)%vdep(it3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of T observation QC
+                     profdata%var(1)%idqc(it3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of T observation QC flags
+                     profdata%var(1)%idqcf(:,it3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(1)%nvpidx(it3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(1)%nvlidx(it3dt) = ij
+
+                     ! Profile potential T value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(1)%vobs(it3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,1)
+                        IF ( ldmod ) THEN
+                           profdata%var(1)%vmod(it3dt) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,1)
+                        ENDIF
+                        ! Count number of profile T data as function of type
+                        itypt( profdata%ntyp(iprof) + 1 ) = &
+                           & itypt( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(1)%vobs(it3dt) = fbrmdi
+                     ENDIF
+
+                     ! Profile T qc
+                     profdata%var(1)%nvqc(it3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,1)
+
+                     ! Profile T qc flags
+                     profdata%var(1)%nvqcf(:,it3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+
+                     ! Profile insitu T value
+                     profdata%var(1)%vext(it3dt,1) = &
+                        &                inpfiles(jj)%pext(ij,ji,1)
+                     
+                  ENDIF
+                  
+                  IF ( ( ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     &   ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) .AND. &
+                     &   lds3d ) .OR. ldsatt ) THEN
+                     
+                     IF (ldsatt) THEN
+
+                        is3dt = ip3dt
+
+                     ELSE
+
+                        is3dt = is3dt + 1
+                        
+                     ENDIF
+
+                     ! Depth of S observation
+                     profdata%var(2)%vdep(is3dt) = &
+                        &                inpfiles(jj)%pdep(ij,ji)
+                     
+                     ! Depth of S observation QC
+                     profdata%var(2)%idqc(is3dt) = &
+                        &                inpfiles(jj)%idqc(ij,ji)
+                     
+                     ! Depth of S observation QC flags
+                     profdata%var(2)%idqcf(:,is3dt) = &
+                        &                inpfiles(jj)%idqcf(:,ij,ji)
+                     
+                     ! Profile index
+                     profdata%var(2)%nvpidx(is3dt) = iprof
+                     
+                     ! Vertical index in original profile
+                     profdata%var(2)%nvlidx(is3dt) = ij
+
+                     ! Profile S value
+                     IF ( ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                        & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                        profdata%var(2)%vobs(is3dt) = &
+                           &                inpfiles(jj)%pob(ij,ji,2)
+                        IF ( ldmod ) THEN
+                           profdata%var(2)%vmod(is3dt) = &
+                              &                inpfiles(jj)%padd(ij,ji,1,2)
+                        ENDIF
+                        ! Count number of profile S data as function of type
+                        ityps( profdata%ntyp(iprof) + 1 ) = &
+                           & ityps( profdata%ntyp(iprof) + 1 ) + 1
+                     ELSE
+                        profdata%var(2)%vobs(is3dt) = fbrmdi
+                     ENDIF
+                     
+                     ! Profile S qc
+                     profdata%var(2)%nvqc(is3dt) = &
+                        & inpfiles(jj)%ivlqc(ij,ji,2)
+
+                     ! Profile S qc flags
+                     profdata%var(2)%nvqcf(:,is3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+
+                  ENDIF
+            
+               END DO loop_p
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer ( it3dt0, it3dtmpp )
+      CALL obs_mpp_sum_integer ( is3dt0, is3dtmpp )
+      CALL obs_mpp_sum_integer ( ip3dt, ip3dtmpp )
+      
+      CALL obs_mpp_sum_integers( itypt, ityptmpp, ntyp1770 + 1 )
+      CALL obs_mpp_sum_integers( ityps, itypsmpp, ntyp1770 + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile data'
+         WRITE(numout,'(1X,A)') '------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile T data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( ityptmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & ityptmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile T data                                 = ',&
+            & it3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile S data'
+         WRITE(numout,'(1X,A)') '--------------'
+         DO ji = 0, ntyp1770
+            IF ( itypsmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,1X,A48,A3,I8)') ctypshort(ji), &
+                  & cwmonam1770(ji)(1:52),' = ', &
+                  & itypsmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,'(1X,A55,I8)') &
+            & 'Total profile S data                                 = ',&
+            & is3dtmpp
+         WRITE(numout,'(1X,A)') &
+            & '---------------------------------------------------------------'
+         WRITE(numout,*) 
+      ENDIF
+      
+      IF (ldsatt) THEN
+         profdata%nvprot(1)    = ip3dt
+         profdata%nvprot(2)    = ip3dt
+         profdata%nvprotmpp(1) = ip3dtmpp
+         profdata%nvprotmpp(2) = ip3dtmpp
+      ELSE
+         profdata%nvprot(1)    = it3dt
+         profdata%nvprot(2)    = is3dt
+         profdata%nvprotmpp(1) = it3dtmpp
+         profdata%nvprotmpp(2) = is3dtmpp
+      ENDIF
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      IF ( ldt3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(1), profdata%var(1)%vdep, &
+            & profdata%var(1)%mvk )
+      ENDIF
+      IF ( lds3d ) THEN
+         CALL obs_level_search( jpk, gdept_0, &
+            & profdata%nvprot(2), profdata%var(2)%vdep, &
+            & profdata%var(2)%mvk )
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_pro_dri
+
+END MODULE obs_read_prof
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90	(revision 3437)
@@ -0,0 +1,455 @@
+MODULE obs_read_seaice
+   !!======================================================================
+   !!                       ***  MODULE obs_read_seaice  ***
+   !! Observation diagnostics: Read the along track SEAICE data from
+   !!                          GHRSST or any SEAICE data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_seaice : Driver for reading seaice data from the GHRSST/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_seaice_io            ! I/O for seaice files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_seaice      ! Read the seaice observations from the point data
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_seaice( kformat, &
+      &                    seaicedata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_seaice ***
+      !!
+      !! ** Purpose : Read from file the seaice data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data 
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & seaicedata     ! seaice data to be read
+      INTEGER, INTENT(IN) :: knumfiles   ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars    ! Number of variables in seaicedata
+      INTEGER, INTENT(IN) :: kextr    ! Number of extra fields for each var in seaicedata
+      INTEGER, INTENT(IN) :: kstp     ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=14), PARAMETER :: cpname='obs_rea_seaice'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: iseaicemaxtype = 1024
+      INTEGER, DIMENSION(0:iseaicemaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & iseaiceidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      seaice_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_seaice : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next < 2 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_seaice( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO seaice_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      iseaiceidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iseaiceidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( seaicedata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to seaicedata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iseaiceidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! seaice time coordinates
+               seaicedata%nyea(iobs) = iyea
+               seaicedata%nmon(iobs) = imon
+               seaicedata%nday(iobs) = iday
+               seaicedata%nhou(iobs) = ihou
+               seaicedata%nmin(iobs) = imin
+               
+               ! seaice space coordinates
+               seaicedata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               seaicedata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               seaicedata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               seaicedata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               seaicedata%ntyp(iobs) = itype
+               IF ( itype < iseaicemaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase iseaicemaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               seaicedata%nsidx(iobs) = iobs
+               seaicedata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               seaicedata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               seaicedata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  seaicedata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  seaicedata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Seaice data types'
+         WRITE(numout,'(1X,A)')'-----------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iseaiceidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_seaice
+
+END MODULE obs_read_seaice
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90	(revision 3437)
@@ -0,0 +1,539 @@
+MODULE obs_read_sla
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sla  ***
+   !! Observation diagnostics: Read the along track SLA data from
+   !!                          the AVISO/CLS database or any SLA data 
+   !!                          from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sla : Driver for reading SLA data from the AVISO/CLS/feedback
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sla_io               ! I/O for sla files
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sla  ! Read the SLA observations from the AVISO/SLA database
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_sla( kformat, &
+      &                    sladata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod, ldobstd )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sla ***
+      !!
+      !! ** Purpose : Read from file the SLA data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat    ! Format of input data
+      !                     ! 0: Feedback
+      !                     ! 1: AVISO
+      TYPE(obs_surf), INTENT(INOUT) :: sladata    ! SLA data to be read
+      INTEGER, INTENT(IN) :: knumfiles      ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  &
+         & cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars     ! Number of variables in sladata
+      INTEGER, INTENT(IN) :: kextr     ! Number of extra fields for each var in sladata
+      INTEGER, INTENT(IN) :: kstp      ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      LOGICAL, INTENT(INOUT), optional :: &
+         & ldobstd        ! Read observation standard deviation from fb. file
+      REAL(KIND=dp), INTENT(IN) :: ddobsini  ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend  ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sla'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER :: iobsmpp
+      INTEGER, DIMENSION(imaxmissions+1) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & islaidx
+      INTEGER :: itype 
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      LOGICAL :: llobstd
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER, DIMENSION(knumfiles) :: &
+         & iobspos, &
+         & iobcpos
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+      IF ( PRESENT(ldobstd) ) THEN
+         IF (.NOT.ldmod) THEN
+            llobstd = .false.
+         ELSE
+            llobstd = ldobstd
+         ENDIF
+      ELSE
+         llobstd = .FALSE.
+      ENDIF
+ 
+      !-----------------------------------------------------------------------
+      ! Check that the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Check that the prescribed obs err is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( llobstd .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Observation error can only be read from feedback files' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sla_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sla : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( inpfiles(jj)%nvar < 1 ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%cname(1)) /= 'SLA' ) THEN
+                  CALL ctl_stop( 'Feedback format error' )
+                  RETURN
+               ENDIF 
+               IF ( ldmod .AND. ( ( inpfiles(jj)%nadd == 0 ) .OR.&
+                  &               ( inpfiles(jj)%next == 0 ) ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_avisofile( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                    numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+               IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+      
+      END DO sla_files
+
+      IF (llobstd) THEN
+         
+         DO jj = 1, inobf
+            iobspos(jj) = -1
+            iobcpos(jj) = -1
+            DO ji = 1,inpfiles(jj)%nadd
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OSTD' ) THEN
+                  iobspos(jj)=ji
+               ENDIF
+               IF ( TRIM(inpfiles(jj)%caddname(ji)) == 'OCNT' ) THEN
+                  iobcpos(jj)=ji
+               ENDIF
+            END DO
+         END DO
+         llobstd = ( ( MINVAL(iobspos) > 0 ) .AND. ( MINVAL(iobcpos) > 0 ) )
+         IF (llobstd) THEN
+            IF (lwp) WRITE(numout,*)'SLA superobs information present.'
+         ELSE
+            IF (lwp) WRITE(numout,*)'SLA superobs information not present.'
+         ENDIF
+
+      ENDIF
+      
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      islaidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+            IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               islaidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sladata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sladata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = islaidx(iindx(jk))
+
+         IF ( inpfiles(jj)%ioqc(ji) > 2 ) CYCLE
+         IF ( inpfiles(jj)%ivqc(ji,1) > 2 ) CYCLE
+
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SLA time coordinates
+               sladata%nyea(iobs) = iyea
+               sladata%nmon(iobs) = imon
+               sladata%nday(iobs) = iday
+               sladata%nhou(iobs) = ihou
+               sladata%nmin(iobs) = imin
+               
+               ! SLA space coordinates
+               sladata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sladata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sladata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sladata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sladata%ntyp(iobs) = itype
+               ityp(itype+1) = ityp(itype+1) + 1
+
+               ! Identifier
+               sladata%cwmo(iobs) = inpfiles(jj)%cdwmo(ji)
+
+               ! Bookkeeping data to match observations
+               sladata%nsidx(iobs) = iobs
+               sladata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sladata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sladata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sladata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+                  sladata%rext(iobs,1) = inpfiles(jj)%padd(1,ji,2,1)
+                  sladata%rext(iobs,2) = inpfiles(jj)%pext(1,ji,1)
+                  IF (llobstd) THEN
+                     sladata%rext(iobs,3) = &
+                        & inpfiles(jj)%padd(1,ji,iobspos(jj),1)
+                     sladata%rext(iobs,4) = &
+                        & inpfiles(jj)%padd(1,ji,iobcpos(jj),1)
+                  ENDIF
+               ELSE
+                  sladata%rmod(iobs,1) = fbrmdi
+                  sladata%rext(iobs,:) = fbrmdi
+               ENDIF
+
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      CALL obs_mpp_sum_integers( ityp, itypmpp, imaxmissions + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'Altimeter satellites'
+         WRITE(numout,'(1X,A)')'--------------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A38,A2,I10)')calttyp(jj-1),'= ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, islaidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+      !-----------------------------------------------------------------------
+      ! Reset ldobstd if the data is present
+      !-----------------------------------------------------------------------
+      IF ( PRESENT(ldobstd) ) THEN
+         ldobstd = llobstd
+      ENDIF
+
+   END SUBROUTINE obs_rea_sla
+
+END MODULE obs_read_sla
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90	(revision 3437)
@@ -0,0 +1,762 @@
+MODULE obs_read_sst
+   !!======================================================================
+   !!                       ***  MODULE obs_read_sst  ***
+   !! Observation diagnostics: Read the SST data from the GHRSST database 
+   !!                          or any SST data from feedback files
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_sst : Driver for reading SST data from the GHRSST/feedback
+   !!   obs_rea_sst_rey : Driver for reading SST data from Reynolds
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_surf_def             ! Surface observation definitions
+   USE obs_types                ! Observation type definitions
+   USE obs_sst_io               ! I/O for sst files
+   USE iom                      ! I/O of fields for Reynolds data
+   USE netcdf                   ! NetCDF library
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_sst      ! Read the SST observations from the point data
+   PUBLIC obs_rea_sst_rey  ! Read the gridded Reynolds SST 
+   
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_rea_sst( kformat, &
+      &                    sstdata, knumfiles, cfilenames, &
+      &                    kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                    ldignmis, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the SST data
+      !!
+      !! ** Method  : Depending on kformat either AVISO or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) Initial version based on old versions
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 0: Feedback
+      !                    ! 1: GHRSST
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata   ! SST data to be read
+      INTEGER, INTENT(IN) :: knumfiles    ! Number of corio format files to read in
+      CHARACTER(LEN=128), INTENT(IN) :: cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata
+      INTEGER, INTENT(IN) :: kextr      ! Number of extra fields for each var in sstdata
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis   ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldmod      ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+         
+      !! * Local declarations
+      CHARACTER(LEN=11), PARAMETER :: cpname='obs_rea_sst'
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: irefdate
+      INTEGER :: iobsmpp
+      INTEGER, PARAMETER :: isstmaxtype = 1024
+      INTEGER, DIMENSION(0:isstmaxtype) :: &
+         & ityp, &
+         & itypmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsi,    &
+         & iobsj,    &
+         & iproc,    &
+         & iindx,    &
+         & ifileidx, &
+         & isstidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iobs
+      INTEGER :: iobstot
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iobs = 0
+ 
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+      
+      ALLOCATE( inpfiles(inobf) )
+
+      sst_files : DO jj = 1, inobf
+
+         CALL init_obfbdata( inpfiles(jj) )
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_sst : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1) THEN
+               CALL read_ghrsst( TRIM( cfilenames(jj) ), inpfiles(jj), &
+               &                 numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsi(inowin) )
+            ALLOCATE( iobsj(inowin) )
+            ALLOCATE( iproc(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsi, iobsj, iproc, 'T' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iproc(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsi(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsj(inowin)
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsi, iobsj, iproc )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+                     & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+                     iobs = iobs + 1
+                  ENDIF
+               ENDIF
+            END DO
+
+         ENDIF
+
+      END DO sst_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iobstot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iobstot = iobstot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iobstot), ifileidx(iobstot), &
+         &      isstidx(iobstot), zdat(iobstot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               isstidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iobstot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      CALL obs_surf_alloc( sstdata, iobs, kvars, kextr, kstp )
+      
+      ! * Read obs/positions, QC, all variable and assign to sstdata
+ 
+      iobs = 0
+
+      ityp   (:) = 0
+      itypmpp(:) = 0
+      
+      DO jk = 1, iobstot
+         
+         jj = ifileidx(iindx(jk))
+         ji = isstidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            ! Set observation information
+            
+            IF ( ( inpfiles(jj)%ivlqc(1,ji,1) == 1 ) .OR. &
+               & ( inpfiles(jj)%ivlqc(1,ji,1) == 2 ) ) THEN
+
+               iobs = iobs + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! SST time coordinates
+               sstdata%nyea(iobs) = iyea
+               sstdata%nmon(iobs) = imon
+               sstdata%nday(iobs) = iday
+               sstdata%nhou(iobs) = ihou
+               sstdata%nmin(iobs) = imin
+               
+               ! SST space coordinates
+               sstdata%rlam(iobs) = inpfiles(jj)%plam(ji)
+               sstdata%rphi(iobs) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               sstdata%mi  (iobs) = inpfiles(jj)%iobsi(ji,1)
+               sstdata%mj  (iobs) = inpfiles(jj)%iobsj(ji,1)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               sstdata%ntyp(iobs) = itype
+               IF ( itype < isstmaxtype + 1 ) THEN
+                  ityp(itype+1) = ityp(itype+1) + 1
+               ELSE
+                  IF(lwp)WRITE(numout,*)'WARNING:Increase isstmaxtype in ',&
+                     &                  cpname
+               ENDIF
+
+               ! Bookkeeping data to match observations
+               sstdata%nsidx(iobs) = iobs
+               sstdata%nsfil(iobs) = iindx(jk)
+
+               ! QC flags
+               sstdata%nqc(iobs) = inpfiles(jj)%ivqc(ji,1)
+
+               ! Observed value
+               sstdata%robs(iobs,1) = inpfiles(jj)%pob(1,ji,1)
+
+
+               ! Model and MDT is set to fbrmdi unless read from file
+               IF ( ldmod ) THEN
+                  sstdata%rmod(iobs,1) = inpfiles(jj)%padd(1,ji,1,1)
+               ELSE
+                  sstdata%rmod(iobs,1) = fbrmdi
+               ENDIF
+            ENDIF
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer( iobs, iobsmpp )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF (lwp) THEN
+
+         WRITE(numout,*)
+         WRITE(numout,'(1X,A)')'SST data types'
+         WRITE(numout,'(1X,A)')'--------------'
+         DO jj = 1,8
+            IF ( itypmpp(jj) > 0 ) THEN
+               WRITE(numout,'(1X,A4,I4,A3,I10)')'Type ', jj,' = ',itypmpp(jj)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A50)')'--------------------------------------------------'
+         WRITE(numout,'(1X,A40,I10)')'Total                                 = ',iobsmpp
+         WRITE(numout,*)
+
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, isstidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         IF ( inpfiles(jj)%lalloc ) THEN
+            CALL dealloc_obfbdata( inpfiles(jj) )
+         ENDIF
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_sst
+
+   SUBROUTINE obs_rea_sst_rey( sstname, cdsstfmt, sstdata, kvars, kextra, &
+      &                        kstp, ddobsini, ddobsend )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_sst ***
+      !!
+      !! ** Purpose : Read from file the pseudo SST data from Reynolds
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      USE par_oce          ! Ocean parameters
+   
+      !! * Arguments
+      CHARACTER(len=128), INTENT(IN) :: sstname   ! Generic file name
+      CHARACTER(len=12), INTENT(IN) :: cdsstfmt   ! Format of SST files (yearly/monthly)
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata    ! SST data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini    ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend    ! Obs. end time in YYYYMMDD.HHMMSS
+      INTEGER, INTENT(IN) :: kvars      ! Number of variables in sstdata structures
+      INTEGER, INTENT(IN) :: kextra     ! Number of extra variables in sstdata structures
+      INTEGER, INTENT(IN) :: kstp       ! Ocean time-step index
+      
+      INTEGER :: iyear
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihour
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER :: ihhmmss
+      INTEGER :: iyear1
+      INTEGER :: iyear2
+      INTEGER :: imon1
+      INTEGER :: imon2
+      INTEGER :: iyearf
+      INTEGER :: imonf
+      REAL(KIND=wp) :: pjulini
+      REAL(KIND=wp) :: pjulend
+      REAL(KIND=wp) :: pjulb
+      REAL(KIND=wp) :: pjule
+      REAL(KIND=wp) :: pjul
+      INTEGER :: inumsst
+      INTEGER :: itotrec
+      INTEGER :: inumobs
+      INTEGER :: irec
+      INTEGER :: ifld
+      INTEGER :: inum
+      INTEGER :: ji, jj
+      CHARACTER(len=128) :: clname
+      CHARACTER(len=4) :: cdyear
+      CHARACTER(len=2) :: cdmon
+      REAL(kind=wp), ALLOCATABLE, DIMENSION(:,:,:) :: zsstin
+
+      IF (lwp) WRITE(numout,*)'In obs_rea_sst_rey',sstname
+
+      !-----------------------------------------------------------------------
+      ! Convert observation window to julian dates.
+      !-----------------------------------------------------------------------
+      iyear1 = NINT( ddobsini / 10000 )
+      imon1 = NINT( ( ddobsini - iyear1 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsini ), 100 )
+      ihhmmss = ( ddobsini - NINT( ddobsini ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon1, iyear1, pjulini )
+      IF (lwp) WRITE(numout,*)'dateini',ddobsini,iyear1,imon1,iday,ihour, &
+         & imin,isec,pjulini
+
+      iyear2 = NINT( ddobsini / 10000 )
+      imon2 = NINT( ( ddobsend - iyear2 * 10000 ) / 100 )
+      iday = MOD( NINT( ddobsend ), 100 )
+      ihhmmss = ( ddobsend - NINT( ddobsend ) ) * 1000000
+      ihour = ihhmmss / 10000
+      imin = ( ihhmmss - ihour * 100 ) / 100
+      isec = MOD( ihhmmss, 100 )
+      CALL greg2jul ( isec, imin, ihour, iday, imon2, iyear2, pjulend )
+      IF (lwp) WRITE(numout,*)'dateend',ddobsend,iyear2,imon2,iday,ihour, &
+         & imin,isec,pjulend
+
+      itotrec = NINT( pjulend - pjulini ) 
+      ALLOCATE( &
+         & zsstin( jpi, jpj, itotrec) &
+         & )
+      
+      pjul = pjulini + 1
+      
+      iyearf = -1 
+      imonf = -1
+
+      IF ( TRIM(cdsstfmt) == 'yearly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, 1, iyear, pjulb )
+               
+               IF ( iyearf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+               jj = INDEX( clname, 'YYYY' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSEIF ( TRIM(cdsstfmt) == 'monthly' ) THEN
+
+         DO
+         
+            CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+               &           pjul, 19500101 )
+            !
+            IF ( iyear /= iyearf .OR. imon /= imonf ) THEN
+               
+               CALL greg2jul ( 0, 0, 0, 1, imon, iyear, pjulb )
+               
+               IF ( iyearf /= -1 .AND. imonf /= -1 ) THEN
+                  
+                  CALL iom_close ( inumsst )      
+                  
+               ENDIF
+               
+               clname = sstname
+
+               jj = INDEX( clname, 'YYYY' )
+
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdyear,'(I4.4)') iyear
+               clname(jj:jj+3) = cdyear
+
+               jj = INDEX( clname, 'MM' )
+               
+               IF ( jj == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                  &           'Error processing filename ' // TRIM(sstname) )
+                  
+               ENDIF
+               
+               WRITE(cdmon,'(I2.2)') imon
+               clname(jj:jj+1) = cdmon
+
+
+               IF(lwp) WRITE(numout,*)'Reading from Reynolds SST file : ',&
+                  & TRIM(clname)
+               
+               inumsst = 0
+               
+               CALL iom_open ( clname, inumsst )
+               
+               IF ( inumsst == 0 ) THEN
+                  
+                  CALL ctl_stop( 'obs_rea_sst_rey : ', &
+                     &           'Error reading ' // TRIM(clname) )
+                  
+               ENDIF
+               
+               iyearf = iyear
+               imonf = iyear
+               
+            ENDIF
+            
+            irec = pjul - pjulb + 1
+            ifld = pjul - pjulini
+            
+            CALL iom_get ( inumsst, jpdom_data, 'sst', zsstin(:,:,ifld), irec )
+            
+            pjul = pjul + 1
+            
+            IF ( pjul > pjulend ) EXIT
+         
+         END DO
+
+      ELSE
+         
+         CALL ctl_stop('Unknown REYNOLDS sst input data file format')
+
+      ENDIF
+
+      CALL iom_close ( inumsst )      
+
+      inumobs = 0
+      DO jj = nldj, nlej
+         DO ji = nldi, nlei
+            IF ( tmask(ji,jj,1) == 1.0_wp ) inumobs = inumobs + 1
+         END DO
+      END DO
+      inumobs = inumobs * itotrec
+
+      ! Allocate obs_surf data structure for time sorted data
+         
+      CALL obs_surf_alloc( sstdata, inumobs, kvars, kextra, kstp )
+
+      pjul = pjulini + 1
+
+      inumobs = 0
+
+      DO
+
+         CALL jul2greg( isec, imin, ihour, iday, imon, iyear, &
+            &           pjul, 19500101 )
+
+         ifld = pjul - pjulini
+
+         DO jj = nldj, nlej
+            DO ji = nldi, nlei
+
+               IF ( tmask(ji,jj,1) == 1.0_wp ) THEN
+
+                  inumobs = inumobs + 1
+                  
+                  ! Integer values
+                  IF (ln_grid_global) THEN
+                     sstdata%mi(inumobs)     = MAX(mig(ji),2)
+                     sstdata%mj(inumobs)     = MAX(mjg(jj),2)
+                  ELSE
+                     sstdata%mi(inumobs)     = MAX(ji,2)
+                     sstdata%mj(inumobs)     = MAX(jj,2)
+                  ENDIF
+                  sstdata%nsidx(inumobs)  = 0
+                  sstdata%nsfil(inumobs)  = 0
+                  sstdata%nyea(inumobs)   = iyear
+                  sstdata%nmon(inumobs)   = imon
+                  sstdata%nday(inumobs)   = iday
+                  sstdata%nhou(inumobs)   = ihour
+                  sstdata%nmin(inumobs)   = imin
+                  sstdata%mstp(inumobs)   = 0
+                  sstdata%nqc(inumobs)    = 0
+                  sstdata%ntyp(inumobs)   = 0
+         
+                  ! Real values
+                  sstdata%rlam(inumobs)   = glamt(ji,jj)
+                  sstdata%rphi(inumobs)   = gphit(ji,jj)
+                  sstdata%robs(inumobs,1) = zsstin(ji,jj,ifld)
+                  sstdata%rmod(inumobs,1) = fbrmdi
+                  sstdata%rext(inumobs,:) = fbrmdi
+
+               ENDIF
+
+            END DO
+         END DO
+
+         pjul = pjul + 1
+
+         IF ( pjul > pjulend ) EXIT
+
+      END DO
+
+   END SUBROUTINE obs_rea_sst_rey
+
+END MODULE obs_read_sst
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90	(revision 3437)
@@ -0,0 +1,646 @@
+MODULE obs_read_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_read_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rea_vel_dri : Driver for reading profile obs
+   !!----------------------------------------------------------------------
+
+   !! * Modules used   
+   USE par_kind                 ! Precision variables
+   USE par_oce                  ! Ocean parameters
+   USE in_out_manager           ! I/O manager
+   USE dom_oce                  ! Ocean space and time domain variables
+   USE obs_mpp                  ! MPP support routines for observation diagnostics
+   USE julian                   ! Julian date routines
+   USE obs_utils                ! Observation operator utility functions
+   USE obs_prep                 ! Prepare observation arrays
+   USE obs_grid                 ! Grid search
+   USE obs_sort                 ! Sorting observation arrays
+   USE obs_profiles_def         ! Profile definitions
+   USE obs_conv                 ! Various conversion routines
+   USE obs_types                ! Observation type definitions
+   USE netcdf                   ! NetCDF library
+   USE obs_oper                 ! Observation operators
+   USE obs_vel_io               ! Velocity profile files I/O (non-FB files)
+   USE lib_mpp                  ! For ctl_warn/stop
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC obs_rea_vel_dri  ! Read the profile observations 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+ 
+   SUBROUTINE obs_rea_vel_dri( kformat, &
+      &                        profdata, knumfiles, cfilenames, &
+      &                        kvars, kextr, kstp, ddobsini, ddobsend, &
+      &                        ldignmis, ldavtimset, ldmod )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_pro_dri ***
+      !!
+      !! ** Purpose : Read from file the profile observations
+      !!
+      !! ** Method  : Depending on kformat either ENACT, CORIOLIS or
+      !!              feedback data files are read
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2009-01 (K. Mogensen) : New merged version of old routines
+      !!----------------------------------------------------------------------
+      !! * Modules used
+   
+      !! * Arguments
+      INTEGER :: kformat   ! Format of input data
+      !                    ! 1: ENACT
+      !                    ! 2: Coriolis
+      TYPE(obs_prof), INTENT(OUT) :: profdata    ! Profile data to be read
+      INTEGER, INTENT(IN) :: knumfiles           ! Number of files to read in
+      CHARACTER(LEN=128), INTENT(IN) ::  cfilenames(knumfiles) ! File names to read in
+      INTEGER, INTENT(IN) :: kvars       ! Number of variables in profdata
+      INTEGER, INTENT(IN) :: kextr       ! Number of extra fields for each var in profdata
+      INTEGER, INTENT(IN) :: kstp        !  Ocean time-step index
+      LOGICAL, INTENT(IN) :: ldignmis    ! Ignore missing files
+      LOGICAL, INTENT(IN) :: ldavtimset  ! Set time to be equal to the end of the day
+      LOGICAL, INTENT(IN) :: ldmod       ! Initialize model from input data
+      REAL(KIND=dp), INTENT(IN) :: ddobsini   ! Obs. ini time in YYYYMMDD.HHMMSS
+      REAL(KIND=dp), INTENT(IN) :: ddobsend   ! Obs. end time in YYYYMMDD.HHMMSS
+
+      !! * Local declarations
+      CHARACTER(LEN=15), PARAMETER :: cpname='obs_rea_vel_dri'
+      INTEGER :: jvar
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+      INTEGER :: ij
+      INTEGER :: iflag
+      INTEGER :: inobf
+      INTEGER :: i_file_id
+      INTEGER :: inowin
+      INTEGER :: iyea
+      INTEGER :: imon
+      INTEGER :: iday
+      INTEGER :: ihou
+      INTEGER :: imin
+      INTEGER :: isec
+      INTEGER, DIMENSION(knumfiles) :: &
+         & irefdate
+      INTEGER, DIMENSION(ntyp1770+1) :: &
+         & itypuv,    &
+         & itypuvmpp 
+      INTEGER :: iuv3dtmpp
+      INTEGER, DIMENSION(:), ALLOCATABLE :: &
+         & iobsiu,   &
+         & iobsju,   &
+         & iprocu,   &
+         & iobsiv,   &
+         & iobsjv,   &
+         & iprocv,   &
+         & iindx,    &
+         & ifileidx, &
+         & iprofidx
+      INTEGER :: itype
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zphi, &
+         & zlam
+      REAL(dp), DIMENSION(:), ALLOCATABLE :: &
+         & zdat
+      LOGICAL :: &
+         & llvalprof
+      TYPE(obfbdata), POINTER, DIMENSION(:) :: &
+         & inpfiles
+      REAL(dp), DIMENSION(knumfiles) :: &
+         & djulini, &
+         & djulend
+      INTEGER :: iprof
+      INTEGER :: iproftot
+      INTEGER :: iuv3dt
+      INTEGER, DIMENSION(kvars) :: iv3dt
+      CHARACTER(len=8) :: cl_refdate
+   
+      ! Local initialization
+      iprof = 0
+      iuv3dt = 0
+
+      !-----------------------------------------------------------------------
+      ! Check data the model part is just with feedback data files
+      !-----------------------------------------------------------------------
+      IF ( ldmod .AND. ( kformat /= 0 ) ) THEN
+         CALL ctl_stop( 'Model can only be read from feedback data' )
+         RETURN
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Count the number of files needed and allocate the obfbdata type
+      !-----------------------------------------------------------------------
+      
+      inobf = knumfiles
+
+      ALLOCATE( inpfiles(inobf) )
+
+      prof_files : DO jj = 1, inobf
+          
+         !---------------------------------------------------------------------
+         ! Prints
+         !---------------------------------------------------------------------
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' obs_rea_vel_dri : Reading from file = ', &
+               & TRIM( TRIM( cfilenames(jj) ) )
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         !---------------------------------------------------------------------
+         !  Initialization: Open file and get dimensions only
+         !---------------------------------------------------------------------
+         
+         iflag = nf90_open( TRIM( TRIM( cfilenames(jj) ) ), nf90_nowrite, &
+            &                      i_file_id )
+         
+         IF ( iflag /= nf90_noerr ) THEN
+
+            IF ( ldignmis ) THEN
+               inpfiles(jj)%nobs = 0
+               CALL ctl_warn( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ELSE 
+               CALL ctl_stop( 'File ' // TRIM( TRIM( cfilenames(jj) ) ) // &
+                  &           ' not found' )
+            ENDIF
+
+         ELSE 
+            
+            !------------------------------------------------------------------
+            !  Close the file since it is opened in read_proffile
+            !------------------------------------------------------------------
+            
+            iflag = nf90_close( i_file_id )
+
+            !------------------------------------------------------------------
+            !  Read the profile file into inpfiles
+            !------------------------------------------------------------------
+            IF ( kformat == 0 ) THEN
+               CALL init_obfbdata( inpfiles(jj) )
+               IF(lwp) THEN
+                  WRITE(numout,*)
+                  WRITE(numout,*)'Reading from feedback file :', &
+                     &           TRIM( cfilenames(jj) )
+               ENDIF
+               CALL read_obfbdata( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &                ldgrid = .TRUE. )
+               IF ( ldmod .AND. ( inpfiles(jj)%nadd == 0 ) ) THEN
+                  CALL ctl_stop( 'Model not in input data' )
+                  RETURN
+               ENDIF
+            ELSEIF ( kformat == 1 ) THEN
+               CALL read_taondbc( TRIM( cfilenames(jj) ), inpfiles(jj), &
+                  &               numout, lwp, .TRUE. )
+            ELSE
+               CALL ctl_stop( 'File format unknown' )
+            ENDIF
+            
+            !------------------------------------------------------------------
+            !  Change longitude (-180,180)
+            !------------------------------------------------------------------
+
+            DO ji = 1, inpfiles(jj)%nobs 
+
+               IF ( inpfiles(jj)%plam(ji) < -180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) + 360.
+
+               IF ( inpfiles(jj)%plam(ji) >  180. ) &
+                  &   inpfiles(jj)%plam(ji) = inpfiles(jj)%plam(ji) - 360.
+
+            END DO
+
+            !------------------------------------------------------------------
+            !  Calculate the date  (change eventually)
+            !------------------------------------------------------------------
+            cl_refdate=inpfiles(jj)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate(jj)
+            
+            CALL ddatetoymdhms( ddobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(jj), &
+               &           krefdate = irefdate(jj) )
+            CALL ddatetoymdhms( ddobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(jj), &
+               &           krefdate = irefdate(jj) )
+
+            IF ( ldavtimset ) THEN
+               DO ji = 1, inpfiles(jj)%nobs
+                  ! 
+                  !  for daily averaged data force the time
+                  !  to be the  end of the day
+                  !
+                  inpfiles(jj)%ptim(ji) = &
+                     & INT(inpfiles(jj)%ptim(ji)) + 1
+               END DO
+            ENDIF
+            
+            IF ( inpfiles(jj)%nobs > 0 ) THEN
+               inpfiles(jj)%iproc = -1
+               inpfiles(jj)%iobsi = -1
+               inpfiles(jj)%iobsj = -1
+            ENDIF
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+               ENDIF
+            END DO
+            ALLOCATE( zlam(inowin)  )
+            ALLOCATE( zphi(inowin)  )
+            ALLOCATE( iobsiu(inowin) )
+            ALLOCATE( iobsju(inowin) )
+            ALLOCATE( iprocu(inowin) )
+            ALLOCATE( iobsiv(inowin) )
+            ALLOCATE( iobsjv(inowin) )
+            ALLOCATE( iprocv(inowin) )
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  zlam(inowin) = inpfiles(jj)%plam(ji)
+                  zphi(inowin) = inpfiles(jj)%pphi(ji)
+               ENDIF
+            END DO
+
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiu, iobsju, iprocu, &
+               & 'U' )
+            CALL obs_grid_search( inowin, zlam, zphi, iobsiv, iobsjv, iprocv, &
+               & 'V' )
+
+            inowin = 0
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  inowin = inowin + 1
+                  inpfiles(jj)%iproc(ji,1) = iprocu(inowin)
+                  inpfiles(jj)%iobsi(ji,1) = iobsiu(inowin)
+                  inpfiles(jj)%iobsj(ji,1) = iobsju(inowin)
+                  inpfiles(jj)%iproc(ji,2) = iprocv(inowin)
+                  inpfiles(jj)%iobsi(ji,2) = iobsiv(inowin)
+                  inpfiles(jj)%iobsj(ji,2) = iobsjv(inowin)
+                  IF ( inpfiles(jj)%iproc(ji,1) /= &
+                     & inpfiles(jj)%iproc(ji,2) ) THEN
+                     CALL ctl_stop( 'Error in obs_read_vel:', &
+                        & 'U and V observation on different processors')
+                  ENDIF
+               ENDIF
+            END DO
+            DEALLOCATE( zlam, zphi, iobsiu, iobsju, iprocu,  &
+               & iobsiv, iobsjv, iprocv )
+
+            DO ji = 1, inpfiles(jj)%nobs
+               IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+                  & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+                  IF ( nproc == 0 ) THEN
+                     IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+                  ELSE
+                     IF ( inpfiles(jj)%iproc(ji,1) /=  nproc ) CYCLE
+                  ENDIF
+                  llvalprof = .FALSE.
+                  IF ( ( ( nproc == 0 ) .AND. &
+                     & ( inpfiles(jj)%iproc(ji,1) <=  nproc ) ) .OR. &
+                     & ( inpfiles(jj)%iproc(ji,1) ==  nproc ) ) THEN
+                     loop_uv_count : DO ij = 1,inpfiles(jj)%nlev
+                        IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                           & CYCLE
+                        IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                           & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                           iuv3dt = iuv3dt + 1
+                           llvalprof = .TRUE.
+                        ENDIF
+                     END DO loop_uv_count
+                  ENDIF
+                  IF ( llvalprof ) iprof = iprof + 1
+               ENDIF
+            END DO
+
+         ENDIF
+         
+      END DO prof_files
+
+      !-----------------------------------------------------------------------
+      ! Get the time ordered indices of the input data
+      !-----------------------------------------------------------------------
+
+      !---------------------------------------------------------------------
+      !  Loop over input data files to count total number of profiles
+      !---------------------------------------------------------------------
+      iproftot = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               iproftot = iproftot + 1
+            ENDIF
+         END DO
+      END DO
+
+      ALLOCATE( iindx(iproftot), ifileidx(iproftot), &
+         &      iprofidx(iproftot), zdat(iproftot) )
+      jk = 0
+      DO jj = 1, inobf
+         DO ji = 1, inpfiles(jj)%nobs
+            IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND. &
+               & ( inpfiles(jj)%ptim(ji) <= djulend(jj) )       ) THEN
+               jk = jk + 1
+               ifileidx(jk) = jj
+               iprofidx(jk) = ji
+               zdat(jk)     = inpfiles(jj)%ptim(ji)
+            ENDIF
+         END DO
+      END DO
+      CALL sort_dp_indx( iproftot, &
+         &               zdat,     &
+         &               iindx   )
+      
+      iv3dt(:) = -1
+      iv3dt(1:2) = iuv3dt
+      CALL obs_prof_alloc( profdata, kvars, kextr, iprof, iv3dt, &
+         &                 kstp, jpi, jpj, jpk )
+      
+      ! * Read obs/positions, QC, all variable and assign to profdata
+
+      profdata%nprof     = 0
+      profdata%nvprot(:) = 0
+
+      iprof = 0
+
+      iuv3dt = 0
+      itypuv   (:) = 0
+      itypuvmpp(:) = 0
+      
+      DO jk = 1, iproftot
+         
+         jj = ifileidx(iindx(jk))
+         ji = iprofidx(iindx(jk))
+         IF ( ( inpfiles(jj)%ptim(ji) >  djulini(jj) ) .AND.  &
+            & ( inpfiles(jj)%ptim(ji) <= djulend(jj) ) ) THEN
+            
+            IF ( nproc == 0 ) THEN
+               IF ( inpfiles(jj)%iproc(ji,1) >  nproc ) CYCLE
+            ELSE
+               IF ( inpfiles(jj)%iproc(ji,1) /= nproc ) CYCLE
+            ENDIF
+            
+            llvalprof = .FALSE.
+
+            loop_prof : DO ij = 1, inpfiles(jj)%nlev
+               
+               IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                  & CYCLE
+               
+               IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                  & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+
+                  llvalprof = .TRUE.
+                  EXIT loop_prof
+
+               ENDIF
+
+            END DO loop_prof
+            
+            ! Set profile information
+            
+            IF ( llvalprof ) THEN
+               
+               iprof = iprof + 1
+
+               CALL jul2greg( isec,                   &
+                  &           imin,                   &
+                  &           ihou,                   &
+                  &           iday,                   &
+                  &           imon,                   &
+                  &           iyea,                   &
+                  &           inpfiles(jj)%ptim(ji), &
+                  &           irefdate(jj) )
+
+
+               ! Profile time coordinates
+               profdata%nyea(iprof) = iyea
+               profdata%nmon(iprof) = imon
+               profdata%nday(iprof) = iday
+               profdata%nhou(iprof) = ihou
+               profdata%nmin(iprof) = imin
+               
+               ! Profile space coordinates
+               profdata%rlam(iprof) = inpfiles(jj)%plam(ji)
+               profdata%rphi(iprof) = inpfiles(jj)%pphi(ji)
+
+               ! Coordinate search parameters
+               profdata%mi  (iprof,1) = inpfiles(jj)%iobsi(ji,1)
+               profdata%mj  (iprof,1) = inpfiles(jj)%iobsj(ji,1)
+               profdata%mi  (iprof,2) = inpfiles(jj)%iobsi(ji,2)
+               profdata%mj  (iprof,2) = inpfiles(jj)%iobsj(ji,2)
+               
+               ! Profile WMO number
+               profdata%cwmo(iprof) = inpfiles(jj)%cdwmo(ji)
+               
+               ! Instrument type
+               READ( inpfiles(jj)%cdtyp(ji), '(I4)' ) itype
+               profdata%ntyp(iprof) = itype
+               
+               ! QC stuff
+
+               profdata%nqc(iprof)     = inpfiles(jj)%ioqc(ji)
+               profdata%nqcf(:,iprof)  = inpfiles(jj)%ioqcf(:,ji)
+               profdata%ipqc(iprof)    = inpfiles(jj)%ipqc(ji)
+               profdata%ipqcf(:,iprof) = inpfiles(jj)%ipqcf(:,ji)
+               profdata%itqc(iprof)    = inpfiles(jj)%itqc(ji)
+               profdata%itqcf(:,iprof) = inpfiles(jj)%itqcf(:,ji)
+               profdata%ivqc(iprof,:)  = inpfiles(jj)%ivqc(ji,:)
+               profdata%ivqcf(:,iprof,:) = inpfiles(jj)%ivqcf(:,ji,:)
+
+               ! Bookkeeping data to match profiles
+               profdata%npidx(iprof) = iprof
+               profdata%npfil(iprof) = iindx(jk)
+
+               ! Observation QC flag (whole profile)
+               profdata%nqc(iprof)  = 0 !TODO
+
+               loop_uv : DO ij = 1, inpfiles(jj)%nlev            
+                   
+                  IF ( inpfiles(jj)%pdep(ij,ji) >= 6000. ) &
+                     & CYCLE
+
+                  IF ( ( inpfiles(jj)%ivlqc(ij,ji,1) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%ivlqc(ij,ji,2) <= 2 ) .AND. &
+                     & ( inpfiles(jj)%idqc(ij,ji) <= 2 ) ) THEN
+                     iuv3dt = iuv3dt + 1
+                  ELSE
+                     CYCLE
+                  ENDIF
+
+                  ! Depth of U observation
+                  profdata%var(1)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of U observation QC
+                  profdata%var(1)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of U observation QC flags
+                  profdata%var(1)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(1)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(1)%nvlidx(iuv3dt) = ij
+
+                  ! Profile U value
+
+                  profdata%var(1)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,1)
+                  IF ( ldmod ) THEN
+                     profdata%var(1)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,1)
+                  ENDIF
+                  
+                  ! Profile U qc
+                  profdata%var(1)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,1)
+                  
+                  ! Profile U qc flags
+                  profdata%var(1)%nvqcf(:,iuv3dt) = &
+                     & inpfiles(jj)%ivlqcf(:,ij,ji,1)
+                  
+                  
+                  ! Depth of V observation
+                  profdata%var(2)%vdep(iuv3dt) = &
+                     &                inpfiles(jj)%pdep(ij,ji)
+                  
+                  ! Depth of V observation QC
+                  profdata%var(2)%idqc(iuv3dt) = &
+                     &                inpfiles(jj)%idqc(ij,ji)
+                  
+                  ! Depth of V observation QC flags
+                  profdata%var(2)%idqcf(:,iuv3dt) = &
+                     &                inpfiles(jj)%idqcf(:,ij,ji)
+                  
+                  ! Profile index
+                  profdata%var(2)%nvpidx(iuv3dt) = iprof
+                  
+                  ! Vertical index in original profile
+                  profdata%var(2)%nvlidx(iuv3dt) = ij
+                  
+                  ! Profile V value
+                  profdata%var(2)%vobs(iuv3dt) = &
+                     &                inpfiles(jj)%pob(ij,ji,2)
+                  IF ( ldmod ) THEN
+                     profdata%var(2)%vmod(iuv3dt) = &
+                        &                inpfiles(jj)%padd(ij,ji,1,2)
+                  ENDIF
+                     
+                  ! Profile V qc
+                  profdata%var(2)%nvqc(iuv3dt) = &
+                     & inpfiles(jj)%ivlqc(ij,ji,2)
+                  
+                  ! Profile V qc flags
+                  profdata%var(2)%nvqcf(:,iuv3dt) = &
+                        & inpfiles(jj)%ivlqcf(:,ij,ji,2)
+                  
+                  ! Observation type
+                  itypuv( profdata%ntyp(iprof) + 1 ) = &
+                     & itypuv( profdata%ntyp(iprof) + 1 ) + 1
+
+
+               END DO loop_uv
+
+            ENDIF
+
+         ENDIF
+
+      END DO
+
+      !-----------------------------------------------------------------------
+      ! Sum up over processors
+      !-----------------------------------------------------------------------
+      
+      CALL obs_mpp_sum_integer ( iuv3dt, iuv3dtmpp )
+      
+      CALL obs_mpp_sum_integers( itypuv, itypuvmpp, ntyp1770 + 1 )
+      
+      !-----------------------------------------------------------------------
+      ! Output number of observations.
+      !-----------------------------------------------------------------------
+      IF(lwp) THEN
+         WRITE(numout,*) 
+         WRITE(numout,'(1X,A)') 'Profile U,V velocity data'
+         WRITE(numout,'(1X,A)') '-------------------------'
+         WRITE(numout,*) 
+         DO ji = 0, ntyp1770
+            IF ( itypuvmpp(ji+1) > 0 ) THEN
+               WRITE(numout,'(1X,A3,A3,I8)') ctypshort(ji), ' = ', &
+                  & itypuvmpp(ji+1)
+            ENDIF
+         END DO
+         WRITE(numout,'(1X,A)') '--------------'
+         WRITE(numout,'(1X,A6,I8)') &
+            & 'Total profile UV data                                 = ',&
+            & iuv3dtmpp
+         WRITE(numout,'(1X,A)') '--------------'
+      ENDIF
+      
+      profdata%nvprot(1)    = iuv3dt
+      profdata%nvprot(2)    = iuv3dt
+      profdata%nvprotmpp(1) = iuv3dtmpp
+      profdata%nvprotmpp(2) = iuv3dtmpp
+      profdata%nprof        = iprof
+
+      !-----------------------------------------------------------------------
+      ! Model level search
+      !-----------------------------------------------------------------------
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(1), profdata%var(1)%vdep, &
+         & profdata%var(1)%mvk )
+      CALL obs_level_search( jpk, gdept_0, &
+         & profdata%nvprot(2), profdata%var(2)%vdep, &
+         & profdata%var(2)%mvk )
+      
+      !-----------------------------------------------------------------------
+      ! Set model equivalent to 99999
+      !-----------------------------------------------------------------------
+      IF ( .NOT. ldmod ) THEN
+         DO jvar = 1, kvars
+            profdata%var(jvar)%vmod(:) = fbrmdi
+         END DO
+      ENDIF
+      !-----------------------------------------------------------------------
+      ! Deallocate temporary data
+      !-----------------------------------------------------------------------
+      DEALLOCATE( ifileidx, iprofidx, zdat )
+
+      !-----------------------------------------------------------------------
+      ! Deallocate input data
+      !-----------------------------------------------------------------------
+      DO jj = 1, inobf
+         CALL dealloc_obfbdata( inpfiles(jj) )
+      END DO
+      DEALLOCATE( inpfiles )
+
+   END SUBROUTINE obs_rea_vel_dri
+   
+END MODULE obs_read_vel
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90	(revision 3437)
@@ -0,0 +1,266 @@
+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, e1t, e2t, gphit, glamt
+   USE obs_const, ONLY :   obfillflt      ! Fillvalue
+   USE oce      , ONLY :   sshn           ! Model variables
+
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   obs_rea_mdt     ! called by ?
+   PUBLIC   obs_offset_mdt  ! called by ?
+
+   INTEGER , PUBLIC ::   nmsshc    = 1         ! MDT correction scheme
+   REAL(wp), PUBLIC ::   mdtcorr   = 1.61_wp   ! User specified MDT correction
+   REAL(wp), PUBLIC ::   mdtcutoff = 65.0_wp   ! MDT cutoff for computed correction
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE obs_rea_mdt( kslano, sladata, k2dint )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_rea_mdt ***
+      !!
+      !! ** Purpose : Read from file the MDT data (skeleton)
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      USE iom
+      !
+      INTEGER                          , INTENT(IN)    ::   kslano    ! Number of SLA Products
+      TYPE(obs_surf), DIMENSION(kslano), INTENT(inout) ::   sladata   ! SLA data
+      INTEGER                          , INTENT(in)    ::   k2dint    ! ?
+      !
+      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt'
+      CHARACTER(LEN=20), PARAMETER ::   mdtname = 'slaReferenceLevel.nc'
+
+      INTEGER ::   jslano              ! Data set loop variable
+      INTEGER ::   jobs                ! Obs loop variable
+      INTEGER ::   jpimdt, jpjmdt      ! Number of grid point in lat/lon for the MDT
+      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 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( nmsshc == 1 .OR. nmsshc == 2 )   CALL obs_offset_mdt( z_mdt, zfill )
+
+      ! Intepolate the MDT already on the model grid at the observation point
+  
+      DO jslano = 1, kslano
+         ALLOCATE( &
+            & igrdi(2,2,sladata(jslano)%nsurf), &
+            & igrdj(2,2,sladata(jslano)%nsurf), &
+            & zglam(2,2,sladata(jslano)%nsurf), &
+            & zgphi(2,2,sladata(jslano)%nsurf), &
+            & zmask(2,2,sladata(jslano)%nsurf), &
+            & zmdtl(2,2,sladata(jslano)%nsurf)  &
+            & )
+         
+         DO jobs = 1, sladata(jslano)%nsurf
+
+            igrdi(1,1,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(1,2,jobs) = sladata(jslano)%mi(jobs)-1
+            igrdj(1,2,jobs) = sladata(jslano)%mj(jobs)
+            igrdi(2,1,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,1,jobs) = sladata(jslano)%mj(jobs)-1
+            igrdi(2,2,jobs) = sladata(jslano)%mi(jobs)
+            igrdj(2,2,jobs) = sladata(jslano)%mj(jobs)
+
+         END DO
+
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, glamt  , zglam )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, gphit  , zgphi )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, mdtmask, zmask )
+         CALL obs_int_comm_2d( 2, 2, sladata(jslano)%nsurf, igrdi, igrdj, z_mdt  , zmdtl )
+
+         DO jobs = 1, sladata(jslano)%nsurf
+            
+            zlam = sladata(jslano)%rlam(jobs)
+            zphi = sladata(jslano)%rphi(jobs)
+
+            CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
+               &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
+               &                   zmask(:,:,jobs), zweig, zobsmask )
+            
+            CALL obs_int_h2d( 1, 1, zweig, zmdtl(:,:,jobs),  zext )
+ 
+            sladata(jslano)%rext(jobs,2) = zext(1)
+
+! mark any masked data with a QC flag
+            IF( zobsmask(1) == 0 )   sladata(jslano)%nqc(jobs) = 11
+
+         END DO
+         
+         DEALLOCATE( &
+            & igrdi, &
+            & igrdj, &
+            & zglam, &
+            & zgphi, &
+            & zmask, &
+            & zmdtl  &
+            & )
+
+      END DO
+
+      CALL wrk_dealloc(jpi,jpj,z_mdt,mdtmask) 
+      !
+   END SUBROUTINE obs_rea_mdt
+
+
+   SUBROUTINE obs_offset_mdt( mdt, zfill )
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_offset_mdt ***
+      !!
+      !! ** Purpose : Compute a correction term for the MDT on the model grid
+      !!             !!!!! IF it is on the model grid
+      !!
+      !! ** Method  : Compute the mean difference between the model and the 
+      !!              used MDT and remove the offset. 
+      !!
+      !! ** Action  : 
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), 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.  mdtcutoff ) &
+              &.OR.( gphit(ji,jj) .LT. -mdtcutoff ) &
+              &.OR.( mdt(ji,jj) .EQ. zfill ) ) &
+              &        zpromsk(ji,jj) = 0.0
+        END DO
+      END DO 
+
+      ! Compute MSSH mean over [0,360] x [-mdtcutoff,mdtcutoff]
+
+      zarea = 0.0
+      zeta1 = 0.0
+      zeta2 = 0.0
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+          zdxdy = e1t(ji,jj) * e2t(ji,jj) * zpromsk(ji,jj)
+          zarea = zarea + zdxdy
+          zeta1 = zeta1 + mdt(ji,jj) * zdxdy
+          zeta2 = zeta2 + sshn (ji,jj) * zdxdy
+        END DO      
+      END DO
+
+      IF( lk_mpp)   CALL mpp_sum( zeta1 )
+      IF( lk_mpp)   CALL mpp_sum( zeta2 )
+      IF( lk_mpp)   CALL mpp_sum( zarea )
+      
+      zcorr_mdt    = zeta1 / zarea
+      zcorr_bcketa = zeta2 / zarea
+
+      !  Define correction term
+
+      zcorr = zcorr_mdt - zcorr_bcketa
+
+      !  Correct spatial mean of the MSSH
+
+      IF( nmsshc == 1 )   mdt(:,:) = mdt(:,:) - zcorr  
+
+      ! User defined value : 1.6 m for the Rio MDT compared to ORCA2 MDT
+
+      IF( nmsshc == 2 )   mdt(:,:) = mdt(:,:) - mdtcorr
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' obs_readmdt : mdtcutoff     = ', mdtcutoff
+         WRITE(numout,*) ' -----------   zcorr_mdt     = ', zcorr_mdt
+         WRITE(numout,*) '               zcorr_bcketa  = ', zcorr_bcketa
+         WRITE(numout,*) '               zcorr         = ', zcorr
+         WRITE(numout,*) '               nmsshc        = ', nmsshc
+      ENDIF
+
+      IF ( nmsshc == 0 ) WRITE(numout,*) '           MSSH correction is not applied'
+      IF ( nmsshc == 1 ) WRITE(numout,*) '           MSSH correction is applied'
+      IF ( nmsshc == 2 ) WRITE(numout,*) '           User defined MSSH correction' 
+
+      CALL wrk_dealloc( jpi,jpj, zpromsk )
+      !
+   END SUBROUTINE obs_offset_mdt
+ 
+   !!======================================================================
+END MODULE obs_readmdt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_rot_vel.F90	(revision 3437)
@@ -0,0 +1,231 @@
+MODULE obs_rot_vel
+   !!======================================================================
+   !!                       ***  MODULE obs_rot_vel  ***
+   !! Observation diagnostics: Read the velocity profile observations
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   obs_rotvel : Rotate velocity data into N-S,E-W directorions
+   !!----------------------------------------------------------------------
+   !! * Modules used   
+   USE 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, igrdiu, igrdju, &
+         &                  glamu, zglamu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  gphiu, zgphiu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  umask(:,:,1), zmasku )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zsingu, zsinlu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiu, igrdju, &
+         &                  zcosgu, zcoslu )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  glamv, zglamv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  gphiv, zgphiv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  vmask(:,:,1), zmaskv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zsingv, zsinlv )
+      CALL obs_int_comm_2d( 2, 2, profdata%nprof, igrdiv, igrdjv, &
+         &                  zcosgv, zcoslv )
+
+      DO ji = 1, profdata%nprof
+            
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamu(:,:,ji), zgphiu(:,:,ji), &
+            &                   zmasku(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlu(:,:,ji),  zsinu )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslu(:,:,ji),  zcosu )
+
+         CALL obs_int_h2d_init( 1, 1, k2dint, &
+            &                   profdata%rlam(ji), profdata%rphi(ji), &
+            &                   zglamv(:,:,ji), zgphiv(:,:,ji), &
+            &                   zmaskv(:,:,ji), zweig, zobsmask )
+         
+         CALL obs_int_h2d( 1, 1, zweig, zsinlv(:,:,ji),  zsinv )
+
+         CALL obs_int_h2d( 1, 1, zweig, zcoslv(:,:,ji),  zcosv )
+
+         ! Assume that the angle at observation point is the 
+         ! mean of u and v cosines/sines
+
+         zcos = 0.5_wp * ( zcosu(1) + zcosv(1) )
+         zsin = 0.5_wp * ( zsinu(1) + zsinv(1) )
+         
+         IF ( ( profdata%npvsta(ji,1) /= profdata%npvsta(ji,2) ) .OR. &
+            & ( profdata%npvend(ji,1) /= profdata%npvend(ji,2) ) ) THEN
+            CALL fatal_error( 'Different number of U and V observations '// &
+               'in a profile in obs_rotvel', __LINE__ )
+         ENDIF
+
+         DO jk = profdata%npvsta(ji,1), profdata%npvend(ji,1)
+            IF ( ( profdata%var(1)%vmod(jk) /= fbrmdi ) .AND. &
+               & ( profdata%var(1)%vmod(jk) /= fbrmdi ) ) THEN
+               pu(jk) = profdata%var(1)%vmod(jk) * zcos - &
+                  &     profdata%var(2)%vmod(jk) * zsin 
+               pv(jk) = profdata%var(2)%vmod(jk) * zcos + &
+                  &     profdata%var(1)%vmod(jk) * zsin
+            ELSE
+               pu(jk) = fbrmdi
+               pv(jk) = fbrmdi
+            ENDIF
+         END DO
+
+      END DO
+      
+      DEALLOCATE( &
+         & igrdiu, &
+         & igrdju, &
+         & zglamu, &
+         & zgphiu, &
+         & zmasku, &
+         & zcoslu, &
+         & zsinlu, &
+         & igrdiv, &
+         & igrdjv, &
+         & zglamv, &
+         & zgphiv, &
+         & zmaskv, &
+         & zcoslv, &
+         & zsinlv  &
+         & )
+
+      CALL wrk_dealloc(jpi,jpj,zsingu,zcosgu,zsingv,zcosgv) 
+
+   END SUBROUTINE obs_rotvel
+
+END MODULE obs_rot_vel
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice.F90	(revision 3437)
@@ -0,0 +1,35 @@
+MODULE obs_seaice
+   !!=====================================================================
+   !!                       ***  MODULE  obs_seaice  ***
+   !! Observation diagnostics: Storage space for sea ice observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of sea ice data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nseaicevars, nseaiceextr, nseaicesets, seaicedata, seaicedatqc
+
+   !! * Shared Module variables
+   INTEGER :: nseaicevars                               ! Number of seaicedata variables
+   INTEGER :: nseaiceextr                               ! Number of seaicedata extra 
+                                                     ! variables
+   INTEGER :: nseaicesets                               ! Number of seaicedata sets
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedata  ! Initial sea ice data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: seaicedatqc ! Sea ice data after quality control
+
+END MODULE obs_seaice
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_seaice_io.F90	(revision 3437)
@@ -0,0 +1,30 @@
+MODULE obs_seaice_io
+   !!======================================================================
+   !!                       ***  MODULE obs_seaice_io  ***
+   !! Observation operators : I/O for GHRSEAICE files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_seaicefile    :  Read a obfbdata structure from an GHRSEAICE file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsseaice_io.h90"
+
+END MODULE obs_seaice_io
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla.F90	(revision 3437)
@@ -0,0 +1,33 @@
+MODULE obs_sla
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sla  ***
+   !! Observation diagnostics: Storage space for SLA observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SLA data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nslavars, nslaextr, nslasets, sladata, sladatqc
+
+   !! * Shared Module variables
+   INTEGER :: nslavars                               ! Number of sladata variables
+   INTEGER :: nslaextr                               ! Number of sladata extra 
+                                                     ! variables
+   INTEGER :: nslasets                               ! Number of sladata sets                                               
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladata  ! Initial SLA data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sladatqc ! SLA data after quality control
+
+END MODULE obs_sla
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_io.F90	(revision 3437)
@@ -0,0 +1,30 @@
+MODULE obs_sla_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_io  ***
+   !! Observation operators : I/O for AVISO SLA files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_enactfile    :  Read a obfbdata structure from an AVISO SLA file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   use obs_sla_types
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssla_io.h90"
+
+END MODULE obs_sla_io
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sla_types.F90	(revision 3437)
@@ -0,0 +1,19 @@
+MODULE obs_sla_types
+   !!======================================================================
+   !!                       ***  MODULE obs_sla_type  ***
+   !! Observation operators : Satellite identifiers for SLA data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+#include "obssla_types.h90"
+
+END MODULE obs_sla_types
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sort.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst.F90	(revision 3437)
@@ -0,0 +1,35 @@
+MODULE obs_sst
+   !!=====================================================================
+   !!                       ***  MODULE  obs_sst  ***
+   !! Observation diagnostics: Storage space for SST observations
+   !!                          arrays and additional flags etc.
+   !!=====================================================================
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   
+   !! * Modules used 
+   USE obs_surf_def ! Definition of SST data types and tools
+
+   IMPLICIT NONE
+   
+   SAVE
+
+   !! * Routine accessibility
+   PRIVATE
+
+   PUBLIC nsstvars, nsstextr, nsstsets, sstdata, sstdatqc
+
+   !! * Shared Module variables
+   INTEGER :: nsstvars                               ! Number of sstdata variables
+   INTEGER :: nsstextr                               ! Number of sstdata extra 
+                                                     ! variables
+   INTEGER :: nsstsets                               ! Number of sstdata sets
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdata  ! Initial SST data
+   TYPE(obs_surf), POINTER, DIMENSION(:) :: sstdatqc ! SST data after quality control
+
+END MODULE obs_sst
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_sst_io.F90	(revision 3437)
@@ -0,0 +1,30 @@
+MODULE obs_sst_io
+   !!======================================================================
+   !!                       ***  MODULE obs_sst_io  ***
+   !! Observation operators : I/O for GHRSST files
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_sstfile    :  Read a obfbdata structure from an GHRSST file
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE julian
+   USE netcdf
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obssst_io.h90"
+
+END MODULE obs_sst_io
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_surf_def.F90	(revision 3437)
@@ -0,0 +1,461 @@
+MODULE obs_surf_def
+   !!=====================================================================
+   !!                       ***  MODULE  obs_surf_def  ***
+   !! Observation diagnostics: Storage handling for surface observation
+   !!                          arrays and additional flags etc.
+   !!                          This module only defines the data type and
+   !!                          operations on the data type. There is no
+   !!                          actual data in the module.
+   !!===================================================================== 
+
+   !!----------------------------------------------------------------------
+   !!   obs_surf            : F90 type containing the surface information
+   !!   obs_surf_alloc      : Allocates surface data arrays
+   !!   obs_surf_dealloc    : Deallocates surface data arrays
+   !!   obs_surf_compress   : Extract sub-information from a obs_surf type
+   !!                         to a new obs_surf type
+   !!   obs_surf_decompress : Reinsert sub-information from a obs_surf type
+   !!                         into the original obs_surf type
+   !!----------------------------------------------------------------------
+   !! * Modules used
+   USE par_kind, ONLY : & ! Precision variables
+      & wp         
+   USE obs_mpp, ONLY : &  ! MPP tools 
+      obs_mpp_sum_integer
+
+   IMPLICIT NONE
+
+   !! * Routine/type accessibility
+   PRIVATE
+
+   PUBLIC &
+      & obs_surf,           &
+      & obs_surf_alloc,     &
+      & obs_surf_dealloc,   &
+      & obs_surf_compress,  &
+      & obs_surf_decompress
+
+   !! * Type definition for surface observation type
+
+   TYPE obs_surf
+
+      ! Bookkeeping
+
+      INTEGER :: nsurf      !: Local number of surface data within window
+      INTEGER :: nsurfmpp   !: Global number of surface data within window
+      INTEGER :: nvar       !: Number of variables at observation points
+      INTEGER :: nextra     !: Number of extra fields at observation points
+      INTEGER :: nstp       !: Number of time steps
+      INTEGER :: nsurfup    !: Observation counter used in obs_oper
+
+      ! Arrays with size equal to the number of surface observations
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & mi,   &        !: i-th grid coord. for interpolating to surface observation
+         & mj,   &        !: j-th grid coord. for interpolating to surface observation
+         & nsidx,&        !: Surface observation number
+         & nsfil,&        !: Surface observation number in file
+         & nyea, &        !: Year of surface observation
+         & nmon, &        !: Month of surface observation 
+         & nday, &        !: Day of surface observation
+         & nhou, &        !: Hour of surface observation
+         & nmin, &        !: Minute of surface observation
+         & mstp, &        !: Time step nearest to surface observation
+         & nqc,  &        !: Surface observation qc flag
+         & ntyp           !: Type of surface observation product
+
+      CHARACTER(LEN=8), POINTER, DIMENSION(:) :: &
+         & cwmo           !: WMO indentifier
+         
+      REAL(KIND=wp), POINTER, DIMENSION(:) :: &
+         & rlam, &        !: Longitude coordinate of surface observation
+         & rphi           !: Latitude coordinate of surface observation
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & robs, &        !: Surface observation 
+         & rmod           !: Model counterpart of the surface observation vector
+
+      REAL(KIND=wp), POINTER, DIMENSION(:,:) :: &
+         & rext           !: Extra fields interpolated to observation points
+
+      ! Arrays with size equal to the number of time steps in the window
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsstp,     &   !: Local number of surface observations per time step
+         & nsstpmpp       !: Global number of surface observations per time step
+
+      ! Arrays used to store source indices when 
+      ! compressing obs_surf derived types
+      
+      ! Array with size nsurf
+
+      INTEGER, POINTER, DIMENSION(:) :: &
+         & nsind          !: Source indices of surface data in compressed data
+
+   END TYPE obs_surf
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+   
+   SUBROUTINE obs_surf_alloc( surf, ksurf, kvar, kextra, kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_alloc  ***
+      !!                      
+      !! ** Purpose : - Allocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) ::  surf      ! Surface data to be allocated
+      INTEGER, INTENT(IN) :: ksurf   ! Number of surface observations
+      INTEGER, INTENT(IN) :: kvar    ! Number of surface variables
+      INTEGER, INTENT(IN) :: kextra  ! Number of extra fields at observation points
+      INTEGER, INTENT(IN) :: kstp    ! Number of time steps
+
+      !!* Local variables
+      INTEGER :: ji
+
+      ! Set bookkeeping variables
+
+      surf%nsurf    = ksurf
+      surf%nsurfmpp = 0
+      surf%nextra   = kextra
+      surf%nvar     = kvar
+      surf%nstp     = kstp
+      
+      ! Allocate arrays of number of surface data size
+
+      ALLOCATE( &
+         & surf%mi(ksurf),      &
+         & surf%mj(ksurf),      &
+         & surf%nsidx(ksurf),   &
+         & surf%nsfil(ksurf),   &
+         & surf%nyea(ksurf),    &
+         & surf%nmon(ksurf),    &
+         & surf%nday(ksurf),    &
+         & surf%nhou(ksurf),    &
+         & surf%nmin(ksurf),    &
+         & surf%mstp(ksurf),    &
+         & surf%nqc(ksurf),     &
+         & surf%ntyp(ksurf),    &
+         & surf%cwmo(ksurf),    &
+         & surf%rlam(ksurf),    &
+         & surf%rphi(ksurf),    &
+         & surf%nsind(ksurf)    &
+         & )
+
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      ALLOCATE( & 
+         & surf%robs(ksurf,kvar), &
+         & surf%rmod(ksurf,kvar)  &
+         & )   
+
+      ! Allocate arrays of number of extra fields at observation points
+
+      ALLOCATE( & 
+         & surf%rext(ksurf,kextra) &
+         & )
+
+      ! Allocate arrays of number of time step size
+
+      ALLOCATE( &
+         & surf%nsstp(kstp),     &
+         & surf%nsstpmpp(kstp)   &
+         & )
+
+      ! Set defaults for compression indices
+      
+      DO ji = 1, ksurf
+         surf%nsind(ji) = ji
+      END DO
+      
+      ! Set defaults for number of observations per time step
+
+      surf%nsstp(:)     = 0
+      surf%nsstpmpp(:)  = 0
+
+      ! Set the observation counter used in obs_oper
+
+      surf%nsurfup     = 0
+              
+   END SUBROUTINE obs_surf_alloc
+
+   SUBROUTINE obs_surf_dealloc( surf )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_dealloc  ***
+      !!                      
+      !! ** Purpose : - Deallocate data for surface data arrays
+      !! 
+      !! ** Method  : - Fortran-90 dynamic arrays
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(INOUT) :: &
+         & surf      ! Surface data to be allocated
+
+      !!* Local variables
+
+      ! Deallocate arrays of number of surface data size
+
+      DEALLOCATE( &
+         & surf%mi,      &
+         & surf%mj,      &
+         & surf%nsidx,   &
+         & surf%nsfil,   &
+         & surf%nyea,    &
+         & surf%nmon,    &
+         & surf%nday,    &
+         & surf%nhou,    &
+         & surf%nmin,    &
+         & surf%mstp,    &
+         & surf%nqc,     &
+         & surf%ntyp,    &
+         & surf%cwmo,    &
+         & surf%rlam,    &
+         & surf%rphi,    &
+         & surf%nsind    &
+         & )
+
+      ! Allocate arrays of number of surface data size * number of variables
+
+      DEALLOCATE( & 
+         & surf%robs,    &
+         & surf%rmod     &
+         & )
+
+      ! Deallocate arrays of number of extra fields at observation points
+
+      DEALLOCATE( & 
+         & surf%rext &
+         & )
+
+      ! Deallocate arrays of number of time step size
+
+      DEALLOCATE( &
+         & surf%nsstp,     &
+         & surf%nsstpmpp   &
+         & )
+
+   END SUBROUTINE obs_surf_dealloc
+
+   SUBROUTINE obs_surf_compress( surf, newsurf, lallocate, kumout, lvalid )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_compress  ***
+      !!                      
+      !! ** Purpose : - Extract sub-information from a obs_surf type
+      !!                into a new obs_surf type
+      !! 
+      !! ** Method  : - The data is copied from surf to new surf.
+      !!                In the case of lvalid being present only the 
+      !!                selected data will be copied.
+      !!                If lallocate is true the data in the newsurf is 
+      !!                allocated either with the same number of elements
+      !!                as surf or with only the subset of elements defined
+      !!                by the optional selection.
+      !!
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf), INTENT(IN)    :: surf      ! Original surface data
+      TYPE(obs_surf), INTENT(INOUT) :: newsurf   ! New surface data with a subset of the original data
+      LOGICAL :: lallocate     ! Allocate newsurf data
+      INTEGER,INTENT(IN) :: kumout        ! Fortran unit for messages
+      LOGICAL, OPTIONAL, INTENT(in), DIMENSION(:) :: &
+         & lvalid         ! Valid of surface observations
+      
+      !!* Local variables
+      INTEGER :: insurf
+      INTEGER :: ji
+      INTEGER :: jk
+      LOGICAL, DIMENSION(:), ALLOCATABLE :: llvalid
+
+      ! Count how many elements there should be in the new data structure
+
+      IF ( PRESENT(lvalid) ) THEN
+         insurf = 0
+         DO ji = 1, surf%nsurf
+            IF ( lvalid(ji) ) THEN
+               insurf = insurf + 1
+            ENDIF
+         END DO
+      ELSE
+         insurf = surf%nsurf
+      ENDIF
+
+      ! Optionally allocate data in the new data structure
+
+      IF ( lallocate ) THEN
+         CALL obs_surf_alloc( newsurf,  insurf, surf%nvar, &
+            & surf%nextra, surf%nstp )
+      ENDIF
+
+      ! Allocate temporary valid array to unify the code for both cases
+
+      ALLOCATE( llvalid(surf%nsurf) )
+      IF ( PRESENT(lvalid) ) THEN
+         llvalid(:)  = lvalid(:)
+      ELSE
+         llvalid(:)  = .TRUE.
+      ENDIF
+
+      ! Setup bookkeeping variables
+
+      insurf = 0
+
+      ! Loop over source surface data
+
+      DO ji = 1, surf%nsurf
+
+         IF ( llvalid(ji) ) THEN
+
+            ! Copy the header information
+
+            insurf = insurf + 1
+
+            newsurf%mi(insurf)    = surf%mi(ji)
+            newsurf%mj(insurf)    = surf%mj(ji)
+            newsurf%nsidx(insurf) = surf%nsidx(ji)
+            newsurf%nsfil(insurf) = surf%nsfil(ji)
+            newsurf%nyea(insurf)  = surf%nyea(ji)
+            newsurf%nmon(insurf)  = surf%nmon(ji)
+            newsurf%nday(insurf)  = surf%nday(ji)
+            newsurf%nhou(insurf)  = surf%nhou(ji)
+            newsurf%nmin(insurf)  = surf%nmin(ji)
+            newsurf%mstp(insurf)  = surf%mstp(ji)
+            newsurf%nqc(insurf)   = surf%nqc(ji)
+            newsurf%ntyp(insurf)  = surf%ntyp(ji)
+            newsurf%cwmo(insurf)  = surf%cwmo(ji)
+            newsurf%rlam(insurf)  = surf%rlam(ji)
+            newsurf%rphi(insurf)  = surf%rphi(ji)
+
+            DO jk = 1, surf%nvar
+
+               newsurf%robs(insurf,jk)  = surf%robs(ji,jk)
+               newsurf%rmod(insurf,jk)  = surf%rmod(ji,jk)
+               
+            END DO
+
+            DO jk = 1, surf%nextra
+
+               newsurf%rext(insurf,jk) = surf%rext(ji,jk)
+
+            END DO
+            
+            ! nsind is the index of the original surface data
+            
+            newsurf%nsind(insurf) = ji
+
+         ENDIF
+
+      END DO
+
+      ! Update MPP counters
+
+      newsurf%nsurf = insurf
+      CALL obs_mpp_sum_integer ( newsurf%nsurf, newsurf%nsurfmpp )
+
+      ! Set book keeping variables which do not depend on number of obs.
+
+      newsurf%nstp  = surf%nstp
+ 
+      ! Deallocate temporary data
+
+      DEALLOCATE( llvalid )
+     
+   END SUBROUTINE obs_surf_compress
+
+   SUBROUTINE obs_surf_decompress( surf, oldsurf, ldeallocate, kumout )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE obs_surf_decompress  ***
+      !!                      
+      !! ** Purpose : - Copy back information to original surface data type
+      !!
+      !! ** Method  : - Reinsert updated information from a previous
+      !!                copied/compressed surface data type into the original
+      !!                surface data and optionally deallocate the surface
+      !!                data input
+      !! 
+      !! History :
+      !!        !  07-03  (K. Mogensen, A. Weaver, E. Remy, S. Ricci) original
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      TYPE(obs_surf),INTENT(INOUT) :: surf       ! Updated surface data
+      TYPE(obs_surf),INTENT(INOUT) :: oldsurf    ! Original surface data
+      LOGICAL :: ldeallocate ! Deallocate the updated data of insertion
+      INTEGER,INTENT(in) :: kumout      ! Output unit
+      
+      !!* Local variables
+      INTEGER :: ji
+      INTEGER :: jj
+      INTEGER :: jk
+
+      ! Copy data from surf to old surf
+
+      DO ji = 1, surf%nsurf
+
+         jj=surf%nsind(ji)
+
+         oldsurf%mi(jj)    = surf%mi(ji)
+         oldsurf%mj(jj)    = surf%mj(ji)
+         oldsurf%nsidx(jj) = surf%nsidx(ji)
+         oldsurf%nsfil(jj) = surf%nsfil(ji)
+         oldsurf%nyea(jj)  = surf%nyea(ji)
+         oldsurf%nmon(jj)  = surf%nmon(ji)
+         oldsurf%nday(jj)  = surf%nday(ji)
+         oldsurf%nhou(jj)  = surf%nhou(ji)
+         oldsurf%nmin(jj)  = surf%nmin(ji)
+         oldsurf%mstp(jj)  = surf%mstp(ji)
+         oldsurf%nqc(jj)   = surf%nqc(ji)
+         oldsurf%ntyp(jj)  = surf%ntyp(ji)
+         oldsurf%cwmo(jj)  = surf%cwmo(ji)
+         oldsurf%rlam(jj)  = surf%rlam(ji)
+         oldsurf%rphi(jj)  = surf%rphi(ji)
+
+      END DO
+
+      DO jk = 1, surf%nvar
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%robs(jj,jk)  = surf%robs(ji,jk)
+            oldsurf%rmod(jj,jk)  = surf%rmod(ji,jk)
+
+         END DO
+
+      END DO
+
+      DO jk = 1, surf%nextra
+
+         DO ji = 1, surf%nsurf
+            
+            jj=surf%nsind(ji)
+
+            oldsurf%rext(jj,jk)  = surf%rext(ji,jk)
+
+         END DO
+
+      END DO
+
+      ! Optionally deallocate the updated surface data
+
+      IF ( ldeallocate ) CALL obs_surf_dealloc( surf )
+      
+   END SUBROUTINE obs_surf_decompress
+   
+END MODULE obs_surf_def
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_types.F90	(revision 3437)
@@ -0,0 +1,267 @@
+MODULE obs_types
+   !!=====================================================================
+   !!                       ***  MODULE  obs_types  ***
+   !! Observation diagnostics: Observation type integer to character 
+   !!                          translation
+   !!=====================================================================
+
+   !!---------------------------------------------------------------------
+   !! 
+   !!   The NetCDF variable CWMO_INST_TYP_COR is used to identify the 
+   !!   different instrument types for coriolis data.
+   !!
+   !!    WMO  NEMOVAR  TYPE                   DESCRIPTION
+   !!    ---  -------  ----   --------------------------------------------
+   !!    800     0     MBT    (1941-) mechanical bathythermograph data
+   !!    401     1     XBT    (1967-) expendable bathythermograph data
+   !!    830     2     CTD    (1967-) high resolution CTD data
+   !!    820     3     MRB    (1990-) moored buoy data
+   !!    831     4     PFL    (1994-) profiling float data
+   !!    995     5     DRB    (1998-) drifting buoy data
+   !!    997     6     APB    (1997-) autonomous pinniped bathythermograph
+   !!    996     7     UOR    (1992-) undulating oceanographic recorder
+   !!    741     8     OSD    (1800-) low resolution (bottle) CTD data
+  !!
+   !! History :
+   !!        !  06-03  (K. Mogensen) Original code
+   !!        !  06-10  (A. Weaver) Cleanup
+   !!---------------------------------------------------------------------
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE 
+
+   !! * Shared Module variables
+
+   INTEGER, PUBLIC, PARAMETER :: ntyp1770 = 1023
+!RBbug useless ?   CHARACTER(LEN=4), PUBLIC, DIMENSION(0:ntyp1770) :: cwmotyp1770
+   CHARACTER(LEN=80), PUBLIC, DIMENSION(0:ntyp1770) :: cwmonam1770
+   CHARACTER(LEN=3), PUBLIC, DIMENSION(0:ntyp1770) :: ctypshort
+
+   INTEGER, PUBLIC, PARAMETER :: ntypalt = 8
+   CHARACTER(LEN=40), PUBLIC, DIMENSION(0:ntypalt) :: calttyp
+
+   PUBLIC obs_typ_init
+   PUBLIC obs_wmo_init
+   PUBLIC obs_alt_typ_init
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS 
+   
+   SUBROUTINE obs_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize code tables
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      CALL obs_wmo_init
+
+      CALL obs_alt_typ_init
+
+   END SUBROUTINE obs_typ_init
+
+   SUBROUTINE obs_wmo_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_wmo_init ***
+      !!
+      !! ** Purpose : Initialize WMO code 1770 code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : WORLD  METEOROLOGICAL  ORGANIZATION
+      !!              Manual on Codes
+      !!              International Codes
+      !!              VOLUME I.1 (Annex II to WMO Technical Regulations)
+      !!              Part A -- Alphanumeric Codes
+      !!              1995 edition
+      !!              WMO-No. 306 
+      !!              Secretariat of the World Meteorological Organization 
+      !!              Geneva, Switzerland
+      !!
+      !! History :  
+      !!      ! :  2007-04 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+      INTEGER :: ji
+
+      DO ji = 0, ntyp1770
+
+         cwmonam1770(ji) = 'Not defined'
+         ctypshort(ji) = 'XBT'
+
+!         IF ( ji < 1000 ) THEN
+!            WRITE(cwmotyp1770(ji),'(1X,I3.3)') ji
+!         ELSE
+!            WRITE(cwmotyp1770(ji),'(I4.4)') ji
+!         ENDIF
+
+      END DO
+
+      cwmonam1770(   1) = 'Sippican T-4'
+      cwmonam1770(   2) = 'Sippican T-4'
+      cwmonam1770(  11) = 'Sippican T-5'
+      cwmonam1770(  21) = 'Sippican Fast Deep'
+      cwmonam1770(  31) = 'Sippican T-6'
+      cwmonam1770(  32) = 'Sippican T-6'
+      cwmonam1770(  41) = 'Sippican T-7'
+      cwmonam1770(  42) = 'Sippican T-7'
+      cwmonam1770(  51) = 'Sippican Deep Blue'
+      cwmonam1770(  52) = 'Sippican Deep Blue'
+      cwmonam1770(  61) = 'Sippican T-10'
+      cwmonam1770(  71) = 'Sippican T-11'
+      cwmonam1770( 201) = 'TSK T-4'
+      cwmonam1770( 202) = 'TSK T-4'
+      cwmonam1770( 211) = 'TSK T-6'
+      cwmonam1770( 212) = 'TSK T-6'
+      cwmonam1770( 221) = 'TSK T-7'
+      cwmonam1770( 222) = 'TSK T-7'
+      cwmonam1770( 231) = 'TSK T-5'
+      cwmonam1770( 241) = 'TSK T-10'
+      cwmonam1770( 251) = 'TSK Deep Blue'
+      cwmonam1770( 252) = 'TSK Deep Blue'
+      cwmonam1770( 261) = 'TSK AXBT '
+      cwmonam1770( 401) = 'Sparton XBT-1'
+      cwmonam1770( 411) = 'Sparton XBT-3'
+      cwmonam1770( 421) = 'Sparton XBT-4'
+      cwmonam1770( 431) = 'Sparton XBT-5'
+      cwmonam1770( 441) = 'Sparton XBT-5DB'
+      cwmonam1770( 451) = 'Sparton XBT-6'
+      cwmonam1770( 461) = 'Sparton XBT-7'
+      cwmonam1770( 462) = 'Sparton XBT-7'
+      cwmonam1770( 471) = 'Sparton XBT-7DB'
+      cwmonam1770( 481) = 'Sparton XBT-10'
+      cwmonam1770( 491) = 'Sparton XBT-20'
+      cwmonam1770( 501) = 'Sparton XBT-20DB'
+      cwmonam1770( 510) = 'Sparton 536 AXBT'
+      cwmonam1770( 700) = 'Sippican XCTD standard'
+      cwmonam1770( 710) = 'Sippican XCTD deep'
+      cwmonam1770( 720) = 'Sippican AXCTD'
+      cwmonam1770( 730) = 'Sippican SXCTD'
+      cwmonam1770( 741) = 'TSK XCTD'
+      cwmonam1770( 742) = 'TSK XCTD-2 '
+      cwmonam1770( 743) = 'TSK XCTD-2F '
+      cwmonam1770( 751) = 'TSK AXCTD '
+      cwmonam1770( 800) = 'Mechanical BT'
+      cwmonam1770( 810) = 'Hydrocast'
+      cwmonam1770( 820) = 'Thermistor Chain'
+      cwmonam1770( 825) = 'Temperature (sonic) and pressure probes'
+      cwmonam1770( 830) = 'CTD'
+      cwmonam1770( 831) = 'CTD-P-ALACE float'
+      cwmonam1770( 840) = 'PROVOR, No conductivity sensor '
+      cwmonam1770( 841) = 'PROVOR, Seabird conductivity sensor '
+      cwmonam1770( 842) = 'PROVOR, FSI conductivity sensor '
+      cwmonam1770( 845) = 'Web Research, No conductivity sensor '
+      cwmonam1770( 846) = 'Web Research, Seabird conductivity sensor '
+      cwmonam1770( 847) = 'Web Research. FSI conductivity sensor'
+      cwmonam1770( 850) = 'SOLO, No conductivity sensor '
+      cwmonam1770( 851) = 'SOLO, Seabird conductivity sensor '
+      cwmonam1770( 852) = 'SOLO, FSI conductivity sensor'
+      cwmonam1770( 855) = 'Profiling float, NINJA, no conductivity sensor'
+      cwmonam1770( 856) = 'Profiling float, NINJA, SBE conductivity sensor'
+      cwmonam1770( 857) = 'Profiling float, NINJA, FSI conductivity sensor'
+      cwmonam1770( 858) = 'Profiling float, NINJA, TSK conductivity sensor'
+      cwmonam1770( 900) = 'Sippican T-12 XBT'
+      cwmonam1770(1023) = 'Missing value'
+
+      DO ji = 853, 854
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 859, 899
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 901, 999
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      DO ji = 1000, 1022
+         cwmonam1770(ji) = 'Reserved'
+      END DO
+
+      ctypshort(800) = 'MBT'
+      ctypshort(401) = 'XBT'
+      ctypshort(830) = 'CTD'
+      ctypshort(820) = 'MRB'
+      ctypshort(831) = 'PFL'
+      ctypshort(995) = 'DRB'
+      ctypshort(997) = 'APB'
+      ctypshort(996) = 'UOR'
+      ctypshort(700:799) = 'OSD'
+
+   END SUBROUTINE obs_wmo_init
+
+   SUBROUTINE obs_alt_typ_init
+      !!---------------------------------------------------------------------
+      !!
+      !!                   *** ROUTINE obs_alt_typ_init ***
+      !!
+      !! ** Purpose : Initialize CLS altimeter code tables
+      !!
+      !! ** Method  : Direct initialisation of variables
+      !!
+      !! ** Action  : 
+      !!
+      !! References : CLS
+      !1              SSALTO/DUACS User Handbook
+      !!              (M)SLA and (M)ADT Near-Real Time and
+      !!              Delayed time products
+      !!              CLS-DOS-NT-06-034
+      !!              2006
+      !!              CLS
+      !!              8-10 Rue Hermes
+      !!              Parc Technologique du Canal
+      !!              31526 Ramonville St-Agne
+      !!              France
+      !!
+      !! History :  
+      !!      ! :  2007-06 (K. Mogensen) Original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+      
+      !! * Arguments
+
+      !! * Local declarations
+
+      calttyp(0) = 'Unknown'
+      calttyp(1) = 'ERS-1'
+      calttyp(2) = 'ERS-2'
+      calttyp(3) = 'Topex/Poseidon'
+      calttyp(4) = 'Topex/Poseidon on its new orbit'
+      calttyp(5) = 'GFO'
+      calttyp(6) = 'Jason-1'
+      calttyp(7) = 'Envisat'
+      calttyp(8) = 'Jason-2'
+
+   END SUBROUTINE obs_alt_typ_init
+
+END MODULE obs_types
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_utils.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_vel_io.F90	(revision 3437)
@@ -0,0 +1,32 @@
+MODULE obs_vel_io
+   !!======================================================================
+   !!                       ***  MODULE obs_vel_io  ***
+   !! Observation operators : I/O for TAO velocity data
+   !!======================================================================
+   !! History : 
+   !!             !  09-01  (K. Mogensen) Initial version based on obs_read_taovel
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   read_taofile    :  Read a obfbdata structure from an TAO velocity file.
+   !!----------------------------------------------------------------------
+   USE par_kind
+   USE obs_utils
+   USE obs_fbm
+   USE obs_conv
+   USE in_out_manager
+   USE netcdf
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER :: imaxlev = 10000
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+#include "obsvel_io.h90"
+
+END MODULE obs_vel_io
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obs_write.F90	(revision 3437)
@@ -0,0 +1,914 @@
+MODULE obs_write
+   !!======================================================================
+   !!                       ***  MODULE obs_write   ***
+   !! Observation diagnosticss: Write observation related diagnostics
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   cdf_wri_p3d   : Write profile observation diagnostics in NetCDF format
+   !!   obs_wri_sla   : Write SLA observation related diagnostics
+   !!   obs_wri_sst   : Write SST observation related diagnostics
+   !!   obs_wri_seaice: Write seaice observation related diagnostics
+   !!   cdf_wri_vel   : Write velocity observation diagnostics in NetCDF format
+   !!----------------------------------------------------------------------
+
+   !! * Modules used
+   USE par_kind, ONLY : &   ! Precision variables
+      & wp
+   USE in_out_manager       ! I/O manager
+   USE dom_oce              ! Ocean space and time domain variables
+   USE obs_types            ! Observation type integer to character translation
+   USE julian, ONLY : &         ! Julian date routines
+      & greg2jul
+   USE obs_utils, ONLY : &  ! Observation operator utility functions
+      & chkerr
+   USE obs_profiles_def     ! Type definitions for profiles
+   USE obs_surf_def         ! Type defintions for surface observations
+   USE obs_fbm              ! Observation feedback I/O
+   USE obs_grid             ! Grid tools
+   USE obs_conv             ! Conversion between units
+   USE obs_const
+   USE obs_sla_types
+   USE obs_rot_vel          ! Rotation of velocities
+
+   IMPLICIT NONE
+
+   !! * Routine accessibility
+   PRIVATE
+   PUBLIC obs_wri_p3d, &    ! Write profile observation related diagnostics
+      &   obs_wri_sla, &    ! Write SLA observation related diagnostics
+      &   obs_wri_sst, &    ! Write SST observation related diagnostics
+      &   obs_wri_sss, &    ! Write SSS observation related diagnostics
+      &   obs_wri_seaice, & ! Write seaice observation related diagnostics
+      &   obs_wri_vel, &    ! Write velocity observation related diagnostics
+      &   obswriinfo
+   
+   TYPE obswriinfo
+      INTEGER :: inum
+      INTEGER, POINTER, DIMENSION(:) :: ipoint
+      CHARACTER(len=ilenname), POINTER, DIMENSION(:) :: cdname
+      CHARACTER(len=ilenlong), POINTER, DIMENSION(:,:) :: cdlong
+      CHARACTER(len=ilenunit), POINTER, DIMENSION(:,:) :: cdunit
+   END TYPE obswriinfo
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE obs_wri_p3d( cprefix, profdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write temperature and salinity (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!      ! 07-01  (K. Mogensen) Use profile data types
+      !!      ! 07-03  (K. Mogensen) General handling of profiles
+      !!      ! 09-01  (K. Mogensen) New feedback format
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix        ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata      ! Full set of profile data
+      TYPE(obswriinfo), OPTIONAL :: padd             ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext             ! Extra info
+      
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: ja
+      INTEGER :: je
+      REAL(wp) :: zpres
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+      
+      CALL init_obfbdata( fbdata )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, &
+         &                 1 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'POTM'
+      fbdata%cname(2)      = 'PSAL'
+      fbdata%coblong(1)    = 'Potential temperature'
+      fbdata%coblong(2)    = 'Practical salinity'
+      fbdata%cobunit(1)    = 'Degrees centigrade'
+      fbdata%cobunit(2)    = 'PSU'
+      fbdata%cextname(1)   = 'TEMP'
+      fbdata%cextlong(1)   = 'Insitu temperature'
+      fbdata%cextunit(1)   = 'Degrees centigrade'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated potential temperature'
+      fbdata%caddlong(1,2) = 'Model interpolated practical salinity'
+      fbdata%caddunit(1,1) = 'Degrees centigrade'
+      fbdata%caddunit(1,2) = 'PSU'
+      fbdata%cgrid(:)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         DO jvar = 1, 2
+            fbdata%caddlong(1+ja,jvar) = padd%cdlong(ja,jvar)
+            fbdata%caddunit(1+ja,jvar) = padd%cdunit(ja,jvar)
+         END DO
+      END DO
+         
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_p3d :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing profile feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               fbdata%padd(ik,jo,1,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,1+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,1+je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+               IF ( jvar == 1 ) THEN
+                  fbdata%pext(ik,jo,1) = profdata%var(jvar)%vext(jk,1)
+               ENDIF 
+            END DO
+         END DO
+      END DO
+
+      ! Convert insitu temperature to potential temperature using the model
+      ! salinity if no potential temperature
+      DO jo = 1, fbdata%nobs
+         IF ( fbdata%pphi(jo) < 9999.0 ) THEN
+            DO jk = 1, fbdata%nlev
+               IF ( ( fbdata%pob(jk,jo,1) >= 9999.0 ) .AND. &
+                  & ( fbdata%pdep(jk,jo) < 9999.0 ) .AND. &
+                  & ( fbdata%padd(jk,jo,1,2) < 9999.0 ) .AND. &
+                  & ( fbdata%pext(jk,jo,1) < 9999.0 ) ) THEN
+                  zpres = dep_to_p( REAL(fbdata%pdep(jk,jo),wp), &
+                     &              REAL(fbdata%pphi(jo),wp) )
+                  fbdata%pob(jk,jo,1) = potemp( &
+                     &                     REAL(fbdata%padd(jk,jo,1,2), wp),  &
+                     &                     REAL(fbdata%pext(jk,jo,1), wp), &
+                     &                     zpres, 0.0_wp )
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+   END SUBROUTINE obs_wri_p3d
+
+   SUBROUTINE obs_wri_sla( cprefix, sladata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sla  ***
+      !!
+      !! ** Purpose : Write SLA observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-03  (K. Mogensen) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix          ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sladata         ! Full set of SLAa
+      TYPE(obswriinfo), OPTIONAL :: padd               ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext               ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname         ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sla'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, sladata%nsurf, 1, &
+         &                 2 + nadd, 1 + next, .TRUE. )
+
+      fbdata%cname(1)      = 'SLA'
+      fbdata%coblong(1)    = 'Sea level anomaly'
+      fbdata%cobunit(1)    = 'Metres'
+      fbdata%cextname(1)   = 'MDT'
+      fbdata%cextlong(1)   = 'Mean dynamic topography'
+      fbdata%cextunit(1)   = 'Metres'
+      DO je = 1, next
+         fbdata%cextname(1+je) = pext%cdname(je)
+         fbdata%cextlong(1+je) = pext%cdlong(je,1)
+         fbdata%cextunit(1+je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated SSH - MDT'
+      fbdata%caddunit(1,1) = 'Metres' 
+      fbdata%caddname(2)   = 'SSH'
+      fbdata%caddlong(2,1) = 'Model Sea surface height'
+      fbdata%caddunit(2,1) = 'Metres'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_sla :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SLA feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sladata%nsurf
+         fbdata%plam(jo)      = sladata%rlam(jo)
+         fbdata%pphi(jo)      = sladata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sladata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = sladata%nqc(jo)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = sladata%cwmo(jo)
+         fbdata%kindex(jo)    = sladata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sladata%mi(jo)
+            fbdata%iobsj(jo,1) = sladata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sladata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sladata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sladata%nmin(jo), &
+            &           sladata%nhou(jo), &
+            &           sladata%nday(jo), &
+            &           sladata%nmon(jo), &
+            &           sladata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sladata%rmod(jo,1)
+         fbdata%padd(1,jo,2,1) = sladata%rext(jo,1)
+         fbdata%pob(1,jo,1)    = sladata%robs(jo,1) 
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sladata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sladata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = sladata%nqc(jo)
+            fbdata%ivlqc(1,jo,1)    = sladata%nqc(jo)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         fbdata%pext(1,jo,1) = sladata%rext(jo,2)
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,2+ja,1) = &
+               & sladata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,1+je) = &
+               & sladata%rext(jo,pext%ipoint(je))
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sla
+
+   SUBROUTINE obs_wri_sst( cprefix, sstdata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_sst  ***
+      !!
+      !! ** Purpose : Write SST observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: sstdata      ! Full set of SST
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations 
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) ::  cfname             ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_sst'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, sstdata%nsurf, 1, &
+         &                 1 + nadd, next, .TRUE. )
+
+      fbdata%cname(1)      = 'SST'
+      fbdata%coblong(1)    = 'Sea surface temperature'
+      fbdata%cobunit(1)    = 'Degree centigrade'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated SST'
+      fbdata%caddunit(1,1) = 'Degree centigrade'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_sst :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SST feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, sstdata%nsurf
+         fbdata%plam(jo)      = sstdata%rlam(jo)
+         fbdata%pphi(jo)      = sstdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') sstdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(sstdata%nqc(jo),1)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = ''
+         fbdata%kindex(jo)    = sstdata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = sstdata%mi(jo)
+            fbdata%iobsj(jo,1) = sstdata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(sstdata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(sstdata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           sstdata%nmin(jo), &
+            &           sstdata%nhou(jo), &
+            &           sstdata%nday(jo), &
+            &           sstdata%nmon(jo), &
+            &           sstdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = sstdata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = sstdata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( sstdata%nqc(jo) > 10 ) THEN
+            fbdata%ivqc(jo,1)       = 4
+            fbdata%ivlqc(1,jo,1)    = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = sstdata%nqc(jo) - 10
+         ELSE
+            fbdata%ivqc(jo,1)       = MAX(sstdata%nqc(jo),1)
+            fbdata%ivlqc(1,jo,1)    = MAX(sstdata%nqc(jo),1)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,1+ja,1) = &
+               & sstdata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & sstdata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_sst
+
+   SUBROUTINE obs_wri_sss
+   END SUBROUTINE obs_wri_sss
+
+   SUBROUTINE obs_wri_seaice( cprefix, seaicedata, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_seaice  ***
+      !!
+      !! ** Purpose : Write sea ice observation diagnostics
+      !!              related 
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !!      ! 07-07  (S. Ricci) Original
+      !!      ! 09-01  (K. Mogensen) New feedback format.
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+      IMPLICIT NONE
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_surf), INTENT(INOUT) :: seaicedata   ! Full set of sea ice
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations 
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname             ! netCDF filename
+      CHARACTER(LEN=12), PARAMETER :: cpname = 'obs_wri_seaice'
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      CALL alloc_obfbdata( fbdata, 1, seaicedata%nsurf, 1, 1, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'SEAICE'
+      fbdata%coblong(1)    = 'Sea ice'
+      fbdata%cobunit(1)    = 'Fraction'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated ICE'
+      fbdata%caddunit(1,1) = 'Fraction'
+      fbdata%cgrid(1)      = 'T'
+      DO ja = 1, nadd
+         fbdata%caddname(1+ja) = padd%cdname(ja)
+         fbdata%caddlong(1+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(1+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_seaice :'
+         WRITE(numout,*)'~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing SEAICE feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, seaicedata%nsurf
+         fbdata%plam(jo)      = seaicedata%rlam(jo)
+         fbdata%pphi(jo)      = seaicedata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') seaicedata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = 0
+         fbdata%ivqcf(:,jo,:) = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = 0
+            fbdata%ioqcf(2,jo) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = MAX(seaicedata%nqc(jo),1)
+            fbdata%ioqcf(:,jo) = 0
+         ENDIF
+         fbdata%ipqc(jo)      = 0
+         fbdata%ipqcf(:,jo)   = 0
+         fbdata%itqc(jo)      = 0
+         fbdata%itqcf(:,jo)   = 0
+         fbdata%cdwmo(jo)     = ''
+         fbdata%kindex(jo)    = seaicedata%nsfil(jo)
+         IF (ln_grid_global) THEN
+            fbdata%iobsi(jo,1) = seaicedata%mi(jo)
+            fbdata%iobsj(jo,1) = seaicedata%mj(jo)
+         ELSE
+            fbdata%iobsi(jo,1) = mig(seaicedata%mi(jo))
+            fbdata%iobsj(jo,1) = mjg(seaicedata%mj(jo))
+         ENDIF
+         CALL greg2jul( 0, &
+            &           seaicedata%nmin(jo), &
+            &           seaicedata%nhou(jo), &
+            &           seaicedata%nday(jo), &
+            &           seaicedata%nmon(jo), &
+            &           seaicedata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         fbdata%padd(1,jo,1,1) = seaicedata%rmod(jo,1)
+         fbdata%pob(1,jo,1)    = seaicedata%robs(jo,1)
+         fbdata%pdep(1,jo)     = 0.0
+         fbdata%idqc(1,jo)     = 0
+         fbdata%idqcf(:,1,jo)  = 0
+         IF ( seaicedata%nqc(jo) > 10 ) THEN
+            fbdata%ivlqc(1,jo,1) = 4
+            fbdata%ivlqcf(1,1,jo,1) = 0
+            fbdata%ivlqcf(2,1,jo,1) = seaicedata%nqc(jo) - 10
+         ELSE
+            fbdata%ivlqc(1,jo,1) = MAX(seaicedata%nqc(jo),1)
+            fbdata%ivlqcf(:,1,jo,1) = 0
+         ENDIF
+         fbdata%iobsk(1,jo,1)  = 0
+         DO ja = 1, nadd
+            fbdata%padd(1,jo,1+ja,1) = &
+               & seaicedata%rext(jo,padd%ipoint(ja))
+         END DO
+         DO je = 1, next
+            fbdata%pext(1,jo,je) = &
+               & seaicedata%rext(jo,pext%ipoint(je))
+         END DO
+
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+
+      CALL dealloc_obfbdata( fbdata )
+
+   END SUBROUTINE obs_wri_seaice
+
+   SUBROUTINE obs_wri_vel( cprefix, profdata, k2dint, padd, pext )
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     *** ROUTINE obs_wri_p3d  ***
+      !!
+      !! ** Purpose : Write current (profile) observation 
+      !!              related diagnostics
+      !!
+      !! ** Method  : NetCDF
+      !! 
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 09-01  (K. Mogensen) New feedback format routine
+      !!-----------------------------------------------------------------------
+
+      !! * Modules used
+
+      !! * Arguments
+      CHARACTER(LEN=*), INTENT(IN) :: cprefix       ! Prefix for output files
+      TYPE(obs_prof), INTENT(INOUT) :: profdata     ! Full set of profile data
+      INTEGER, INTENT(IN) :: k2dint                 ! Horizontal interpolation method
+      TYPE(obswriinfo), OPTIONAL :: padd            ! Additional info for each variable
+      TYPE(obswriinfo), OPTIONAL :: pext            ! Extra info
+
+      !! * Local declarations
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(LEN=40) :: cfname
+      INTEGER :: ilevel
+      INTEGER :: jvar
+      INTEGER :: jk
+      INTEGER :: ik
+      INTEGER :: jo
+      INTEGER :: ja
+      INTEGER :: je
+      INTEGER :: nadd
+      INTEGER :: next
+      REAL(wp) :: zpres
+      REAL(wp), DIMENSION(:), ALLOCATABLE :: &
+         & zu, &
+         & zv
+
+      IF ( PRESENT( padd ) ) THEN
+         nadd = padd%inum
+      ELSE
+         nadd = 0
+      ENDIF
+
+      IF ( PRESENT( pext ) ) THEN
+         next = pext%inum
+      ELSE
+         next = 0
+      ENDIF
+
+      CALL init_obfbdata( fbdata )
+
+      ! Find maximum level
+      ilevel = 0
+      DO jvar = 1, 2
+         ilevel = MAX( ilevel, MAXVAL( profdata%var(jvar)%nvlidx(:) ) )
+      END DO
+      CALL alloc_obfbdata( fbdata, 2, profdata%nprof, ilevel, 2, 0, .TRUE. )
+
+      fbdata%cname(1)      = 'UVEL'
+      fbdata%cname(2)      = 'VVEL'
+      fbdata%coblong(1)    = 'Zonal velocity'
+      fbdata%coblong(2)    = 'Meridional velocity'
+      fbdata%cobunit(1)    = 'm/s'
+      fbdata%cobunit(2)    = 'm/s'
+      DO je = 1, next
+         fbdata%cextname(je) = pext%cdname(je)
+         fbdata%cextlong(je) = pext%cdlong(je,1)
+         fbdata%cextunit(je) = pext%cdunit(je,1)
+      END DO
+      fbdata%caddname(1)   = 'Hx'
+      fbdata%caddlong(1,1) = 'Model interpolated zonal velocity'
+      fbdata%caddlong(1,2) = 'Model interpolated meridional velocity'
+      fbdata%caddunit(1,1) = 'm/s'
+      fbdata%caddunit(1,2) = 'm/s'
+      fbdata%caddname(2)   = 'HxG'
+      fbdata%caddlong(2,1) = 'Model interpolated zonal velocity (model grid)'
+      fbdata%caddlong(2,2) = 'Model interpolated meridional velocity (model grid)'
+      fbdata%caddunit(2,1) = 'm/s'
+      fbdata%caddunit(2,2) = 'm/s' 
+      fbdata%cgrid(1)      = 'U' 
+      fbdata%cgrid(2)      = 'V'
+      DO ja = 1, nadd
+         fbdata%caddname(2+ja) = padd%cdname(ja)
+         fbdata%caddlong(2+ja,1) = padd%cdlong(ja,1)
+         fbdata%caddunit(2+ja,1) = padd%cdunit(ja,1)
+      END DO
+
+      WRITE(cfname, FMT="(A,'_fdbk_',I4.4,'.nc')") TRIM(cprefix), nproc
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)'obs_wri_vel :'
+         WRITE(numout,*)'~~~~~~~~~~~~~'
+         WRITE(numout,*)'Writing velocuty feedback file : ',TRIM(cfname)
+      ENDIF
+
+      ALLOCATE( &
+         & zu(profdata%nvprot(1)), &
+         & zv(profdata%nvprot(2))  &
+         & )
+      CALL obs_rotvel( profdata, k2dint, zu, zv )
+
+      ! Transform obs_prof data structure into obfbdata structure
+      fbdata%cdjuldref = '19500101000000'
+      DO jo = 1, profdata%nprof
+         fbdata%plam(jo)      = profdata%rlam(jo)
+         fbdata%pphi(jo)      = profdata%rphi(jo)
+         WRITE(fbdata%cdtyp(jo),'(I4)') profdata%ntyp(jo)
+         fbdata%ivqc(jo,:)    = profdata%ivqc(jo,:)
+         fbdata%ivqcf(:,jo,:) = profdata%ivqcf(:,jo,:)
+         IF ( profdata%nqc(jo) > 10 ) THEN
+            fbdata%ioqc(jo)    = 4
+            fbdata%ioqcf(1,jo) = profdata%nqcf(1,jo)
+            fbdata%ioqcf(2,jo) = profdata%nqc(jo) - 10
+         ELSE
+            fbdata%ioqc(jo)    = profdata%nqc(jo)
+            fbdata%ioqcf(:,jo) = profdata%nqcf(:,jo)
+         ENDIF
+         fbdata%ipqc(jo)      = profdata%ipqc(jo)
+         fbdata%ipqcf(:,jo)   = profdata%ipqcf(:,jo)
+         fbdata%itqc(jo)      = profdata%itqc(jo)
+         fbdata%itqcf(:,jo)   = profdata%itqcf(:,jo)
+         fbdata%cdwmo(jo)     = profdata%cwmo(jo)
+         fbdata%kindex(jo)    = profdata%npfil(jo)
+         DO jvar = 1, profdata%nvar
+            IF (ln_grid_global) THEN
+               fbdata%iobsi(jo,jvar) = profdata%mi(jo,jvar)
+               fbdata%iobsj(jo,jvar) = profdata%mj(jo,jvar)
+            ELSE
+               fbdata%iobsi(jo,jvar) = mig(profdata%mi(jo,jvar))
+               fbdata%iobsj(jo,jvar) = mjg(profdata%mj(jo,jvar))
+            ENDIF
+         END DO
+         CALL greg2jul( 0, &
+            &           profdata%nmin(jo), &
+            &           profdata%nhou(jo), &
+            &           profdata%nday(jo), &
+            &           profdata%nmon(jo), &
+            &           profdata%nyea(jo), &
+            &           fbdata%ptim(jo),   &
+            &           krefdate = 19500101 )
+         ! Reform the profiles arrays for output
+         DO jvar = 1, 2
+            DO jk = profdata%npvsta(jo,jvar), profdata%npvend(jo,jvar)
+               ik = profdata%var(jvar)%nvlidx(jk)
+               IF ( jvar == 1 ) THEN
+                  fbdata%padd(ik,jo,1,jvar) = zu(jk)
+               ELSE
+                  fbdata%padd(ik,jo,1,jvar) = zv(jk)
+               ENDIF
+               fbdata%padd(ik,jo,2,jvar) = profdata%var(jvar)%vmod(jk)
+               fbdata%pob(ik,jo,jvar)    = profdata%var(jvar)%vobs(jk)
+               fbdata%pdep(ik,jo)        = profdata%var(jvar)%vdep(jk)
+               fbdata%idqc(ik,jo)        = profdata%var(jvar)%idqc(jk)
+               fbdata%idqcf(:,ik,jo)     = profdata%var(jvar)%idqcf(:,jk)
+               IF ( profdata%var(jvar)%nvqc(jk) > 10 ) THEN
+                  fbdata%ivlqc(ik,jo,jvar) = 4
+                  fbdata%ivlqcf(1,ik,jo,jvar) = profdata%var(jvar)%nvqcf(1,jk)
+                  fbdata%ivlqcf(2,ik,jo,jvar) = profdata%var(jvar)%nvqc(jk) - 10
+               ELSE
+                  fbdata%ivlqc(ik,jo,jvar) = profdata%var(jvar)%nvqc(jk)
+                  fbdata%ivlqcf(:,ik,jo,jvar) = profdata%var(jvar)%nvqcf(:,jk)
+               ENDIF
+               fbdata%iobsk(ik,jo,jvar)  = profdata%var(jvar)%mvk(jk)
+               DO ja = 1, nadd
+                  fbdata%padd(ik,jo,2+ja,jvar) = &
+                     & profdata%var(jvar)%vext(jk,padd%ipoint(ja))
+               END DO
+               DO je = 1, next
+                  fbdata%pext(ik,jo,je) = &
+                     & profdata%var(jvar)%vext(jk,pext%ipoint(je))
+               END DO
+            END DO
+         END DO
+      END DO
+
+      ! Write the obfbdata structure
+      CALL write_obfbdata( cfname, fbdata )
+      
+      CALL dealloc_obfbdata( fbdata )
+     
+      DEALLOCATE( &
+         & zu, &
+         & zv  &
+         & )
+
+   END SUBROUTINE obs_wri_vel
+
+END MODULE obs_write
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_h2d.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsinter_z1d.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsprof_io.h90	(revision 3437)
@@ -0,0 +1,834 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_enactfile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the profile ENACT observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                      ! Number of levels
+      INTEGER :: i_file_id
+      INTEGER :: i_obs_id
+      INTEGER :: i_lev_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_pl_num_id
+      INTEGER :: i_reference_date_time_id
+      INTEGER :: i_format_version_id
+      INTEGER :: i_juld_id
+      INTEGER :: i_data_type_id
+      INTEGER :: i_wmo_inst_type_id
+      INTEGER :: i_qc_var_id
+      INTEGER :: i_dc_ref_id
+      INTEGER :: i_qc_flag_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth 
+      CHARACTER(LEN=40) :: cl_fld_var_tp
+      CHARACTER(LEN=40) :: cl_fld_var_s
+      CHARACTER(LEN=40) :: cl_fld_var_ti
+      CHARACTER(LEN=40) :: cl_fld_var_juld_qc
+      CHARACTER(LEN=40) :: cl_fld_var_pos_qc
+      CHARACTER(LEN=40) :: cl_fld_var_depth_qc 
+      CHARACTER(LEN=40) :: cl_fld_var_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_qc_s
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_t
+      CHARACTER(LEN=40) :: cl_fld_var_prof_qc_s
+      CHARACTER(LEN=40) :: cl_fld_reference_date_time
+      CHARACTER(LEN=40) :: cl_fld_juld
+      CHARACTER(LEN=40) :: cl_fld_data_type
+      CHARACTER(LEN=40) :: cl_fld_pl_num
+      CHARACTER(LEN=40) :: cl_fld_format_version
+      CHARACTER(LEN=40) :: cl_fld_wmo_inst_type
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_profiles
+      CHARACTER(LEN=40) :: cl_fld_qc_flags_levels
+
+      CHARACTER(LEN=14), PARAMETER :: cl_name = 'read_enactfile'
+      CHARACTER(LEN=16)            :: cl_data_type = ''
+      CHARACTER(LEN=4 )            :: cl_format_version = ''
+      INTEGER, DIMENSION(1) :: istart1, icount1
+      INTEGER, DIMENSION(2) :: istart2, icount2
+      CHARACTER(len=imaxlev) :: clqc
+      CHARACTER(len=1) :: cqc
+      INTEGER :: ji, jk
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: iqc1
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iqc2
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      cl_fld_lam                 = 'LONGITUDE'
+      cl_fld_phi                 = 'LATITUDE'
+      cl_fld_depth               = 'DEPH_CORRECTED'
+      cl_fld_reference_date_time = 'REFERENCE_DATE_TIME'
+      cl_fld_juld                = 'JULD'
+      cl_fld_data_type           = 'DATA_TYPE'
+      cl_fld_format_version      = 'FORMAT_VERSION'
+      cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+      cl_fld_pl_num              = 'PLATFORM_NUMBER'
+
+      cl_fld_var_qc_t            = 'POTM_CORRECTED_QC'
+      cl_fld_var_prof_qc_t       = 'PROFILE_POTM_QC'
+      cl_fld_var_tp              = 'POTM_CORRECTED'
+      cl_fld_var_qc_s            = 'PSAL_CORRECTED_QC'
+      cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+      cl_fld_var_s               = 'PSAL_CORRECTED'
+      cl_fld_var_depth_qc        = 'DEPH_CORRECTED_QC'
+      cl_fld_var_juld_qc         = 'JULD_QC'
+      cl_fld_var_pos_qc          = 'POSITION_QC'
+      cl_fld_var_ti              = 'TEMP'
+      cl_fld_qc_flags_profiles   = 'QC_FLAGS_PROFILES'
+      cl_fld_qc_flags_levels     = 'QC_FLAGS_LEVELS'
+
+      icount1(1) = 1 
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_data_type,      &
+         &         i_data_type_id ),      cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_data_type_id,        &
+         &         cl_data_type ),        cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_format_version, &
+         &         i_format_version_id ), cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_format_version_id,   &
+         &         cl_format_version ),   cl_name, __LINE__ )
+      
+      CALL str_c_to_for( cl_data_type )
+      CALL str_c_to_for( cl_format_version )
+      
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_enactfile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Data type           = ', &
+         &                TRIM( ADJUSTL( cl_data_type ) )
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ',  &
+         &                TRIM( ADJUSTL( cl_format_version ) )
+      
+      IF ( ( ( INDEX( cl_data_type,"ENACT v1.0" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.4" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENACT v1.5" ) == 1 ) .OR.   &
+         &   ( INDEX( cl_data_type,"ENSEMBLES EN3 v1" ) == 1 )      ) &
+         &   .AND.                                              &
+         &   ( INDEX( cl_format_version,"2.0"   ) == 1 ) ) THEN
+         IF(ldwp)WRITE(kunit,*)'               Valid input file'
+      ELSE
+         CALL fatal_error( 'Invalid input file', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_PROF', i_obs_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'N_LEVELS', i_lev_id ),     &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+
+      !---------------------------------------------------------------------
+      ! Read the QC atributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )        
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ),                         &
+         &         cl_name, __LINE__ )
+      DO ji = 1, iobs
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      ! No depth QC in files
+      DO ji = 1, iobs
+         DO jk = 1, ilev
+            inpfile%idqc(jk,ji)  = 1
+            inpfile%idqcf(:,jk,ji) = 0
+         END DO
+      END DO
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                    & 
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+!!      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_juld_qc, i_qc_var_id ),                       &
+!!         &         cl_name, __LINE__ ) 
+!!      !DO ji = 1,iobs
+!!         istart1(1) = ji
+!!         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+!!            &                         start = istart1, count = icount1),                              &
+!!            &         cl_name, __LINE__ )
+!!         inpfile%itqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+!!         inpfile%itqcf(:,ji) = 0
+!!      END DO
+      ! Since the flags are not set in the ENACT files we reset them to 0
+      inpfile%itqc(:)    = 1      
+      inpfile%itqcf(:,:) = 0
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)    = IACHAR( cqc ) - IACHAR( '0' )
+         inpfile%ipqcf(:,ji) = 0
+      END DO
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_profiles, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc1(iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc1 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            inpfile%ioqcf(1,ji)   = iqc1(ji)
+            inpfile%ivqcf(1,ji,:) = iqc1(ji)
+            inpfile%ioqcf(2,ji)   = 0
+            inpfile%ivqcf(2,ji,:) = 0
+         END DO
+         DEALLOCATE( &
+            & iqc1 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC profile flags in file'
+         inpfile%ioqcf(:,:)   = 0
+         inpfile%ivqcf(:,:,:) = 0
+      ENDIF
+      IF ( nf90_inq_varid( i_file_id, cl_fld_qc_flags_levels, i_qc_flag_id ) == nf90_noerr ) THEN
+         ALLOCATE( &
+            & iqc2(ilev,iobs) &
+            & )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_flag_id, iqc2 ),                                &
+            &         cl_name, __LINE__ )
+         DO ji = 1,iobs
+            DO jk = 1,ilev
+               inpfile%ivlqcf(1,jk,ji,:) = iqc2(jk,ji)
+               inpfile%ivlqcf(2,jk,ji,:) = 0
+            END DO
+         END DO
+         DEALLOCATE( &
+            & iqc2 &
+            & )
+      ELSE
+         IF(ldwp) WRITE(kunit,*)'No QC level flags in file'
+         inpfile%ivlqcf(:,:,:,:) = 0
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                             &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_reference_date_time, i_reference_date_time_id ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_reference_date_time_id, inpfile%cdjuldref ),          &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_tp, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,1) ),                         &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                         &
+         &         cl_name, __LINE__ )
+ 
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_ti, i_var_id ),                              &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+
+   END SUBROUTINE read_enactfile
+
+   SUBROUTINE read_coriofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_coriofile **
+      !!
+      !! ** Purpose : Read from file the profile CORIO observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output enactfile structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      INTEGER  :: &
+         & iobs, &
+         & ilev
+      !! * Local declarations
+      INTEGER :: &
+         & i_file_id,                &
+         & i_obs_id,                 &
+         & i_lev_id,                 &
+         & i_phi_id,                 & 
+         & i_lam_id,                 &
+         & i_depth_id,               &
+         & i_pres_id,                &
+         & i_var_id,                 &
+         & i_pl_num_id,              &
+         & i_format_version_id,      &
+         & i_juld_id,                &
+         & i_data_type_id,           &
+         & i_wmo_inst_type_id,       &
+         & i_qc_var_id,              &
+         & i_dc_ref_id
+      CHARACTER(LEN=40) :: & 
+         & cl_fld_lam,                 &
+         & cl_fld_phi,                 &
+         & cl_fld_depth,               & 
+         & cl_fld_depth_qc,            & 
+         & cl_fld_pres,                & 
+         & cl_fld_pres_qc,             & 
+         & cl_fld_var_t,               &
+         & cl_fld_var_s,               &
+         & cl_fld_var_ti,              &
+         & cl_fld_var_pos_qc,          &
+         & cl_fld_var_qc_t,            &
+         & cl_fld_var_qc_s,            &
+         & cl_fld_var_prof_qc_t,       &
+         & cl_fld_var_prof_qc_s,       &
+         & cl_fld_dc_ref,              &
+         & cl_fld_juld,                &
+         & cl_fld_pl_num,              &
+         & cl_fld_wmo_inst_type
+      CHARACTER(LEN=14), PARAMETER :: &
+         & cl_name = 'read_coriofile'
+      CHARACTER(LEN=4 )            :: &
+         & cl_format_version = ''
+      INTEGER, DIMENSION(1) :: &
+         & istart1, icount1
+      INTEGER, DIMENSION(2) :: &
+         & istart2, icount2
+      CHARACTER(len=imaxlev) :: &
+         & clqc
+      CHARACTER(len=1) :: &
+         & cqc
+      CHARACTER(len=256) :: &
+         & cdjulref
+      INTEGER :: &
+         & ji, jk
+      INTEGER :: &
+         & iformat
+      LOGICAL :: & 
+         & lsal
+      REAL(fbdp), DIMENSION(:,:), ALLOCATABLE :: &
+         & zpres
+      INTEGER, DIMENSION(:,:), ALLOCATABLE :: &
+         & ipresqc
+      CHARACTER(len=256) :: &
+         & cerr
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+
+      icount1(1) = 1 
+      lsal = .TRUE.
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Check format and set variables accordingly
+      !-----------------------------------------------------------------------
+
+      IF ( ( nf90_inq_dimid( i_file_id, 'N_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'N_LEVELS', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 1
+      ELSEIF ( ( nf90_inq_dimid( i_file_id, 'mN_PROF', i_obs_id ) == nf90_noerr ) .AND. &
+         & ( nf90_inq_dimid( i_file_id, 'mN_ZLEV', i_lev_id ) == nf90_noerr ) ) THEN
+         iformat = 2
+      ELSE
+         WRITE(cerr,'(2A)')'Invalid data format in ',cl_name
+         CALL fatal_error( cerr, __LINE__ )
+      ENDIF
+      IF ( iformat == 1 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'DEPH_QC'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'PRES_QC'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'WMO_INST_TYPE'
+         cl_fld_dc_ref              = 'DC_REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'TEMP_QC'
+         cl_fld_var_prof_qc_t       = 'PROFILE_TEMP_QC'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'PSAL_QC'
+         cl_fld_var_prof_qc_s       = 'PROFILE_PSAL_QC'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'POSITION_QC'
+      ELSEIF ( iformat==2 ) THEN
+         cl_fld_lam                 = 'LONGITUDE'
+         cl_fld_phi                 = 'LATITUDE'  
+         cl_fld_depth               = 'DEPH'
+         cl_fld_depth_qc            = 'QC_DEPH'
+         cl_fld_pres                = 'PRES'
+         cl_fld_pres_qc             = 'QC_PRES'
+         cl_fld_juld                = 'JULD'
+         cl_fld_wmo_inst_type       = 'INST_TYPE'
+         cl_fld_dc_ref              = 'REFERENCE'
+         cl_fld_pl_num              = 'PLATFORM_NUMBER'
+         cl_fld_var_qc_t            = 'QC_TEMP'
+         cl_fld_var_prof_qc_t       = 'Q_PROFILE_TEMP'
+         cl_fld_var_t               = 'TEMP'
+         cl_fld_var_qc_s            = 'QC_PSAL'
+         cl_fld_var_prof_qc_s       = 'Q_PROFILE_PSAL'
+         cl_fld_var_s               = 'PSAL'
+         cl_fld_var_pos_qc          = 'Q_POSITION'
+      ENDIF
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+
+      IF(ldwp)WRITE(kunit,*)
+      IF(ldwp)WRITE(kunit,*) ' read_coriofile :' 
+      IF(ldwp)WRITE(kunit,*) ' ~~~~~~~~~~~~~~~~'
+      IF(ldwp)WRITE(kunit,*) '               Format version      = ', iformat
+
+      !---------------------------------------------------------------------
+      ! Read the number of observations and levels to allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_obs_id, len = iobs ), &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_lev_id, len = ilev ), &
+         &         cl_name, __LINE__ )
+      IF(ldwp)WRITE(kunit,*) '               No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '               No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+      IF (ilev > imaxlev) THEN
+         CALL fatal_error( 'Increase imaxlev in obs_prof_io.F90', __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 1, ldgrid )
+      inpfile%cname(1) = 'POTM'
+      inpfile%cname(2) = 'PSAL'
+      inpfile%coblong(1) = 'Potential temperature'
+      inpfile%coblong(2) = 'Practical salinity'
+      inpfile%cobunit(1) = 'Degrees Celsius'
+      inpfile%cobunit(2) = 'PSU'
+      inpfile%cextname(1) = 'TEMP'
+      inpfile%cextlong(1) = 'Insitu temperature'
+      inpfile%cextunit(1) = 'Degrees Celsius'
+      ALLOCATE( &
+         & zpres(ilev,iobs),  &
+         & ipresqc(ilev,iobs) &
+         & )
+      !---------------------------------------------------------------------
+      ! Get julian data reference (iformat==2)
+      !---------------------------------------------------------------------
+
+      IF (iformat==2) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, nf90_global, &
+            &                        "Reference_date_time", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(7:10)//cdjulref(4:5)// &
+            & cdjulref(1:2)//cdjulref(12:13)//cdjulref(15:16)//cdjulref(18:19)
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_qc_t, i_qc_var_id ),                                &
+         &         cl_name, __LINE__ )
+      istart2(1) = 1
+      icount2(2) = 1
+      icount2(1) = ilev
+      DO ji = 1, iobs 
+         istart2(2) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                   &
+            &                         start = istart2, count = icount2),                              &
+            &         cl_name, __LINE__ )
+         DO jk = 1, ilev
+            inpfile%ivlqc(jk,ji,1) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+         END DO
+      END DO
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_s, i_qc_var_id ) == nf90_noerr ) THEN
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%ivlqc(jk,ji,2) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%ivlqc(:,:,2) = 4
+         inpfile%pob(:,:,2) = fbrmdi
+         lsal = .FALSE.
+      ENDIF
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_t, i_qc_var_id ),                    &
+         &         cl_name,  __LINE__ )
+      DO ji = 1,iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ivqc(ji,1) = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      IF (lsal) THEN
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_prof_qc_s, i_qc_var_id ),                 & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1,iobs
+            istart1(1) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                 &
+               &                         start = istart1, count = icount1),                           &
+               &         cl_name, __LINE__ )
+            inpfile%ivqc(ji,2) = IACHAR( cqc ) - IACHAR( '0' )
+         END DO
+      ELSE
+         inpfile%ivqc(:,2) = 4
+      ENDIF
+      DO ji = 1,iobs
+         inpfile%ioqc(ji) = MIN( inpfile%ivqc(ji,1), inpfile%ivqc(ji,2) )
+      END DO
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_pos_qc, i_qc_var_id ),                       &
+         &         cl_name, __LINE__ ) 
+      DO ji = 1, iobs
+         istart1(1) = ji
+         CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, cqc,                                    &
+            &                         start = istart1, count = icount1),                              &
+            &         cl_name, __LINE__ )
+         inpfile%ipqc(ji)  = IACHAR( cqc ) - IACHAR( '0' )
+      END DO
+      
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_juld, i_juld_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_juld_id, inpfile%ptim ),                              &
+         &         cl_name, __LINE__ )
+      IF (iformat==1) THEN
+         CALL chkerr ( nf90_get_att( i_file_id, i_juld_id, &
+            &                        "units", cdjulref ), &
+            &         cl_name, __LINE__ )
+         inpfile%cdjuldref = cdjulref(12:15)//cdjulref(17:18)// &
+            & cdjulref(20:21)//cdjulref(23:24)//cdjulref(26:27)//&
+            & cdjulref(29:30)
+      ENDIF
+      
+      IF ( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, inpfile%pdep ),                          &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth_qc, i_qc_var_id ),                      & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               inpfile%idqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         inpfile%pdep(:,:) = fbrmdi
+         inpfile%idqc(:,:) = 4
+      ENDIF
+
+      IF ( nf90_inq_varid( i_file_id, cl_fld_pres, i_pres_id ) == nf90_noerr ) THEN
+         CALL chkerr( nf90_get_var  ( i_file_id, i_pres_id, zpres ),                                  &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pres_qc, i_qc_var_id ),                       & 
+            &         cl_name, __LINE__ ) 
+         DO ji = 1, iobs
+            istart2(2) = ji
+            CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, clqc,                                &
+               &                         start = istart2, count = icount2),                           &
+               &         cl_name, __LINE__ )
+            DO jk = 1, ilev
+               ipresqc(jk,ji) = IACHAR( clqc(jk:jk) ) - IACHAR( '0' )
+            END DO
+         END DO
+      ELSE
+         zpres(:,:) = fbrmdi
+         ipresqc(:,:) = 4
+      ENDIF
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, inpfile%pphi ),                               &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, inpfile%plam ),                               &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the platform information
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_wmo_inst_type, i_wmo_inst_type_id ),             &
+         &         cl_name, __LINE__ )          
+      CALL chkerr( nf90_get_var  ( i_file_id, i_wmo_inst_type_id, inpfile%cdtyp ),                    &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_pl_num, i_pl_num_id ),                           &
+         &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_pl_num_id, inpfile%cdwmo ),                           &
+         &         cl_name, __LINE__ )         
+
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_t, i_var_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pext(:,:,1) ),                        &
+         &         cl_name, __LINE__ )
+
+      IF (lsal) THEN      
+         CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_var_s, i_var_id ),                            &
+            &         cl_name, __LINE__ )
+         CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, inpfile%pob(:,:,2) ),                      &
+            &         cl_name, __LINE__ )
+      ENDIF
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+         
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         inpfile%kindex(ji) = ji
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Coriolis data conversion from insitu to potential temperature
+      !---------------------------------------------------------------------
+      !---------------------------------------------------------------------
+      !  Convert pressure to depth if depth not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( inpfile%pdep(jk,ji) >= 9999.0 ) THEN
+                  IF ( zpres(jk,ji) < 9999.0 ) THEN
+                     inpfile%pdep(jk,ji) = &
+                        & p_to_dep( REAL(zpres(jk,ji),wp), REAL(inpfile%pphi(ji),wp) )
+                     inpfile%idqc(jk,ji) = ipresqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert depth to pressure if pressure not present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         IF ( inpfile%pphi(ji) < 9999.0 ) THEN
+            DO jk = 1, inpfile%nlev
+               IF ( zpres(jk,ji) >= 9999.0 ) THEN
+                  IF ( inpfile%pdep(jk,ji) < 9999.0 ) THEN
+                     zpres(jk,ji) = dep_to_p( REAL(inpfile%pdep(jk,ji),wp), &
+                        &                            REAL(inpfile%pphi(ji),wp) )
+                     ipresqc(jk,ji) = inpfile%idqc(jk,ji)
+                  ENDIF
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !---------------------------------------------------------------------
+      !  Convert insitu temperature to potential temperature if
+      !  salinity, insitu temperature and pressure are present
+      !---------------------------------------------------------------------
+      DO ji = 1, inpfile%nobs
+         DO jk = 1, inpfile%nlev
+            IF (( inpfile%pob(jk,ji,2) < 9999.0 ) .AND. &
+               &( inpfile%pext(jk,ji,1) < 9999.0 ) .AND. &
+               &( zpres(jk,ji) < 9999.0 ) ) THEN
+               inpfile%pob(jk,ji,1) = potemp( REAL(inpfile%pob(jk,ji,2), wp),  &
+                  &                           REAL(inpfile%pext(jk,ji,1), wp), &
+                  &                           REAL(zpres(jk,ji),wp),  &
+                  &                           0.0_wp )
+            ELSE
+               inpfile%pob(jk,ji,1) = fbrmdi
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      !  Initialize flags since they are not in the CORIOLIS input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+   END SUBROUTINE read_coriofile
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsseaice_io.h90	(revision 3437)
@@ -0,0 +1,270 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_seaice( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_seaice **
+      !!
+      !! ** Purpose : Read from file the SEAICE observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_seaice'
+      INTEGER :: i_file_id    ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data       ! Number of data per parameter in current file
+      INTEGER :: i_time       ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of seaice measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_seaice         ! Seaice data     
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen          ! Length of netCDF attributes
+      INTEGER :: itype          ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca      ! Scale factor
+      REAL(KIND=wp) :: zoff      ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset  ! Offset for time conversion
+      REAL(KIND=wp) :: zfill     ! Fill value in netcdf file
+      CHARACTER (len=33) ::creftime     ! Reference time of file
+      INTEGER :: i_refyear       ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_seaice        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SeaIce_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get seaice data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_ice_concentration', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_seaice), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_seaice(:,:) /=  zfill)
+         z_seaice(:,:) = (zsca * z_seaice(:,:)) + zoff
+      ELSEWHERE
+         z_seaice(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get seaice obs type
+      
+      i_type(:,:)=1
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SEAICE'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'seaice','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_seaice(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_seaice(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+   END SUBROUTINE read_seaice
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_io.h90	(revision 3437)
@@ -0,0 +1,378 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_avisofile( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_avisofile **
+      !!
+      !! ** Purpose : Read from file the AVISO SLA observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : http://www.aviso.oceanobs.com
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=14),PARAMETER :: cpname = 'read_avisofile'
+      INTEGER :: i_file_id     ! netcdf IDS
+      INTEGER :: i_tracks_id
+      INTEGER :: i_cycles_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER, PARAMETER :: imaxdim = 2    ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims       ! Dimensions in file
+      INTEGER :: iilen         ! Length of netCDF attributes
+      INTEGER :: itype         ! Typeof netCDF attributes
+      REAL(fbdp) :: zsca       ! Scale factor
+      REAL(fbdp) :: zfill      ! Fill value
+      CHARACTER(len=3) ::  cmission      ! Mission global attribute
+      INTEGER :: itracks       ! Maximum number of passes in file
+      INTEGER :: icycles       ! Maximum number of cycles for each pass
+      INTEGER :: idata         ! Number of data per parameter in current file
+      REAL(fbdp) :: zdeltat    ! Time gap getween two measurements in seconds
+      INTEGER, DIMENSION(:), POINTER :: & 
+         & iptracks,     &  ! List of passes contained in current file
+         & ipnbpoints,   &  ! Number of points per pass
+         & ipdataindexes    ! Index of data in theoretical profile
+      INTEGER, DIMENSION(:,:), POINTER :: & 
+         & ipcycles         ! List of cycles per pass
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zphi,   &        ! Latitudes
+         & zlam             ! Longitudes
+      REAL(fbdp), DIMENSION(:,:), POINTER :: &
+         & zbegindates      ! Date of point with index 0
+      REAL(fbdp) :: zbeginmiss    ! Missing data for dates
+      REAL(fbsp), DIMENSION(:,:), POINTER :: &
+         & zsla             ! SLA data
+      REAL(fbdp), DIMENSION(:), POINTER :: &
+         & zjuld            ! Julian date
+      LOGICAL, DIMENSION(:), POINTER :: &
+         & llskip           ! Skip observation
+      CHARACTER(len=14) :: cdjuldref    ! Julian data reference
+      INTEGER :: imission   ! Mission number converted from Mission global 
+                            ! netCDF atttribute.
+      CHARACTER(len=255) :: ctmp
+      INTEGER :: iobs
+      INTEGER :: jl
+      INTEGER :: jm
+      INTEGER :: jj
+      INTEGER :: ji
+      INTEGER :: jk
+      INTEGER :: jobs
+      INTEGER :: jcycle
+
+      ! Open the file
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, i_file_id ), &
+         &         cpname, __LINE__ )
+
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Tracks', i_tracks_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_tracks_id, &
+         &                                 len = itracks ),  &
+         &         cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Cycles', i_cycles_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_cycles_id, &
+         &                                 len = icycles ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'Data', i_data_id ),  &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_data_id, &
+         &                                 len = idata ),  &
+         &         cpname, __LINE__ )
+
+      ! Allocate memory for input data
+
+      ALLOCATE( &
+         & iptracks     ( itracks          ), &  
+         & ipnbpoints   ( itracks          ), &  
+         & ipcycles     ( icycles, itracks ), &
+         & zphi         ( idata            ), &   
+         & zlam         ( idata            ), &  
+         & zbegindates  ( icycles, itracks ), &
+         & ipdataindexes( idata            ), & 
+         & zsla         ( icycles, idata   ), &
+         & zjuld        ( idata*icycles    ), &
+         & llskip       ( idata*icycles    )  &
+         & )
+
+      ! Get time gap getween two measurements in seconds
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DeltaT', i_var_id ), & 
+         &         cpname, __LINE__ )
+      CALL chkdim( i_file_id, i_var_id, 0, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zdeltat), &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zdeltat = zsca * zdeltat
+         
+      ! Get List of passes contained in current file      
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Tracks', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, iptracks), &
+         &         cpname, __LINE__ )
+      
+      ! Get Number of points per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'NbPoints', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = itracks
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipnbpoints),&
+         &         cpname, __LINE__ )
+      
+      ! Get list of cycles per pass
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Cycles', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipcycles),   &
+         &         cpname, __LINE__ )
+
+      ! Get longitudes
+
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Longitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zlam),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                         == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zlam(:) = zsca * zlam(:)
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'Latitudes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zphi),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     'scale_factor',zsca), cpname,  __LINE__)
+      ENDIF
+      zphi(:) = zsca * zphi(:)
+      
+      ! Get date of point with index 0
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'BeginDates', i_var_id ), & 
+         &        cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = itracks
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zbegindates), &
+         &         cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, &
+         &                                 'units', len = iilen,  &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 255 )) THEN
+         CALL fatal_error('Error decoding BeginDates unit', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, 'units', &
+         &                       ctmp ), cpname, __LINE__ )
+      jl=1
+      DO jm = 1, LEN(TRIM(ctmp))
+         IF ((ctmp(jm:jm)>='0').AND.(ctmp(jm:jm)<='9')) THEN
+            cdjuldref(jl:jl) = ctmp(jm:jm)
+            jl=jl+1
+         ENDIF
+         IF (jl>14) EXIT
+      END DO
+      CALL chkerr( nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue', &
+         &                                  xtype = itype), cpname, __LINE__ )
+      IF ( itype /= NF90_DOUBLE ) THEN
+         CALL fatal_error('Error decoding BeginDates missing data', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, i_var_id, '_FillValue', &
+         &                       zbeginmiss ), cpname, __LINE__ )
+
+      ! Get indices of data in theoretical profile
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'DataIndexes', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = idata
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, ipdataindexes),   &
+         &       cpname, __LINE__ )
+      
+      ! Get SLA data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'SLA', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = icycles
+      idims(2) = idata
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zsla),   &
+         &         cpname, __LINE__ )
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, 'scale_factor') &
+         &                        == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       'scale_factor',zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, '_FillValue') &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     '_FillValue',zfill), cpname,  __LINE__ )
+      ENDIF
+      WHERE(zsla(:,:) /=  zfill)
+         zsla(:,:) = zsca * zsla(:,:)
+      ELSEWHERE
+         zsla(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get the global Mission netCDF attribute
+      
+      cmission='   '
+      CALL chkerr( nf90_inquire_attribute( i_file_id, nf90_global, &
+         &                                 'Mission', len = iilen,  &
+         &                                 xtype = itype), cpname, __LINE__ )
+      IF (( itype /= NF90_CHAR ) .OR. ( iilen > 3 )) THEN
+         CALL fatal_error('Error decoding Mission global attribute', __LINE__ )
+      ENDIF
+      CALL chkerr( nf90_get_att( i_file_id, nf90_global, 'Mission', &
+         &                       cmission ), cpname, __LINE__ )
+      
+      ! Convert it to an integer
+      imission = 0
+      DO jm = 1, imaxmissions
+         IF (cmission==cmissions(jm)) THEN
+            imission = jm
+            EXIT
+         ENDIF
+      END DO
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Compute Julian dates for all observations
+      
+      jm = 0
+      jl = 0
+      DO jj = 1, itracks
+         DO ji = 1, ipnbpoints(jj)
+            jl = jl + 1
+            DO jk = 1, icycles
+               jm = jm + 1
+               IF (zbegindates(jk,jj)==zbeginmiss) THEN
+                  llskip(jm) = .TRUE.
+                  zjuld(jm)  = fbrmdi
+               ELSE
+                  llskip(jm) = .FALSE.
+                  zjuld(jm)  = zbegindates(jk,jj) + &
+                     &         (ipdataindexes(jl) * zdeltat / 86400._wp )
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Get rid of missing data
+
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (zsla(jcycle,jobs) == fbrmdi) llskip(jm) = .TRUE.
+         END DO
+      END DO
+      
+      ! Allocate obfbdata
+
+      iobs = COUNT( .NOT.llskip(:) )
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SLA'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = cdjuldref
+      iobs = 0
+      jm = 0
+      DO jobs = 1, idata
+         DO jcycle = 1, icycles
+            jm = jm + 1
+            IF (llskip(jm)) CYCLE
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A3,A5)') cmissions(imission), '     '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') imission
+            ! Real values
+            inpfile%plam(iobs)         = zlam(jobs)
+            inpfile%pphi(iobs)         = zphi(jobs)
+            inpfile%pob(1,iobs,1)      = zsla(jcycle,jobs)
+            inpfile%ptim(iobs)         = zjuld(jm)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            inpfile%ioqc(iobs)      = 1
+            inpfile%ivqc(iobs,1)    = 1
+            inpfile%ivlqc(1,iobs,1) = 1
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+
+      ! Deallocate memory for input data
+
+      DEALLOCATE( &
+         & iptracks,      &
+         & ipnbpoints,    &
+         & ipcycles,      &
+         & zphi,          &
+         & zlam,          &  
+         & zbegindates,   &
+         & ipdataindexes, &
+         & zsla,          &
+         & zjuld,         &
+         & llskip         &
+         & )
+
+   END SUBROUTINE read_avisofile
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssla_types.h90	(revision 3437)
@@ -0,0 +1,9 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   INTEGER, PARAMETER :: imaxmissions=8
+   CHARACTER(len=3) :: cmissions(0:imaxmissions) = &
+      & (/ 'XXX', 'E1 ', 'E2 ', 'TP ', 'TPM', 'G2 ', 'J1 ', 'EN ', 'J2 ' /)
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obssst_io.h90	(revision 3437)
@@ -0,0 +1,286 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_ghrsst( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_ghrsst **
+      !!
+      !! ** Purpose : Read from file the GHRSST observations.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! References : 
+      !!
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original based on old versions
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      CHARACTER(LEN=12),PARAMETER :: cpname = 'read_ghrsst'
+      INTEGER :: i_file_id        ! netcdf IDS
+      INTEGER :: i_time_id
+      INTEGER :: i_ni_id
+      INTEGER :: i_data_id
+      INTEGER :: i_var_id
+      INTEGER :: i_data           ! Number of data per parameter in current file
+      INTEGER :: i_time           ! Number of reference times in file
+      INTEGER, DIMENSION(:), POINTER :: &
+         & i_reftime        ! Reference time in file in seconds since 1/1/1981.
+      INTEGER, DIMENSION(:,:), POINTER :: &
+         & i_dtime, &       ! Offset in seconds since reference time
+         & i_qc,    &       ! Quality control flag.
+         & i_type           ! Type of SST measurement.            
+      REAL(wp), DIMENSION(:), POINTER :: &
+         & z_phi,   &       ! Latitudes
+         & z_lam            ! Longitudes
+      REAL(wp), DIMENSION(:,:), POINTER :: &
+         & z_sst            ! SST data     
+      INTEGER, PARAMETER :: imaxdim = 2      ! Assumed maximum for no. dims. in file
+      INTEGER, DIMENSION(2) :: idims         ! Dimensions in file
+      INTEGER :: iilen            ! Length of netCDF attributes
+      INTEGER :: itype            ! Typeof netCDF attributes
+      REAL(KIND=wp) :: zsca           ! Scale factor
+      REAL(KIND=wp) :: zoff           ! Offset for data in netcdf file
+      REAL(KIND=wp) :: z_offset       ! Offset for time conversion
+      REAL(KIND=wp) :: zfill          ! Fill value in netcdf file
+      CHARACTER (len=33) :: creftime  ! Reference time of file
+      INTEGER :: i_refyear            ! Integer version of reference time
+      INTEGER :: i_refmonth
+      INTEGER :: i_refday
+      INTEGER :: i_refhour
+      INTEGER :: i_refmin
+      INTEGER :: i_refsec
+      INTEGER :: ichunk
+      INTEGER :: jtim
+      INTEGER :: jobs
+      INTEGER :: iobs
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+         &                i_file_id, chunksize=ichunk), cpname, __LINE__ )
+      
+      ! Get the netCDF dimensions
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_time_id, &
+         &                              len = i_time ),  &
+         &      cpname, __LINE__ )
+      
+      CALL chkerr( nf90_inq_dimid( i_file_id, 'ni', i_ni_id ),  &
+         &       cpname, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_ni_id, &
+         &                              len = i_data ),  &
+         &      cpname, __LINE__ )
+      
+      
+      ! Allocate NetCDF variables
+      
+      ALLOCATE( &
+         & i_reftime    ( i_time                 ), &
+         & i_dtime      ( i_data,i_time  ), &      
+         & i_qc         ( i_data,i_time  ), & 
+         & i_type       ( i_data,i_time  ), &     
+         & z_phi        ( i_data                 ), &   
+         & z_lam        ( i_data                 ), &  
+         & z_sst        ( i_data,i_time  )  &
+         & )
+      
+      ! Get reference time of file which is in seconds since 1981/1/1 00:00. 
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'time', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_time
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_reftime),&
+         &       cpname, __LINE__ )
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "units") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "units",creftime), cpname,  __LINE__ )
+      ELSE
+         creftime = "seconds since 1981-01-01 00:00:00"
+      ENDIF
+      READ(creftime(15:18),*)i_refyear
+      READ(creftime(20:21),*)i_refmonth
+      READ(creftime(23:24),*)i_refday
+      READ(creftime(26:27),*)i_refhour
+      READ(creftime(29:30),*)i_refmin
+      READ(creftime(32:33),*)i_refsec
+      !Work out offset in days between reference time and 1/1/1950.
+      CALL greg2jul( i_refsec, i_refmin, i_refhour, i_refday, &
+         &           i_refmonth, i_refyear, z_offset)
+      
+      ! Get list of times for each ob in seconds relative to reference time
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sst_dtime', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_dtime),&
+         &       cpname, __LINE__ )
+      zsca = 1.0      
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname,  __LINE__ )
+      ENDIF
+      zoff = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "add_offset") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "add_offset",zoff), cpname,  __LINE__ )
+      ENDIF
+      i_dtime(:,:) = NINT((zsca * FLOAT(i_dtime(:,:))) &
+         &                 + zoff)
+      
+      ! Get longitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lon', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_lam),   &
+         &         cpname, __LINE__ )
+      
+      ! Get latitudes
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'lat', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      CALL chkdim( i_file_id, i_var_id, 1, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_phi),   &
+         &         cpname, __LINE__ )
+      
+      ! Get SST data
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'sea_surface_temperature', &
+         &                         i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, z_sst), &
+         &       cpname, __LINE__ )
+      zoff = 0.
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                      == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                     "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zsca = 1.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "scale_factor") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "scale_factor",zsca), cpname, __LINE__ )
+      ENDIF
+      zfill = 0.0
+      IF (nf90_inquire_attribute( i_file_id, i_var_id, "_FillValue") &
+         &                       == nf90_noerr) THEN
+         CALL chkerr( nf90_get_att( i_file_id, i_var_id, &
+            &                       "_FillValue",zfill), cpname, __LINE__ )
+      ENDIF
+      WHERE(z_sst(:,:) /=  zfill)
+         z_sst(:,:) = (zsca * z_sst(:,:)) + zoff
+      ELSEWHERE
+         z_sst(:,:) = fbrmdi
+      END WHERE
+      
+      ! Get QC flag
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'confidence_flag', i_var_id ), & 
+         &       cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_qc),   &
+            &       cpname, __LINE__ )
+      
+      ! Get SST obs type
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, 'data_source', i_var_id ), & 
+         &         cpname, __LINE__ )
+      idims(1) = i_data
+      idims(2) = i_time
+      CALL chkdim( i_file_id, i_var_id, 2, idims, cpname, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, i_type),   &
+         &       cpname, __LINE__ )
+      
+      ! Close the file
+      
+      CALL chkerr( nf90_close( i_file_id ), cpname, __LINE__ )
+
+      ! Fill the obfbdata structure
+
+      ! Allocate obfbdata
+      
+      iobs = i_data * i_time
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 1, iobs, 1, 0, 0, ldgrid )
+      inpfile%cname(1) = 'SST'
+
+      ! Fill the obfbdata structure from input data
+
+      inpfile%cdjuldref = "19500101000000"
+      iobs = 0
+      DO jtim = 1, i_time
+         DO jobs = 1, i_data
+            iobs = iobs + 1
+            ! Characters
+            WRITE(inpfile%cdwmo(iobs),'(A6,A2)') 'ghrsst','  '
+            WRITE(inpfile%cdtyp(iobs),'(I4)') i_type(jobs,jtim)
+            ! Real values
+            inpfile%plam(iobs)         = z_lam(jobs)
+            inpfile%pphi(iobs)         = z_phi(jobs)
+            inpfile%pob(1,iobs,1)      = z_sst(jobs,jtim)
+            inpfile%ptim(iobs)         = &
+               & REAL(i_reftime(jtim))/(60.*60.*24.) + &
+               & z_offset + REAL(i_dtime(jobs,jtim))/(60.*60.*24.)
+            inpfile%pdep(1,iobs)       = 0.0
+            ! Integers
+            inpfile%kindex(iobs)       = iobs
+            IF ( z_sst(jobs,jtim) == fbrmdi ) THEN
+               inpfile%ioqc(iobs)      = 4
+               inpfile%ivqc(iobs,1)    = 4 
+               inpfile%ivlqc(1,iobs,1) = 4
+            ELSE 
+               inpfile%ioqc(iobs)      = i_qc(jobs,jtim)
+               inpfile%ivqc(iobs,1)    = i_qc(jobs,jtim)
+               inpfile%ivlqc(1,iobs,1) = 1
+            ENDIF
+            inpfile%ipqc(iobs)         = 0 
+            inpfile%ipqcf(:,iobs)      = 0
+            inpfile%itqc(iobs)         = 0
+            inpfile%itqcf(:,iobs)      = 0
+            inpfile%ivqcf(:,iobs,1)    = 0
+            inpfile%ioqcf(:,iobs)      = 0
+            inpfile%idqc(1,iobs)       = 0
+            inpfile%idqcf(1,1,iobs)    = 0
+            inpfile%ivlqcf(:,1,iobs,1) = 0
+         END DO
+      END DO
+
+      DEALLOCATE( &
+         & i_reftime, &
+         & i_dtime,   &
+         & i_qc,      &
+         & i_type,    &
+         & z_phi,     &
+         & z_lam,     &
+         & z_sst      &
+         & )
+
+   END SUBROUTINE read_ghrsst
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/obsvel_io.h90	(revision 3437)
@@ -0,0 +1,360 @@
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE read_taondbc( cdfilename, inpfile, kunit, ldwp, ldgrid )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE read_enactfile **
+      !!
+      !! ** Purpose : Read from file the TAO data fro NDBC.
+      !!
+      !! ** Method  : The data file is a NetCDF file. 
+      !!
+      !! ** Action  :
+      !!
+      !! ** Reference : http://tao.noaa.gov/tao/data_deliv/deliv_ndbc.shtml
+      !! History : 
+      !!          ! 09-01 (K. Mogensen) Original version.
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdfilename ! Input filename
+      TYPE(obfbdata)   :: inpfile    ! Output obfbdata structure
+      INTEGER          :: kunit      ! Unit for output
+      LOGICAL          :: ldwp       ! Print info
+      LOGICAL          :: ldgrid     ! Save grid info in data structure
+      !! * Local declarations
+      INTEGER :: iobs                ! Number of observations
+      INTEGER :: ilev                ! Number of levels
+      INTEGER :: ilat                ! Number of latitudes
+      INTEGER :: ilon                ! Number of longtudes
+      INTEGER :: itim                ! Number of obs. times
+      INTEGER :: i_file_id
+      INTEGER :: i_dimid_id
+      INTEGER :: i_phi_id
+      INTEGER :: i_lam_id
+      INTEGER :: i_depth_id
+      INTEGER :: i_var_id
+      INTEGER :: i_time_id
+      INTEGER :: i_time2_id
+      INTEGER :: i_qc_var_id
+      CHARACTER(LEN=40) :: cl_fld_lam
+      CHARACTER(LEN=40) :: cl_fld_phi
+      CHARACTER(LEN=40) :: cl_fld_depth
+      CHARACTER(LEN=40) :: cl_fld_var_u
+      CHARACTER(LEN=40) :: cl_fld_var_v
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv1
+      CHARACTER(LEN=40) :: cl_fld_var_qc_uv2
+      CHARACTER(LEN=40) :: cl_fld_time
+      CHARACTER(LEN=40) :: cl_fld_time2
+      INTEGER :: ja
+      INTEGER :: jo
+      INTEGER :: jk
+      INTEGER :: jt
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: &
+         & zv,     &
+         & zu,     &
+         & zuv1qc, &
+         & zuv2qc
+      REAL(wp), ALLOCATABLE, DIMENSION(:) :: &
+         & zdep, &
+         & zlat, &
+         & zlon, &
+         & zjuld
+      REAL(wp) :: zl
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: &
+         & itime, &
+         & itime2
+      CHARACTER(LEN=50) :: cdjulref
+      CHARACTER(LEN=12), PARAMETER :: cl_name = 'read_taondbc'
+      CHARACTER(len=1) :: cns, cew
+
+      !-----------------------------------------------------------------------
+      ! Initialization
+      !-----------------------------------------------------------------------
+      cl_fld_lam                 = 'lon'
+      cl_fld_phi                 = 'lat'
+      cl_fld_depth               = 'depth'
+      cl_fld_time                = 'time'
+      cl_fld_time2               = 'time2'
+
+      !-----------------------------------------------------------------------
+      ! Open file
+      !-----------------------------------------------------------------------
+
+      CALL chkerr( nf90_open( TRIM( cdfilename ), nf90_nowrite, &
+            &      i_file_id ),           cl_name, __LINE__ )
+
+      !-----------------------------------------------------------------------
+      ! Read the heading of the file
+      !-----------------------------------------------------------------------
+      IF(ldwp) WRITE(kunit,*)
+      IF(ldwp) WRITE(kunit,*) ' read_taondbc :' 
+      IF(ldwp) WRITE(kunit,*) ' ~~~~~~~~~~~~'
+      
+      !---------------------------------------------------------------------
+      ! Read the number of observations and of levels to allocate array
+      !---------------------------------------------------------------------
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'time', i_dimid_id ),        &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = itim ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'depth', i_dimid_id ),       &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilev ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lat', i_dimid_id ),           &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilat ),    &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inq_dimid        ( i_file_id, 'lon', i_dimid_id ),         &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_inquire_dimension( i_file_id, i_dimid_id, len = ilon ),    &
+         &         cl_name, __LINE__ ) 
+
+      iobs = itim * ilat * ilon
+      IF(ldwp)WRITE(kunit,*) '         No. of data records = ', iobs
+      IF(ldwp)WRITE(kunit,*) '         No. of levels       = ', ilev
+      IF(ldwp)WRITE(kunit,*) 
+
+      !---------------------------------------------------------------------
+      ! Allocate arrays
+      !---------------------------------------------------------------------
+
+      CALL init_obfbdata( inpfile )
+      CALL alloc_obfbdata( inpfile, 2, iobs, ilev, 0, 0, ldgrid )
+      inpfile%cname(1) = 'UVEL'
+      inpfile%cname(2) = 'VVEL'
+      inpfile%coblong(1) = 'Zonal current'
+      inpfile%coblong(2) = 'Meridional current'
+      inpfile%cobunit(1) = 'Meters per second'
+      inpfile%cobunit(2) = 'Meters per second'
+
+      ALLOCATE( &
+         & zu(ilon,ilat,ilev,itim),     &
+         & zv(ilon,ilat,ilev,itim),     &
+         & zdep(ilev),                  &
+         & zuv1qc(ilon,ilat,ilev,itim), &
+         & zuv2qc(ilon,ilat,ilev,itim), &
+         & itime(itim),                 &
+         & itime2(itim),                &
+         & zlat(ilat),                  &
+         & zlon(ilon),                  &
+         & zjuld(itim)                  &
+         & )
+
+      !---------------------------------------------------------------------
+      ! Read the time/position variables 
+      !---------------------------------------------------------------------
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time, i_time_id ),                               &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time_id, itime ),                                     &
+         &         cl_name, __LINE__ )
+
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_time2, i_time2_id ),                             &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_time2_id, itime2 ),                                   &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_depth, i_depth_id ),                             &
+            &         cl_name, __LINE__ )         
+      CALL chkerr( nf90_get_var  ( i_file_id, i_depth_id, zdep ),                                     &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_phi, i_phi_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_phi_id, zlat ),                                       &
+         &         cl_name, __LINE__ )
+      
+      CALL chkerr( nf90_inq_varid( i_file_id, cl_fld_lam, i_lam_id ),                                 &
+         &         cl_name, __LINE__ )
+      CALL chkerr( nf90_get_var  ( i_file_id, i_lam_id, zlon ),                                       &
+         &         cl_name, __LINE__ )
+      
+      !---------------------------------------------------------------------
+      ! Read the variables
+      !---------------------------------------------------------------------
+
+      ! ADCP format assumed
+      cl_fld_var_u = 'u_1205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_u = 'U_320'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_u, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zu ),                                         &
+         &         cl_name, __LINE__ )
+      
+      ! ADCP format assumed
+      cl_fld_var_v = 'v_1206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_v = 'V_321'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_v, i_var_id ) /= nf90_noerr ) THEN
+            CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_var_id, zv ),                                         &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Read the QC attributes
+      !---------------------------------------------------------------------
+      
+      ! ADCP format assumed
+      cl_fld_var_qc_uv1 = 'QU_5205'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv1 = 'QCS_5300'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv1 = 'QCU_5320'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv1, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv1qc),                                   &
+         &         cl_name, __LINE__ )
+
+      ! ADCP format assumed
+      cl_fld_var_qc_uv2 = 'QV_5206'
+      IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+         ! Try again with current meter format
+         cl_fld_var_qc_uv2 = 'QCD_5310'
+         IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+            ! Try again with high freq. current meter format
+            cl_fld_var_qc_uv2 = 'QCV_5321'
+            IF ( nf90_inq_varid( i_file_id, cl_fld_var_qc_uv2, i_qc_var_id ) /= nf90_noerr ) THEN
+               CALL fatal_error( 'Unknown format in read_taondbc', __LINE__ )
+            ENDIF
+         ENDIF
+      ENDIF
+      CALL chkerr( nf90_get_var  ( i_file_id, i_qc_var_id, zuv2qc),                                   &
+         &         cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Close file
+      !---------------------------------------------------------------------
+
+      CALL chkerr( nf90_close( i_file_id ),           cl_name, __LINE__ )
+
+      !---------------------------------------------------------------------
+      ! Convert to to 19500101 based Julian date
+      !---------------------------------------------------------------------
+      DO jt = 1, itim
+         zjuld(jt) = REAL(itime(jt),wp) + REAL(itime2(jt),wp)/86400000.0_wp &
+            &           - 2433283.0_wp
+      END DO
+      inpfile%cdjuldref = '19500101000000'
+
+      !---------------------------------------------------------------------
+      ! Copy info to obfbdata structure
+      !---------------------------------------------------------------------
+
+      iobs = 0
+      DO jt = 1, itim
+         DO ja = 1, ilat
+            DO jo = 1, ilon
+               iobs = iobs + 1
+               zl = zlon(jo)
+               IF ( zl > 180.0_wp ) zl = zl - 360.0_wp
+               IF ( zl < 0 ) THEN
+                  cew = 'w'
+               ELSE
+                  cew = 'e'
+               ENDIF
+               IF ( zlat(jo) < 0 ) THEN
+                  cns = 's'
+               ELSE
+                  cns = 'n'
+               ENDIF
+               WRITE(inpfile%cdwmo(iobs),'(A1,I2.2,A1,I3.3)') &
+                  & cns, ABS(NINT(zlat(ja))), cew, ABS(NINT(zl))
+               DO jk = 1, ilev
+                  inpfile%pob(jk,iobs,1)     = zu(jo,ja,jk,jt)
+                  inpfile%pob(jk,iobs,2)     = zv(jo,ja,jk,jt)
+                  inpfile%pdep(jk,iobs)      = zdep(jk)
+                  inpfile%ivlqc(jk,iobs,1:2) = INT( MAX( zuv1qc(jo,ja,jk,jt), zuv2qc(jo,ja,jk,jt) ) )
+               END DO
+               inpfile%plam(iobs) = zlon(jo)
+               inpfile%pphi(iobs) = zlat(ja)
+               inpfile%ptim(iobs) = zjuld(jt)
+            END DO
+         END DO
+      END DO
+
+      ! No position, time, depth and variable QC in input files
+      DO jo = 1, iobs
+         inpfile%ipqc(jo) = 1
+         inpfile%itqc(jo) = 1
+         inpfile%ivqc(jo,1:2) = 1
+         DO jk = 1, ilev
+            inpfile%idqc(jk,jo) = 1
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set the platform information
+      !---------------------------------------------------------------------
+      inpfile%cdtyp(:)=' 820'
+
+      !---------------------------------------------------------------------
+      ! Set QC flags for missing data and rescale to m/s
+      !---------------------------------------------------------------------
+
+      DO jo = 1, iobs
+         DO jk = 1, ilev
+            IF ( ( ABS(inpfile%pob(jk,jo,1)) > 10000.0_wp ) .OR. &
+               & ( ABS(inpfile%pob(jk,jo,2)) > 10000.0_wp ) ) THEN
+               inpfile%ivlqc(jk,jo,:) = 4
+               inpfile%pob(jk,jo,1) = fbrmdi
+               inpfile%pob(jk,jo,2) = fbrmdi
+            ELSE
+               inpfile%pob(jk,jo,1) = 0.01 * inpfile%pob(jk,jo,1)
+               inpfile%pob(jk,jo,2) = 0.01 * inpfile%pob(jk,jo,2)
+            ENDIF
+         END DO
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Set file indexes
+      !---------------------------------------------------------------------
+
+      DO jo = 1, inpfile%nobs
+         inpfile%kindex(jo) = jo
+      END DO
+
+      !---------------------------------------------------------------------
+      ! Initialize flags since they are not in the TAO input files
+      !---------------------------------------------------------------------
+
+      inpfile%ioqcf(:,:)      = 0
+      inpfile%ipqcf(:,:)      = 0
+      inpfile%itqcf(:,:)      = 0
+      inpfile%idqcf(:,:,:)    = 0
+      inpfile%ivqcf(:,:,:)    = 0
+      inpfile%ivlqcf(:,:,:,:) = 0
+
+      !---------------------------------------------------------------------
+      ! Deallocate data
+      !---------------------------------------------------------------------
+      DEALLOCATE( &
+         & zu,     &
+         & zv,     &
+         & zdep,   &
+         & zuv1qc, &
+         & zuv2qc, &
+         & itime,  &
+         & itime2, &
+         & zlat,   &
+         & zlon,   &
+         & zjuld   &
+         & )
+
+   END SUBROUTINE read_taondbc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/OBS/str_c_to_for.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90	(revision 3437)
@@ -0,0 +1,223 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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
+
+   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) ::   zzero     = 0.e0   ! constant values
+   REAL(wp) ::   zone      = 1.e0   !    "       "
+
+   REAL(wp) ::   c1     = 0.05    ! constants values
+   REAL(wp) ::   c2     = 0.10    !    "        "
+   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude
+
+   !                               !!* namelist namsbc_alb
+   REAL(wp) ::   rn_cloud  = 0.06   !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984)
+#if defined key_lim3
+   REAL(wp) ::   rn_albice = 0.53   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
+#else
+   REAL(wp) ::   rn_albice = 0.50   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
+#endif
+   REAL(wp) ::   rn_alphd  = 0.80   !  coefficients for linear interpolation used to compute
+   REAL(wp) ::   rn_alphdi = 0.72   !  albedo between two extremes values (Pyane, 1972)
+   REAL(wp) ::   rn_alphc  = 0.65   ! 
+
+   !!----------------------------------------------------------------------
+   !! 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 
+      !!                as well as the ocean one
+      !!       
+      !! ** Method  : - Computation of the albedo of snow or ice (choose the 
+      !!                rignt one by a large number of tests
+      !!              - Computation of the albedo of the ocean
+      !!
+      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250.
+      !!----------------------------------------------------------------------
+      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) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting
+      REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing
+      REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow
+      REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow
+      REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow)
+      REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow)
+      REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1
+      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2
+      !!
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness
+      !!---------------------------------------------------------------------
+      
+      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
+
+      CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth )
+
+      IF( albd_init == 0 )   CALL albedo_init      ! initialization 
+
+      !---------------------------
+      !  Computation of  zficeth
+      !---------------------------
+      ! ice free of snow and melts
+      WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalbfz(:,:,:) = rn_albice
+      ELSE WHERE                                              ;   zalbfz(:,:,:) = rn_alphdi
+      END  WHERE
+
+      WHERE     ( 1.5  < ph_ice                     )  ;  zficeth = zalbfz
+      ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 )
+      ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              &
+         &                                                                 - 0.8608 * ph_ice * ph_ice     &
+         &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice
+      ELSE WHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice
+      END WHERE
+
+!!gm old code
+!      DO jl = 1, ijpl
+!         DO jj = 1, jpj
+!            DO ji = 1, jpi
+!               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN
+!                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl)
+!               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN
+!                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 )
+!               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN
+!                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               &
+!                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 &
+!                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl)
+!               ELSE
+!                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl) 
+!               ENDIF
+!            END DO
+!         END DO
+!      END DO
+!!gm end old code
+      
+      !----------------------------------------------- 
+      !    Computation of the snow/ice albedo system 
+      !-------------------------- ---------------------
+      
+      !    Albedo of snow-ice for clear sky.
+      !-----------------------------------------------    
+      DO jl = 1, ijpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !  Case of ice covered by snow.             
+               !                                        !  freezing snow        
+               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) )
+               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                             &
+                  &                           + ph_snw(ji,jj,jl) * ( rn_alphd - zficeth(ji,jj,jl) ) / c1  )   &
+                  &     +         zihsc1   * rn_alphd  
+               !                                        !  melting snow                
+               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) )
+               zalbpsnm = ( 1.0 - zihsc2 ) * ( rn_albice + ph_snw(ji,jj,jl) * ( rn_alphc - rn_albice ) / c2 )   &
+                  &     +         zihsc2   *   rn_alphc 
+               !
+               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )   
+               zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf
+            
+               !  Case of ice free of snow.
+               zalbpic  = zficeth(ji,jj,jl) 
+            
+               ! albedo of the system   
+               zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) )
+               pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
+            END DO
+         END DO
+      END DO
+      
+      !    Albedo of snow-ice for overcast sky.
+      !----------------------------------------------  
+      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction
+      !
+      CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth )
+      !
+   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   ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982 
+      pa_oce_cs(:,:) = zcoef               
+      pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972
+      !
+   END SUBROUTINE albedo_oce
+
+
+   SUBROUTINE albedo_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE albedo_init  ***
+      !!
+      !! ** Purpose :   initializations for the albedo parameters
+      !!
+      !! ** Method  :   Read the namelist namsbc_alb
+      !!----------------------------------------------------------------------
+      NAMELIST/namsbc_alb/ rn_cloud, rn_albice, rn_alphd, rn_alphdi, rn_alphc
+      !!----------------------------------------------------------------------
+      !
+      albd_init = 1                     ! indicate that the initialization has been done
+      !
+      REWIND( numnam )                  ! Read Namelist namsbc_alb : albedo parameters
+      READ  ( numnam, 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,*) '      correction for snow and ice albedo                  rn_cloud  = ', rn_cloud
+         WRITE(numout,*) '      albedo of melting ice in the arctic and antarctic   rn_albice = ', rn_albice
+         WRITE(numout,*) '      coefficients for linear                             rn_alphd  = ', rn_alphd
+         WRITE(numout,*) '      interpolation used to compute albedo                rn_alphdi = ', rn_alphdi
+         WRITE(numout,*) '      between two extremes values (Pyane, 1972)           rn_alphc  = ', rn_alphc
+      ENDIF
+      !
+   END SUBROUTINE albedo_init
+
+   !!======================================================================
+END MODULE albedo
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90	(revision 3437)
@@ -0,0 +1,363 @@
+MODULE cpl_oasis3
+   !!======================================================================
+   !!                    ***  MODULE cpl_oasis  ***
+   !! Coupled O/A : coupled ocean-atmosphere case using OASIS3 V. prism_2_4
+   !!               special case: NEMO OPA/LIM coupled to ECHAM5
+   !!=====================================================================
+   !! History :   
+   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
+   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
+   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
+   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
+   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
+   !!   " "  !  06-01  (W. Park) modification of physical part
+   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
+   !!----------------------------------------------------------------------
+#if defined key_oasis3
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
+   !!----------------------------------------------------------------------
+   !!   cpl_prism_init     : initialization of coupled mode communication
+   !!   cpl_prism_define   : definition of grid and fields
+   !!   cpl_prism_snd     : snd out fields in coupled mode
+   !!   cpl_prism_rcv     : receive fields in coupled mode
+   !!   cpl_prism_finalize : finalize the coupled mode communication
+   !!----------------------------------------------------------------------
+   USE mod_prism_proto              ! OASIS3 prism module
+   USE mod_prism_def_partition_proto! OASIS3 prism module for partitioning
+   USE mod_prism_put_proto          ! OASIS3 prism module for snding
+   USE mod_prism_get_proto          ! OASIS3 prism module for receiving
+   USE mod_comprism_proto           ! OASIS3 prism module to get coupling frequency
+   USE par_oce                      ! ocean parameters
+   USE dom_oce                      ! ocean space and time domain
+   USE in_out_manager               ! I/O manager
+   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link)
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   cpl_prism_init
+   PUBLIC   cpl_prism_define
+   PUBLIC   cpl_prism_snd
+   PUBLIC   cpl_prism_rcv
+   PUBLIC   cpl_prism_freq
+   PUBLIC   cpl_prism_finalize
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_cpl = .TRUE.   !: coupled flag
+   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 prism_init_comp
+   INTEGER                    ::   nerror            ! return error code
+
+   INTEGER, PARAMETER ::   nmaxfld=40    ! Maximum number of coupling fields
+   
+   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information
+      LOGICAL               ::   laction   ! To be coupled or not
+      CHARACTER(len = 8)    ::   clname    ! Name of the coupling field   
+      CHARACTER(len = 1)    ::   clgrid    ! Grid type  
+      REAL(wp)              ::   nsgn      ! Control of the sign change
+      INTEGER, DIMENSION(9) ::   nid       ! Id of the field (no more than 9 categories)
+      INTEGER               ::   nct       ! Number of categories in field
+   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_prism_init( kl_comm )
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_prism_init  ***
+      !!
+      !! ** Purpose :   Initialize coupled mode communication for ocean
+      !!    exchange between AGCM, OGCM and COUPLER. (OASIS3 software)
+      !!
+      !! ** Method  :   OASIS3 MPI communication 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
+      !!--------------------------------------------------------------------
+
+      ! WARNING: No write in numout in this routine
+      !============================================
+
+      !------------------------------------------------------------------
+      ! 1st Initialize the PRISM system for the application
+      !------------------------------------------------------------------
+      CALL prism_init_comp_proto ( ncomp_id, 'oceanx', nerror )
+      IF ( nerror /= PRISM_Ok ) &
+         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp_proto')
+
+      !------------------------------------------------------------------
+      ! 3rd Get an MPI communicator for OPA local communication
+      !------------------------------------------------------------------
+
+      CALL prism_get_localcomm_proto ( kl_comm, nerror )
+      IF ( nerror /= PRISM_Ok ) &
+         CALL prism_abort_proto (ncomp_id, 'cpl_prism_init','Failure in prism_get_localcomm_proto' )
+      !
+   END SUBROUTINE cpl_prism_init
+
+
+   SUBROUTINE cpl_prism_define( krcv, ksnd )
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_prism_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 :: id_part
+      INTEGER :: paral(5)       ! OASIS3 box partition
+      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe
+      INTEGER :: ji,jc          ! local loop indicees
+      CHARACTER(LEN=8) :: zclname
+      !!--------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      !
+      ! ... 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 prism_abort_proto ( ncomp_id, 'cpl_prism_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 prism_def_partition_proto ( id_part, paral, nerror )
+      !
+      ! ... Announce send variables. 
+      !
+      DO ji = 1, ksnd
+         IF ( ssnd(ji)%laction ) THEN 
+            DO jc = 1, ssnd(ji)%nct
+               IF ( ssnd(ji)%nct .gt. 1 ) THEN
+                  WRITE(zclname,'( a7, i1)') ssnd(ji)%clname,jc
+               ELSE
+                  zclname=ssnd(ji)%clname
+               ENDIF
+               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_Out
+               CALL prism_def_var_proto (ssnd(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
+                    PRISM_Out, ishape, PRISM_REAL, nerror)
+               IF ( nerror /= PRISM_Ok ) THEN
+                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
+                  CALL prism_abort_proto ( ssnd(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      DO ji = 1, krcv
+         IF ( srcv(ji)%laction ) THEN 
+            DO jc = 1, srcv(ji)%nct
+               IF ( srcv(ji)%nct .gt. 1 ) THEN
+                  WRITE(zclname,'( a7, i1)') srcv(ji)%clname,jc
+               ELSE
+                  zclname=srcv(ji)%clname
+               ENDIF
+               WRITE(numout,*) "Define",ji,jc,zclname," for",PRISM_In
+               CALL prism_def_var_proto ( srcv(ji)%nid(jc), zclname, id_part, (/ 2, 0/),   &
+                    &                      PRISM_In    , ishape   , PRISM_REAL, nerror)
+               IF ( nerror /= PRISM_Ok ) THEN
+                  WRITE(numout,*) 'Failed to define transient ', ji, TRIM(zclname)
+                  CALL prism_abort_proto ( srcv(ji)%nid(jc), 'cpl_prism_define', 'Failure in prism_def_var')
+               ENDIF
+            END DO
+         ENDIF
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      CALL prism_enddef_proto(nerror)
+      IF( nerror /= PRISM_Ok )   CALL prism_abort_proto ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
+      !
+   END SUBROUTINE cpl_prism_define
+   
+   
+   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_snd  ***
+      !!
+      !! ** Purpose : - At each coupling time-step,this routine sends fields
+      !!      like sst or ice cover to the coupler or remote application.
+      !!----------------------------------------------------------------------
+      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        ! local loop index
+      !!--------------------------------------------------------------------
+      !
+      ! snd data to OASIS3
+      !
+      DO jc = 1, ssnd(kid)%nct
+
+         CALL prism_put_proto ( ssnd(kid)%nid(jc), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo )
+         
+         IF ( ln_ctl ) THEN        
+            IF ( kinfo == PRISM_Sent     .OR. kinfo == PRISM_ToRest .OR.   &
+                 & kinfo == PRISM_SentOut  .OR. kinfo == PRISM_ToRestOut ) THEN
+               WRITE(numout,*) '****************'
+               WRITE(numout,*) 'prism_put_proto: Outgoing ', ssnd(kid)%clname
+               WRITE(numout,*) 'prism_put_proto: ivarid ', ssnd(kid)%nid(jc)
+               WRITE(numout,*) 'prism_put_proto:  kstep ', kstep
+               WRITE(numout,*) 'prism_put_proto:   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
+
+      ENDDO
+      !
+    END SUBROUTINE cpl_prism_snd
+
+
+   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_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
+      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument
+      !!
+      INTEGER                                   ::   jc        ! local loop index
+      LOGICAL                                   ::   llaction
+      !!--------------------------------------------------------------------
+      !
+      ! receive local data from OASIS3 on every process
+      !
+      DO jc = 1, srcv(kid)%nct
+
+         CALL prism_get_proto ( srcv(kid)%nid(jc), kstep, exfld, kinfo )         
+         
+         llaction = .false.
+         IF( kinfo == PRISM_Recvd   .OR. kinfo == PRISM_FromRest .OR.   &
+              kinfo == PRISM_RecvOut .OR. kinfo == PRISM_FromRestOut )   llaction = .TRUE.
+         
+         IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc)
+         
+         IF ( llaction ) THEN
+            
+            kinfo = OASIS_Rcv
+            pdata(nldi:nlei, nldj:nlej,jc) = exfld(:,:)
+            
+            !--- Fill the overlap areas and extra hallows (mpp)
+            !--- check periodicity conditions (all cases)
+            CALL lbc_lnk( pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )   
+            
+            IF ( ln_ctl ) THEN        
+               WRITE(numout,*) '****************'
+               WRITE(numout,*) 'prism_get_proto: Incoming ', srcv(kid)%clname
+               WRITE(numout,*) 'prism_get_proto: ivarid '  , srcv(kid)%nid(jc)
+               WRITE(numout,*) 'prism_get_proto:   kstep', kstep
+               WRITE(numout,*) 'prism_get_proto:   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
+            
+         ELSE
+            kinfo = OASIS_idle     
+         ENDIF
+         
+      ENDDO
+      !
+   END SUBROUTINE cpl_prism_rcv
+
+
+   INTEGER FUNCTION cpl_prism_freq( kid )  
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_freq  ***
+      !!
+      !! ** Purpose : - send back the coupling frequency for a particular field
+      !!----------------------------------------------------------------------
+      INTEGER,INTENT(in) ::   kid   ! variable index 
+      !!----------------------------------------------------------------------
+      cpl_prism_freq = ig_def_freq( kid )
+      !
+   END FUNCTION cpl_prism_freq
+
+
+   SUBROUTINE cpl_prism_finalize
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_finalize  ***
+      !!
+      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
+      !!      called explicitly before cpl_prism_init it will also close
+      !!      MPI communication.
+      !!----------------------------------------------------------------------
+      !
+      DEALLOCATE( exfld )
+      CALL prism_terminate_proto( nerror )         
+      !
+   END SUBROUTINE cpl_prism_finalize
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case          Dummy module          Forced Ocean/Atmosphere
+   !!----------------------------------------------------------------------
+   USE in_out_manager               ! I/O manager
+   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .FALSE.   !: coupled flag
+   PUBLIC cpl_prism_init
+   PUBLIC cpl_prism_finalize
+CONTAINS
+   SUBROUTINE cpl_prism_init (kl_comm) 
+      INTEGER, INTENT(out)   :: kl_comm       ! local communicator of the model
+      kl_comm = -1
+      WRITE(numout,*) 'cpl_prism_init: Error you sould not be there...'
+   END SUBROUTINE cpl_prism_init
+   SUBROUTINE cpl_prism_finalize
+      WRITE(numout,*) 'cpl_prism_finalize: Error you sould not be there...'
+   END SUBROUTINE cpl_prism_finalize
+#endif
+
+   !!=====================================================================
+END MODULE cpl_oasis3
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis4.F90	(revision 3437)
@@ -0,0 +1,481 @@
+MODULE cpl_oasis4
+   !!======================================================================
+   !!                    ***  MODULE cpl_oasis  ***
+   !! Coupled O/A : coupled ocean-atmosphere case using OASIS4
+   !!=====================================================================
+   !! History :   
+   !!   9.0  !  2004-06  (R. Redler, NEC Laboratories Europe, St Augustin, Germany) Original code
+   !!    -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Kiel, Germany) revision
+   !!    -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
+   !!    -   !  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
+   !!    -   !  2010-10  (E. Maisonnave and S. Masson) complete rewrite
+   !!----------------------------------------------------------------------
+#if defined key_oasis4
+   !!----------------------------------------------------------------------
+   !!   'key_oasis4'                    coupled Ocean/Atmosphere via OASIS4
+   !!----------------------------------------------------------------------
+   !!   cpl_prism_init     : initialization of coupled mode communication
+   !!   cpl_prism_define   : definition of grid and fields
+   !!   cpl_prism_snd      : snd out fields in coupled mode
+   !!   cpl_prism_rcv      : receive fields in coupled mode
+   !!   cpl_prism_update_time : update date sent to Oasis
+   !!   cpl_prism_finalize : finalize the coupled mode communication
+   !!----------------------------------------------------------------------
+   USE prism            ! OASIS4 prism module
+   USE par_oce          ! ocean parameters
+   USE dom_oce          ! ocean space and time domain
+   USE domwri           ! ocean space and time domain
+   USE in_out_manager   ! I/O manager
+   USE lbclnk           ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo         ! work arrays
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC cpl_prism_init
+   PUBLIC cpl_prism_define
+   PUBLIC cpl_prism_snd
+   PUBLIC cpl_prism_rcv
+   PUBLIC cpl_prism_update_time
+   PUBLIC cpl_prism_finalize
+   
+!   LOGICAL, PUBLIC, PARAMETER :: lk_cpl = .TRUE.    ! coupled flag
+   INTEGER                    :: ncomp_id           ! id returned by prism_init_comp
+   INTEGER                    :: nerror             ! return error code
+   INTEGER, PUBLIC            :: OASIS_Rcv  = 1     ! return code if received field
+   INTEGER, PUBLIC            :: OASIS_idle = 0     ! return code if nothing done by oasis
+
+   INTEGER, PARAMETER :: nmaxfld=40    ! Maximum number of coupling fields
+   
+   TYPE, PUBLIC ::   FLD_CPL            ! Type for coupling field information
+      LOGICAL            ::   laction   ! To be coupled or not
+      CHARACTER(len = 8) ::   clname    ! Name of the coupling field   
+      CHARACTER(len = 1) ::   clgrid    ! Grid type  
+      REAL(wp)           ::   nsgn      ! Control of the sign change
+      INTEGER            ::   nid       ! Id of the field
+   END TYPE FLD_CPL
+
+   TYPE(FLD_CPL), DIMENSION(nmaxfld), PUBLIC :: srcv, ssnd   ! Coupling fields
+
+   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: exfld  ! Temporary buffer for receiving
+
+   TYPE(PRISM_Time_struct), PUBLIC    :: date            ! date info for send operation
+   TYPE(PRISM_Time_struct), PUBLIC    :: date_bound(2)   ! date info for send operation
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE cpl_prism_init( kl_comm ) 
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_prism_init  ***
+      !!
+      !! ** Purpose :   Initialize coupled mode communication for ocean
+      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
+      !!
+      !! ** Method  :   OASIS4 MPI communication 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
+      !!--------------------------------------------------------------------
+      
+      CALL prism_init( 'nemo', nerror )
+
+      !------------------------------------------------------------------
+      ! 2nd Initialize the PRISM system for the component
+      !------------------------------------------------------------------
+      CALL prism_init_comp( ncomp_id, 'oceanx', nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_init_comp' )
+
+      !------------------------------------------------------------------
+      ! 3rd Get an MPI communicator fr OPA local communication
+      !------------------------------------------------------------------
+      CALL prism_get_localcomm( ncomp_id, kl_comm, nerror )
+      IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_init', 'Failure in prism_get_localcomm' )
+      !
+   END SUBROUTINE cpl_prism_init
+
+
+   SUBROUTINE cpl_prism_define( krcv, ksnd )
+      !!-------------------------------------------------------------------
+      !!             ***  ROUTINE cpl_prism_define  ***
+      !!
+      !! ** Purpose :   Define grid and field information for ocean
+      !!    exchange between AGCM, OGCM and COUPLER. (OASIS4 software)
+      !!
+      !! ** Method  :   OASIS4 MPI communication 
+      !!--------------------------------------------------------------------
+      INTEGER, INTENT(in) :: krcv, ksnd     ! Number of received and sent coupling fields
+      !
+      INTEGER, DIMENSION(4)      :: igrid     ! ids returned by prism_def_grid
+      INTEGER, DIMENSION(4)      :: iptid     ! ids returned by prism_set_points
+      INTEGER, DIMENSION(4)      :: imskid    ! ids returned by prism_set_mask
+      INTEGER, DIMENSION(4)      :: iishift   ! 
+      INTEGER, DIMENSION(4)      :: ijshift   ! 
+      INTEGER, DIMENSION(4)      :: iioff     ! 
+      INTEGER, DIMENSION(4)      :: ijoff     ! 
+      INTEGER, DIMENSION(4)      :: itmp      ! 
+      INTEGER, DIMENSION(1,3)    :: iextent   ! 
+      INTEGER, DIMENSION(1,3)    :: ioffset   ! 
+
+      INTEGER                    :: ishape(2,3)    ! shape of arrays passed to PSMILe
+      INTEGER                    :: data_type      ! data type of transients
+
+      LOGICAL                    :: new_points
+      LOGICAL                    :: new_mask
+      LOGICAL, ALLOCATABLE, SAVE :: llmask(:,:,:) ! jpi,jpj,1
+
+      INTEGER                    :: ji, jj, jg, jc   ! local loop indicees
+      INTEGER                    :: ii, ij           ! index
+      INTEGER, DIMENSION(1)      :: ind              ! index
+
+      CHARACTER(len=32)          :: clpt_name     ! name of the grid points
+      CHARACTER(len=7)           :: cltxt 
+      CHARACTER(len=1), DIMENSION(4) :: clgrd = (/ 'T','U','V','F' /)     ! name of the grid points
+
+      TYPE(PRISM_Time_struct)    :: tmpdate
+      INTEGER                    :: idate_incr      ! date increment
+      REAL(wp), POINTER, DIMENSION(:,:)   ::   zlon, zlat
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zclo, zcla
+      !!--------------------------------------------------------------------
+      
+      CALL wrk_alloc( jpi,jpj, zlon, zlat )
+      CALL wrk_alloc( jpi,jpj,jpk, zclo, zcla )
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cpl_prism_define : initialization in coupled ocean/atmosphere case'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~'
+      IF(lwp) WRITE(numout,*)
+
+      !
+      ! ... Allocate memory for data exchange
+      !
+      ALLOCATE( exfld(nlei-nldi+1, nlej-nldj+1, 1), stat = nerror )
+      IF ( nerror > 0 ) THEN
+         CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating exfld' )
+         RETURN
+      ENDIF
+
+      IF(.not. ALLOCATED(mask))THEN
+         ALLOCATE(llmask(jpi,jpj,1), Stat=ji)
+         IF(ji /= 0)THEN
+            CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in allocating llmask' )
+            RETURN
+         END IF
+      END IF
+
+      ! -----------------------------------------------------------------
+      ! ... Define the shape of the valid region without the halo and overlaps between cpus
+      !     For serial configuration (key_mpp_mpi not being active)
+      !     nl* is set to the global values 1 and jp*glo.
+      ! -----------------------------------------------------------------
+
+      ishape(:,1) = (/ 1, nlei-nldi+1 /)
+      ishape(:,2) = (/ 1, nlej-nldj+1 /)
+      ishape(:,3) = (/ 1,           1 /)
+          
+      DO ji = 1, 4
+         CALL prism_def_grid( igrid(ji), 'orca'//clgrd(ji), ncomp_id, ishape, PRISM_irrlonlat_regvrt, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_grid of '//clgrd(jg)//'-point' )
+      END DO
+      
+      ! -----------------------------------------------------------------
+      ! ... Define the partition 
+      ! -----------------------------------------------------------------
+      
+      iextent(1,:) = (/    nlei-nldi+1,    nlej-nldj+1, 1 /)
+      ioffset(1,:) = (/ nldi-1+nimpp-1, nldj-1+njmpp-1, 0 /)
+      
+      DO ji = 1, 4
+         CALL prism_def_partition( igrid(ji), 1, ioffset, iextent, nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort (ncomp_id, 'cpl_prism_define',   &
+            &                                                        'Failure in prism_def_partition of '//clgrd(jg)//'-point' )
+      END DO
+
+      ! -----------------------------------------------------------------
+      ! ... Define the elements, i.e. specify the corner points for each
+      !     volume element. In case OPA runs on level coordinates (regular
+      !     in the vertical) we only need to give the 4 horizontal corners
+      !     for a volume element plus the vertical position of the upper
+      !     and lower face. Nevertheless the volume element has 8 corners.
+      ! -----------------------------------------------------------------
+      
+      iioff(:) = (/0,1,0,1/)
+      ijoff(:) = (/0,0,1,1/) 
+      iishift(:) = (/0,1,1,0/)
+      ijshift(:) = (/0,0,1,1/)
+
+      DO jg = 1, 4    ! ... the t,u,v,f-points
+
+         cltxt = clgrd(jg)//'-point'
+         
+         ! -----------------------------------------------------------------
+         ! ... Convert OPA masks to logicals and define the masks
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1)  ) == 1.
+         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1)  ) == 1.
+         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1)  ) == 1.
+         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1)  ) == 1.
+!         CASE(1)   ;   llmask(:,:,1) = ( tmask(:,:,1) * dom_uniq('T') ) == 1.
+!         CASE(2)   ;   llmask(:,:,1) = ( umask(:,:,1) * dom_uniq('U') ) == 1.
+!         CASE(3)   ;   llmask(:,:,1) = ( vmask(:,:,1) * dom_uniq('V') ) == 1.
+!         CASE(4)   ;   llmask(:,:,1) = ( fmask(:,:,1) * dom_uniq('F') ) == 1.
+         END SELECT
+         CALL prism_set_mask( imskid(jg), igrid(jg), ishape, llmask(nldi:nlei, nldj:nlej, 1), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_mask for '//cltxt )
+
+         ! -----------------------------------------------------------------
+         ! ... Define the corners
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         CASE(2)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(3)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:) 
+         CASE(4)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         END SELECT
+
+         DO jc = 1, 4   ! corner number (anti-clockwise, starting from the bottom left corner)
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1   ! NO vector opt.
+                  ii = ji-1 + iioff(jg) + iishift(jc)
+                  ij = jj-1 + ijoff(jg) + ijshift(jc)
+                  zclo(ji,jj,jc) = zlon(ii,ij)
+                  zcla(ji,jj,jc) = zlat(ii,ij)
+               END DO
+            END DO
+            CALL lbc_lnk( zclo(:,:,jc), clgrd(jg), 1. )   ;   CALL lbc_lnk( zcla(:,:,jc), clgrd(jg), 1. )
+         END DO
+
+         CALL prism_set_corners( igrid(jg), 8, ishape, zclo(nldi:nlei, nldj:nlej,:),   &
+            &                                          zcla(nldi:nlei, nldj:nlej,:), RESHAPE( (/-1.,1./), (/1,2/) ), nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_corners of '//cltxt )    
+
+         ! -----------------------------------------------------------------
+         ! ... Define the center points
+         ! -----------------------------------------------------------------
+         SELECT CASE( jg ) 
+         CASE(1)   ;   zlon(:,:) = glamt(:,:)   ;   zlat(:,:) = gphit(:,:)
+         CASE(2)   ;   zlon(:,:) = glamu(:,:)   ;   zlat(:,:) = gphiu(:,:)
+         CASE(3)   ;   zlon(:,:) = glamv(:,:)   ;   zlat(:,:) = gphiv(:,:)
+         CASE(4)   ;   zlon(:,:) = glamf(:,:)   ;   zlat(:,:) = gphif(:,:)
+         END SELECT
+
+         CALL prism_set_points ( iptid(jg), cltxt, igrid(jg), ishape, zlon(nldi:nlei, nldj:nlej),   &
+         &                                                            zlat(nldi:nlei, nldj:nlej), (/0./), .TRUE., nerror )
+         IF( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_set_points '//cltxt )
+
+      END DO
+
+      ! ... Announce send variables. 
+      !
+      DO ji = 1, ksnd
+         IF ( ssnd(ji)%laction ) THEN 
+            
+            itmp(:) = 0
+            WHERE( clgrd == ssnd(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), ssnd(ji)%clname
+             ind(1) = 1
+
+            CALL prism_def_var( ssnd(ji)%nid, ssnd(ji)%clname, igrid(ind(1)), iptid(ind(1)),  imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(ssnd(ji)%clname))
+
+         ENDIF
+      END DO
+      !
+      ! ... Announce received variables. 
+      !
+      DO ji = 1, krcv
+         IF ( srcv(ji)%laction ) THEN 
+
+            itmp(:) = 0
+            WHERE( clgrd == srcv(ji)%clgrid  ) itmp = 1
+            ind(:) = maxloc( itmp )
+            WRITE(6,*) ' grid for field ', ind(1), srcv(ji)%clname
+             ind(1) = 1
+ 
+            CALL prism_def_var( srcv(ji)%nid, srcv(ji)%clname, igrid(ind(1)), iptid(ind(1)), imskid(ind(1)), (/ 3, 0/),   &
+               &                ishape, PRISM_Double_Precision, nerror )
+            IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(ji)%nid, 'cpl_prism_define',   &
+               &                                               'Failure in prism_def_var for '//TRIM(srcv(ji)%clname))
+
+         ENDIF
+      END DO
+      
+      !------------------------------------------------------------------
+      ! End of definition phase
+      !------------------------------------------------------------------
+      
+      CALL prism_enddef( nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort ( ncomp_id, 'cpl_prism_define', 'Failure in prism_enddef')
+      
+      CALL wrk_dealloc( jpi,jpj, zlon, zlat )
+      CALL wrk_dealloc( jpi,jpj,jpk, zclo, zcla )
+      !
+   END SUBROUTINE cpl_prism_define
+   
+   
+   SUBROUTINE cpl_prism_snd( kid, kstep, pdata, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_snd  ***
+      !!
+      !! ** Purpose : - At each coupling time-step,this routine sends fields
+      !!      like sst or ice cover to the coupler or remote application.
+      !!----------------------------------------------------------------------
+      INTEGER                 , INTENT(in   ) ::   kid     ! variable intex in the array
+      INTEGER                 , INTENT(  out) ::   kinfo   ! OASIS4 info argument
+      INTEGER                 , INTENT(in   ) ::   kstep   ! ocean time-step in seconds
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   pdata
+      !!--------------------------------------------------------------------
+      !
+      ! snd data to OASIS4
+      !
+      exfld(:,:,1) = pdata(nldi:nlei, nldj:nlej)
+      CALL prism_put( ssnd(kid)%nid, date, date_bound, exfld, kinfo, nerror )
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( ssnd(kid)%nid, 'cpl_prism_snd',   &
+         &                                               'Failure in prism_put for '//TRIM(ssnd(kid)%clname) )
+
+      IF( ln_ctl ) THEN        
+         IF ( kinfo >= PRISM_Cpl     .OR. kinfo == PRISM_Rst .OR.   &
+            & kinfo == PRISM_RstTimeop ) THEN
+            WRITE(numout,*) '****************'
+            WRITE(numout,*) 'prism_put: Outgoing ', ssnd(kid)%clname
+            WRITE(numout,*) 'prism_put: ivarid ', ssnd(kid)%nid
+            WRITE(numout,*) 'prism_put:  kstep ', kstep
+            WRITE(numout,*) 'prism_put:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+         ENDIF
+      ENDIF
+      !
+   END SUBROUTINE cpl_prism_snd
+
+
+   SUBROUTINE cpl_prism_rcv( kid, kstep, pdata, kinfo )
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_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 intex 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
+      INTEGER                 , INTENT(  out) ::   kinfo   ! OASIS4 info argument
+      !
+      LOGICAL                :: llaction
+      !!--------------------------------------------------------------------
+      !
+      ! receive local data from OASIS4 on every process
+      !
+      CALL prism_get( srcv(kid)%nid, date, date_bound, exfld, kinfo, nerror )         
+      IF ( nerror /= PRISM_Success )   CALL prism_abort( srcv(kid)%nid, 'cpl_prism_rcv',   &
+         &                                               'Failure in prism_get for '//TRIM(srcv(kid)%clname) )
+
+      WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+      call flush(numout)
+      llaction = .false.
+      IF( kinfo == PRISM_Cpl )  llaction = .TRUE.
+
+      IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid
+
+      IF ( llaction ) THEN
+
+         kinfo = OASIS_Rcv
+         pdata(nldi:nlei, nldj:nlej) = exfld(:,:,1)
+         
+         !--- Fill the overlap areas and extra hallows (mpp)
+         !--- check periodicity conditions (all cases)
+         CALL lbc_lnk( pdata, srcv(kid)%clgrid, srcv(kid)%nsgn )   
+         
+         IF ( ln_ctl ) THEN        
+            WRITE(numout,*) '****************'
+            WRITE(numout,*) 'prism_get: Incoming ', srcv(kid)%clname
+            WRITE(numout,*) 'prism_get: ivarid '  , srcv(kid)%nid
+            WRITE(numout,*) 'prism_get:   kstep', kstep
+            WRITE(numout,*) 'prism_get:   info ', kinfo
+            WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata)
+            WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata)
+            WRITE(numout,*) '     -     Sum value is ', SUM(pdata)
+            WRITE(numout,*) '****************'
+         ENDIF
+
+      ELSE
+         kinfo = OASIS_idle     
+      ENDIF
+      !
+   END SUBROUTINE cpl_prism_rcv
+
+
+   SUBROUTINE cpl_prism_finalize
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_finalize  ***
+      !!
+      !! ** Purpose : - Finalizes the coupling. If MPI_init has not been
+      !!      called explicitly before cpl_prism_init it will also close
+      !!      MPI communication.
+      !!----------------------------------------------------------------------
+      !
+      DEALLOCATE(exfld)
+      CALL prism_terminate ( nerror )         
+      !
+   END SUBROUTINE cpl_prism_finalize
+
+
+   SUBROUTINE cpl_prism_update_time(kt)
+      !!---------------------------------------------------------------------
+      !!              ***  ROUTINE cpl_prism_update_time  ***
+      !!
+      !! ** Purpose : - Increment date with model timestep
+      !!                called explicitly at the end of each timestep
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean model time step index
+
+      TYPE(PRISM_Time_struct) ::   tmpdate
+      INTEGER                 ::   idate_incr   ! date increment
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN      ! Define the actual date 
+         !
+         ! date is determined by adding days since beginning of the run to the corresponding initial date.
+         ! Note that OPA internal info about the start date of the experiment is bypassed.
+         ! Instead we rely sololy on the info provided by the SCC.xml file.
+         !
+         date = PRISM_Jobstart_date
+         !
+         !
+         ! lower/upper bound is determined by adding half a time step
+         !
+         idate_incr = 0.5 * NINT ( rdttra(1) )
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate, -idate_incr, nerror )   ;   date_bound(1) = tmpdate
+         tmpdate = date   ;   CALL PRISM_calc_newdate ( tmpdate,  idate_incr, nerror )   ;   date_bound(2) = tmpdate
+         !
+      ELSE      ! Date update
+         !
+         idate_incr  = rdttra(1)
+         CALL PRISM_calc_newdate( date, idate_incr, nerror )
+         date_bound(1) = date_bound(2)
+         tmpdate = date_bound(2)
+         CALL PRISM_calc_newdate( tmpdate, idate_incr, nerror )
+         date_bound(2) = tmpdate
+         !
+      END IF
+      !
+   END SUBROUTINE cpl_prism_update_time
+
+#endif
+
+   !!=====================================================================
+END MODULE cpl_oasis4
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90	(revision 3437)
@@ -0,0 +1,1255 @@
+MODULE fldread
+   !!======================================================================
+   !!                       ***  MODULE  fldread  ***
+   !! Ocean forcing:  read input field for surface boundary condition
+   !!=====================================================================
+   !! History :  2.0  !  06-2006  (S. Masson, G. Madec) Original code
+   !!                 !  05-2008  (S. Alderson) Modified for Interpolation in memory
+   !!                 !                         from input grid to model grid
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   fld_read      : read input fields used for the computation of the
+   !!                   surface boundary condition
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! ???
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager library
+   USE geo2ocean       ! for vector rotation on to model grid
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar
+
+   IMPLICIT NONE
+   PRIVATE   
+ 
+   PUBLIC   fld_map    ! routine called by tides_init
+
+   TYPE, PUBLIC ::   FLD_N      !: Namelist field informations
+      CHARACTER(len = 256) ::   clname      ! generic name of the NetCDF flux file
+      INTEGER              ::   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 = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not
+      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation
+      !                                     ! a string starting with "U" or "V" for each component   
+      !                                     ! chars 2 onwards identify which components go together  
+   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
+      INTEGER                         ::   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                         ::   rotn         ! flag to indicate whether field has been rotated
+   END TYPE FLD
+
+   TYPE, PUBLIC ::   MAP_POINTER      !: Array of integer pointers to 1D arrays
+      INTEGER, POINTER   ::  ptr(:)
+   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
+
+!$AGRIF_END_DO_NOT_TREAT
+
+   PUBLIC   fld_read, fld_fill   ! called by sbc... modules
+
+   !!----------------------------------------------------------------------
+   !! 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, jit, time_offset )
+      !!---------------------------------------------------------------------
+      !!                    ***  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 index
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   jit       ! subcycle timestep for timesplitting option
+      INTEGER  , INTENT(in   ), OPTIONAL     ::   time_offset ! provide fields at time other than "now"
+                                                              ! time_offset = -1 => fields at "before" time level
+                                                              ! time_offset = +1 => fields at "after" time levels
+                                                              ! etc.
+      !!
+      INTEGER  ::   imf        ! size of the structure sd
+      INTEGER  ::   jf         ! dummy indices
+      INTEGER  ::   ireclast   ! last record to be read in the current year file
+      INTEGER  ::   isecend    ! number of second since Jan. 1st 00h of nit000 year at nitend
+      INTEGER  ::   isecsbc    ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step
+      INTEGER  ::   itime_add  ! 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
+      !!---------------------------------------------------------------------
+      ll_firstcall = .false.
+      IF( PRESENT(jit) ) THEN
+         IF(kt == nit000 .and. jit == 1) ll_firstcall = .true.
+      ELSE
+         IF(kt == nit000) ll_firstcall = .true.
+      ENDIF
+
+      itime_add = 0
+      IF( PRESENT(time_offset) ) itime_add = time_offset
+         
+      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 
+      IF( present(jit) ) THEN 
+         ! ignore kn_fsbc in this case
+         isecsbc = nsec_year + nsec1jan000 + (jit+itime_add)*rdt/REAL(nn_baro,wp) 
+      ELSE
+         isecsbc = nsec_year + nsec1jan000 + NINT(0.5 * REAL(kn_fsbc - 1,wp) * rdttra(1)) + itime_add * rdttra(1)  ! middle of sbc time step
+      ENDIF
+      imf = SIZE( sd )
+      !
+      IF( ll_firstcall ) THEN                      ! initialization
+         IF( PRESENT(map) ) THEN
+            DO jf = 1, imf 
+               CALL fld_init( kn_fsbc, sd(jf), map(jf)%ptr )  ! read each before field (put them in after as they will be swapped)
+            END DO
+         ELSE
+            DO jf = 1, imf 
+               CALL fld_init( kn_fsbc, sd(jf) )       ! read each before field (put them in after as they will be swapped)
+            END DO
+         ENDIF
+         IF( lwp ) CALL wgt_print()                ! control print
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+      ENDIF
+      !                                            ! ====================================== !
+      IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN         ! update field at each kn_fsbc time-step !
+         !                                         ! ====================================== !
+         !
+         DO jf = 1, imf                            ! ---   loop over field   --- !
+            
+            IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN  ! read/update the after data?
+
+               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations
+                  sd(jf)%nrec_b(:) = sd(jf)%nrec_a(:)
+!CDIR COLLAPSE
+                  sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2)
+               ENDIF
+
+               IF( PRESENT(jit) ) THEN
+                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add, jit=jit )              ! update record informations
+               ELSE
+                  CALL fld_rec( kn_fsbc, sd(jf), time_offset=itime_add )                       ! update record informations
+               ENDIF
+
+               ! do we have to change the year/month/week/day of the forcing field?? 
+               IF( sd(jf)%ln_tint ) THEN
+                  ! if we do time interpolation we will need to open next year/month/week/day file before the end of the current
+                  ! one. If so, we are still before the end of the year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1)
+                  ! will be larger than the record number that should be read for current year/month/week/day
+
+                  ! last record to be read in the current file
+                  IF    ( sd(jf)%nfreqh == -12 ) THEN                 ;   ireclast = 1    !  yearly mean
+                  ELSEIF( sd(jf)%nfreqh ==  -1 ) THEN                                     ! monthly mean
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 1
+                     ELSE                                             ;   ireclast = 12
+                     ENDIF
+                  ELSE                                                                    ! higher frequency mean (in hours)
+                     IF(     sd(jf)%cltype      == 'monthly' ) THEN   ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh 
+                     ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN   ;   ireclast = 24 * 7                  / sd(jf)%nfreqh
+                     ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN   ;   ireclast = 24                      / sd(jf)%nfreqh
+                     ELSE                                             ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh 
+                     ENDIF
+                  ENDIF
+
+                  ! do we need next file data?
+                  IF( sd(jf)%nrec_a(1) > ireclast ) THEN
+
+                     sd(jf)%nrec_a(1) = 1              ! force to read the first record of the next file
+
+                     IF( .NOT. sd(jf)%ln_clim ) THEN   ! close the current file and open a new one.
+
+                        llnxtmth = sd(jf)%cltype == 'monthly' .OR. nday == nmonth_len(nmonth)      ! open next month file?
+                        llnxtyr  = sd(jf)%cltype == 'yearly'  .OR. (nmonth == 12 .AND. llnxtmth)   ! open next year  file?
+
+                        ! if the run finishes at the end of the current year/month/week/day, we will allow next
+                        ! year/month/week/day file to be not present. If the run continue further than the current
+                        ! year/month/week/day, next year/month/week/day file must exist
+                        isecend = nsec_year + nsec1jan000 + (nitend - kt) * NINT(rdttra(1))   ! second at the end of the run 
+                        llstop = isecend > sd(jf)%nrec_a(2)                                   ! read more than 1 record of next year
+
+                        CALL fld_clopn( sd(jf), nyear  + COUNT((/llnxtyr /))                                           ,         &
+                           &                    nmonth + COUNT((/llnxtmth/)) - 12                 * COUNT((/llnxtyr /)),         &
+                           &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop )
+
+                        IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist
+                           CALL ctl_warn('next year/month/week/day file: '//TRIM(sd(jf)%clname)//     &
+                              &     ' not present -> back to current year/month/day')
+                           CALL fld_clopn( sd(jf), nyear, nmonth, nday )       ! back to the current year/month/day
+                           sd(jf)%nrec_a(1) = ireclast     ! force to read the last record to be read in the current year file
+                        ENDIF
+
+                     ENDIF
+                  ENDIF
+
+               ELSE
+                  ! if we are not doing time interpolation, we must change the year/month/week/day of the file just after
+                  ! switching to the NEW year/month/week/day. If it is the case, we are at the beginning of the
+                  ! year/month/week/day when calling fld_rec so sd(jf)%nrec_a(1) = 1
+                  IF( sd(jf)%nrec_a(1) == 1 .AND. .NOT. ( sd(jf)%ln_clim .AND. sd(jf)%cltype == 'yearly' ) )   &
+                     &   CALL fld_clopn( sd(jf), nyear, nmonth, nday )
+               ENDIF
+
+               ! read after data
+               IF( PRESENT(map) ) THEN
+                  CALL fld_get( sd(jf), map(jf)%ptr )
+               ELSE
+                  CALL fld_get( sd(jf) )
+               ENDIF
+
+            ENDIF
+         END DO                                    ! --- end loop over field --- !
+
+         CALL fld_rot( kt, sd )                    ! rotate vector fiels if needed
+
+         DO jf = 1, imf                            ! ---   loop over field   --- !
+            !
+            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation
+               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8, ' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', records b/a: ', i4.4, '/', i4.4, ' (days ', f7.2,'/', f7.2, ')')"
+                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &            
+                     & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
+                  WRITE(numout, *) 'itime_add is : ',itime_add
+               ENDIF
+               ! temporal interpolation weights
+               ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp )
+               ztintb =  1. - ztinta
+!CDIR COLLAPSE
+               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2)
+            ELSE   ! nothing to do...
+               IF(lwp .AND. kt - nit000 <= 100 ) THEN
+                  clfmt = "('fld_read: var ', a, ' kt = ', i8,' (', f7.2,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," //   &
+                     &    "', record: ', i4.4, ' (days ', f7.2, ' <-> ', f7.2, ')')"
+                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    &
+                     &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday
+               ENDIF
+            ENDIF
+            !
+            IF( kt == nitend - kn_fsbc + 1 )   CALL iom_close( sd(jf)%num )   ! Close the input files
+
+         END DO                                    ! --- end loop over field --- !
+         !
+         !                                         ! ====================================== !
+      ENDIF                                        ! update field at each kn_fsbc time-step !
+      !                                            ! ====================================== !
+      !
+   END SUBROUTINE fld_read
+
+
+   SUBROUTINE fld_init( kn_fsbc, sdjf, map )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_init  ***
+      !!
+      !! ** Purpose :  - if time interpolation, read before data 
+      !!               - open current year file
+      !!----------------------------------------------------------------------
+      INTEGER  , INTENT(in   ) ::   kn_fsbc   ! sbc computation period (in time step) 
+      TYPE(FLD), INTENT(inout) ::   sdjf      ! input field related variables
+      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
+      !!
+      LOGICAL :: llprevyr              ! are we reading previous year  file?
+      LOGICAL :: llprevmth             ! are we reading previous month file?
+      LOGICAL :: llprevweek            ! are we reading previous week  file?
+      LOGICAL :: llprevday             ! are we reading previous day   file?
+      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday
+      INTEGER :: idvar                 ! variable id 
+      INTEGER :: inrec                 ! number of record existing for this variable
+      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd
+      INTEGER :: isec_week             ! number of seconds since start of the weekly file
+      CHARACTER(LEN=1000) ::   clfmt   ! write format
+      !!---------------------------------------------------------------------
+      
+      ! some default definitions...
+      sdjf%num = 0   ! default definition for non-opened file
+      IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case
+      llprevyr   = .FALSE.
+      llprevmth  = .FALSE.
+      llprevweek = .FALSE.
+      llprevday  = .FALSE.
+      isec_week  = 0
+            
+      IF( sdjf%cltype(1:4) == 'week' .AND. nn_leapy == 0 )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs nn_leapy = 1')
+      IF( sdjf%cltype(1:4) == 'week' .AND. sdjf%ln_clim  )   &
+         &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdjf%clrootname)//') needs ln_clim = .FALSE.')
+
+      ! define record informations
+      CALL fld_rec( kn_fsbc, sdjf, 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%clname) )
+               ENDIF
+            ELSEIF( sdjf%nfreqh ==  -1 ) THEN   ! monthly mean
+               IF( sdjf%cltype == 'monthly' ) THEN            ! monthly file
+                  sdjf%nrec_a(1) = 1                                                       ! force to read the unique record
+                  llprevmth = .TRUE.                                                       ! use previous month file?
+                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
+               ELSE                                           ! yearly file
+                  sdjf%nrec_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) = 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) = 24 * 7 / sdjf%nfreqh                                    ! last record of previous week
+                  isec_week = NINT(rday) * 7                                               ! add a shift toward previous week
+               ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ! daily file
+                  sdjf%nrec_a(1) = 24 / sdjf%nfreqh                                        ! last record of previous day
+                  llprevday = .TRUE.                                                       ! use previous day   file?
+                  llprevmth = llprevday .AND. nday   == 1                                  ! use previous month file?
+                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file?
+               ELSE                                           ! yearly file
+                  sdjf%nrec_a(1) = 24 * nyear_len(0) / sdjf%nfreqh                         ! last record of previous year 
+                  llprevyr = .NOT. sdjf%ln_clim                                            ! use previous year  file?
+               ENDIF
+            ENDIF
+         ENDIF
+         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%clname)//   &
+               &           ' not present -> back to current year/month/week/day' )
+            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day
+            llprev = .FALSE.
+            sdjf%nrec_a(1) = 1
+            CALL fld_clopn( sdjf, nyear, nmonth, nday )
+         ENDIF
+         
+         IF( llprev ) THEN   ! check if the last record sdjf%nrec_n(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 
+         IF( PRESENT(map) ) THEN
+            CALL fld_get( sdjf, map )  ! read before values in after arrays(as we will swap it later)
+         ELSE
+            CALL fld_get( sdjf )  ! read before values in after arrays(as we will swap it later)
+         ENDIF
+
+         clfmt = "('fld_init : time-interpolation for ', a, ' read previous record = ', i4, ' at time = ', f7.2, ' days')"
+         IF(lwp) WRITE(numout, clfmt) TRIM(sdjf%clvar), sdjf%nrec_a(1), REAL(sdjf%nrec_a(2),wp)/rday
+
+         IF( llprev )   CALL iom_close( sdjf%num )          ! force to close previous year file (-> redefine sdjf%num to 0)
+
+      ENDIF
+
+      ! make sure current year/month/day file is opened
+      IF( sdjf%num <= 0 ) THEN
+         !
+         IF ( sdjf%cltype(1:4) == 'week' ) THEN
+            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week
+            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month
+            llprevyr   = llprevmth .AND. nmonth == 1
+         ELSE
+            isec_week  = 0
+            llprevmth  = .FALSE.
+            llprevyr   = .FALSE.
+         ENDIF
+         !
+         iyear  = nyear  - COUNT((/llprevyr /))
+         imonth = nmonth - COUNT((/llprevmth/)) + 12 * COUNT((/llprevyr /))
+         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week / NINT(rday)
+         !
+         CALL fld_clopn( sdjf, iyear, imonth, iday )
+      ENDIF 
+      !
+   END SUBROUTINE fld_init
+
+
+   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit, time_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 ::   jit       ! index of barotropic subcycle
+                                                        ! used only if sdjf%ln_tint = .TRUE.
+      INTEGER  , INTENT(in   ), OPTIONAL ::   time_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  ::   itime_add   ! 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
+      !
+      itime_add = 0
+      IF( PRESENT(time_offset) ) itime_add = time_offset
+      !
+      !                                      ! =========== !
+      IF    ( sdjf%nfreqh == -12 ) THEN      ! yearly mean
+         !                                   ! =========== !
+         !
+         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    1 |    *----
+            !                    0 |----(              
+            !                      |----+----|--> time
+            !                      0   /|\   1   (nday/nyear_len(1))
+            !                           |   
+            !                           |   
+            !       forcing record :    1 
+            !                            
+            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5
+            IF( PRESENT(jit) ) THEN 
+               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+            ELSE
+               ztmp = ztmp + itime_add*rdttra(1)
+            ENDIF
+            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ! swap at the middle of the year
+            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0)
+            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)   
+            ENDIF
+         ELSE                                    ! no time interpolation
+            sdjf%nrec_a(1) = 1
+            sdjf%nrec_a(2) = NINT(rday) * nyear_len(1) + nsec1jan000   ! swap at the end    of the year
+            sdjf%nrec_b(2) = nsec1jan000                               ! beginning of the year (only for print)
+         ENDIF
+         !
+         !                                   ! ============ !
+      ELSEIF( sdjf%nfreqh ==  -1 ) THEN      ! monthly mean !
+         !                                   ! ============ !
+         !
+         IF( sdjf%ln_tint ) THEN                 ! time interpolation, shift by 1/2 record
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    1 |    *----
+            !                    0 |----(              
+            !                      |----+----|--> time
+            !                      0   /|\   1   (nday/nmonth_len(nmonth))
+            !                           |   
+            !                           |   
+            !       forcing record :  nmonth 
+            !                            
+            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5
+            IF( PRESENT(jit) ) THEN 
+               ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+            ELSE
+               ztmp = ztmp + itime_add*rdttra(1)
+            ENDIF
+            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/))
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))
+            ELSE                                  ;   sdjf%nrec_a(1) = imth
+            ENDIF
+            sdjf%nrec_a(2) = nmonth_half(   imth ) + nsec1jan000   ! swap at the middle of the month
+         ELSE                                    ! no time interpolation
+            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1
+            ELSE                                  ;   sdjf%nrec_a(1) = nmonth
+            ENDIF
+            sdjf%nrec_a(2) =  nmonth_end(nmonth  ) + nsec1jan000   ! swap at the end    of the month
+            sdjf%nrec_b(2) =  nmonth_end(nmonth-1) + nsec1jan000   ! beginning of the month (only for print)
+         ENDIF
+         !
+         !                                   ! ================================ !
+      ELSE                                   ! higher frequency mean (in hours)
+         !                                   ! ================================ !
+         !
+         ifreq_sec = sdjf%nfreqh * 3600                                                 ! frequency mean (in seconds)
+         IF( sdjf%cltype(1:4) == 'week' )   isec_week = ksec_week( sdjf%cltype(6:8) )   ! since the first day of the current week
+         ! number of second since the beginning of the file
+         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)  ! since the first day of the current month
+         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week ,wp)  ! since the first day of the current week
+         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)  ! since 00h of the current day
+         ELSE                                           ;   ztmp = REAL(nsec_year ,wp)  ! since 00h on Jan 1 of the current year
+         ENDIF
+         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step
+         ztmp = ztmp + 0.01 * rdttra(1)                          ! add 0.01 time step to avoid truncation error 
+         IF( PRESENT(jit) ) THEN 
+            ztmp = ztmp + (jit+itime_add)*rdt/REAL(nn_baro,wp)
+         ELSE
+            ztmp = ztmp + itime_add*rdttra(1)
+         ENDIF
+         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    2 |        *-----(
+            !                    1 |  *-----(
+            !                    0 |--(              
+            !                      |--+--|--+--|--+--|--> time
+            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
+            !                         |     |     |
+            !                         |     |     |
+            !       forcing record :  1     2     3
+            !                   
+            ztmp= ztmp / REAL(ifreq_sec, wp) + 0.5
+         ELSE                                   ! no time interpolation
+            !
+            !                  INT( ztmp )
+            !                     /|\
+            !                    2 |           *-----(
+            !                    1 |     *-----(
+            !                    0 |-----(              
+            !                      |--+--|--+--|--+--|--> time
+            !                      0 /|\ 1 /|\ 2 /|\ 3 (nsec_year/ifreq_sec) or (nsec_month/ifreq_sec)
+            !                         |     |     |
+            !                         |     |     |
+            !       forcing record :  1     2     3
+            !                            
+            ztmp= ztmp / REAL(ifreq_sec, wp)
+         ENDIF
+         sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/))   ! record nomber to be read
+
+         iendrec = ifreq_sec * sdjf%nrec_a(1) + nsec1jan000       ! end of this record (in second)
+         ! add the number of seconds between 00h Jan 1 and the end of previous month/week/day (ok if nmonth=1)
+         IF( sdjf%cltype      == 'monthly' )   iendrec = iendrec + NINT(rday) * SUM(nmonth_len(1:nmonth -1))
+         IF( sdjf%cltype(1:4) == 'week'    )   iendrec = iendrec + ( nsec_year - isec_week )
+         IF( sdjf%cltype      == 'daily'   )   iendrec = iendrec + NINT(rday) * ( nday_year - 1 )
+         IF( sdjf%ln_tint ) THEN
+             sdjf%nrec_a(2) = iendrec - ifreq_sec / 2        ! swap at the middle of the record
+         ELSE
+             sdjf%nrec_a(2) = iendrec                        ! swap at the end    of the record
+             sdjf%nrec_b(2) = iendrec - ifreq_sec            ! beginning of the record (only for print)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE fld_rec
+
+
+   SUBROUTINE fld_get( sdjf, map )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_get  ***
+      !!
+      !! ** Purpose :   read the data
+      !!----------------------------------------------------------------------
+      TYPE(FLD), INTENT(inout) ::   sdjf   ! input field related variables
+      INTEGER  , INTENT(in), OPTIONAL, DIMENSION(:) :: map ! global-to-local mapping indices
+      !!
+      INTEGER                  ::   ipk    ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk )
+      INTEGER                  ::   iw     ! index into wgts array
+      !!---------------------------------------------------------------------
+            
+      ipk = SIZE( sdjf%fnow, 3 )
+
+      IF( PRESENT(map) ) THEN
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map )
+         ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1), map )
+         ENDIF
+      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
+         CALL wgt_list( sdjf, iw )
+         IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+         ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw , ipk  , sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+         ENDIF
+      ELSE
+         SELECT CASE( ipk )
+         CASE(1)   
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) )
+            ENDIF
+         CASE DEFAULT
+            IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )
+            ELSE                      ;   CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) )
+            ENDIF
+         END SELECT
+      ENDIF
+      !
+      sdjf%rotn = .false.   ! vector not yet rotated
+
+   END SUBROUTINE fld_get
+
+   SUBROUTINE fld_map( num, clvar, dta, nrec, map )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_get  ***
+      !!
+      !! ** Purpose :   read global data from file and map onto local data
+      !!                using a general mapping (for open boundaries)
+      !!----------------------------------------------------------------------
+#if defined key_bdy
+      USE bdy_oce, ONLY:  dta_global         ! workspace to read in global data arrays
+#endif 
+
+      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)
+      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map     ! global-to-local mapping indices
+      !!
+      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   ! loop counters
+      INTEGER                                 ::   ierr
+      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read ! work space for global data
+      !!---------------------------------------------------------------------
+            
+#if defined key_bdy
+      dta_read => dta_global
+#endif
+
+      ipi = SIZE( dta, 1 )
+      ipj = 1
+      ipk = SIZE( dta, 3 )
+
+      idvar   = iom_varid( num, clvar )
+      ilendta = iom_file(num)%dimsz(1,idvar)
+      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 )
+      CASE DEFAULT
+         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )
+      END SELECT
+      !
+      DO ib = 1, ipi
+         DO ik = 1, ipk
+            dta(ib,1,ik) =  dta_read(map(ib),1,ik)
+         END DO
+      END DO
+
+   END SUBROUTINE fld_map
+
+
+   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), INTENT(inout), DIMENSION(:) ::   sd        ! input field related variables
+      !!
+      INTEGER                           ::   ju, jv, jk   ! loop indices
+      INTEGER                           ::   imf          ! size of the structure sd
+      INTEGER                           ::   ill          ! character length
+      INTEGER                           ::   iv           ! indice of V component
+      REAL(wp), POINTER, DIMENSION(:,:) ::   utmp, vtmp   ! temporary arrays for vector rotation
+      CHARACTER (LEN=100)               ::   clcomp       ! dummy weight name
+      !!---------------------------------------------------------------------
+
+      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 )
+         IF( ill > 0 .AND. .NOT. sd(ju)%rotn ) THEN   ! find vector rotations required             
+             IF( sd(ju)%vcomp(1:1) == 'U' ) THEN      ! east-west component has symbolic name starting with 'U'
+                ! look for the north-south component which has same symbolic name but with 'U' replaced with 'V'
+                clcomp = 'V' // sd(ju)%vcomp(2:ill)   ! works even if ill == 1
+                iv = -1
+                DO jv = 1, imf
+                  IF( TRIM(sd(jv)%vcomp) == TRIM(clcomp) )   iv = jv
+                END DO
+                IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together
+                   DO jk = 1, SIZE( sd(ju)%fnow, 3 )
+                      IF( sd(ju)%ln_tint )THEN
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fdta(:,:,jk,2), sd(iv)%fdta(:,:,jk,2), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fdta(:,:,jk,2) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,2) = vtmp(:,:)
+                      ELSE 
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->i', utmp(:,:) )
+                         CALL rot_rep( sd(ju)%fnow(:,:,jk  ), sd(iv)%fnow(:,:,jk  ), 'T', 'en->j', vtmp(:,:) )
+                         sd(ju)%fnow(:,:,jk  ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk  ) = vtmp(:,:)
+                      ENDIF
+                   END DO
+                   sd(ju)%rotn = .TRUE.               ! vector was rotated 
+                   IF( lwp .AND. kt == nit000 )   WRITE(numout,*)   &
+                      &   'fld_read: vector pair ('//TRIM(sd(ju)%clvar)//', '//TRIM(sd(iv)%clvar)//') rotated on to model grid'
+                ENDIF
+             ENDIF
+          ENDIF
+       END DO
+      !
+      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 open the file
+      !!----------------------------------------------------------------------
+      TYPE(FLD)        , INTENT(inout) ::   sdjf     ! input field related variables
+      INTEGER          , INTENT(in   ) ::   kyear    ! year value
+      INTEGER          , INTENT(in   ) ::   kmonth   ! month value
+      INTEGER          , INTENT(in   ) ::   kday     ! day value
+      LOGICAL, OPTIONAL, INTENT(in   ) ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.)
+      !!----------------------------------------------------------------------
+
+      IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open
+      ! build the new filename if not climatological data
+      sdjf%clname=TRIM(sdjf%clrootname)
+      !
+      ! note that sdjf%ln_clim is is only acting on presence of the year in the file
+      IF( .NOT. sdjf%ln_clim ) THEN   
+                                         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month
+      ELSE
+         ! build the new filename if climatological data
+         IF( sdjf%cltype /= 'yearly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month
+      ENDIF
+      IF( sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) &
+            &                            WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day
+      !
+      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 )
+     !
+   END SUBROUTINE fld_clopn
+
+
+   SUBROUTINE fld_fill( sdf, sdf_n, cdir, cdcaller, cdtitle, cdnam )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE fld_fill  ***
+      !!
+      !! ** Purpose :   fill sdf with 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   ! 
+      CHARACTER(len=*)         , INTENT(in   ) ::   cdtitle    ! 
+      CHARACTER(len=*)         , INTENT(in   ) ::   cdnam      ! 
+      !
+      INTEGER  ::   jf       ! dummy indices
+      !!---------------------------------------------------------------------
+
+      DO jf = 1, SIZE(sdf)
+         sdf(jf)%clrootname = TRIM( cdir )//TRIM( sdf_n(jf)%clname )
+         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)%wgtname = " "
+         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname )
+         sdf(jf)%vcomp   = sdf_n(jf)%vcomp
+      END DO
+
+      IF(lwp) THEN      ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) TRIM( cdcaller )//' : '//TRIM( cdtitle )
+         WRITE(numout,*) (/ ('~', jf = 1, LEN_TRIM( cdcaller ) ) /)
+         WRITE(numout,*) '          '//TRIM( cdnam )//' Namelist'
+         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     ,   &
+               &                          ' weights    : '    , TRIM( sdf(jf)%wgtname    ),   &
+               &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   &
+               &                          ' data type: '      ,       sdf(jf)%cltype
+            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 it is a 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          ! temporary logical unit
+      INTEGER                           ::   id            ! temporary variable id
+      INTEGER                           ::   ipk           ! temporary vertical dimension
+      CHARACTER (len=5)                 ::   aname
+      INTEGER , DIMENSION(3)            ::   ddims
+      INTEGER , POINTER, DIMENSION(:,:) ::   data_src
+      REAL(wp), POINTER, DIMENSION(:,:) ::   data_tmp
+      LOGICAL                           ::   cyclical
+      INTEGER                           ::   zwrap      ! local integer
+      !!----------------------------------------------------------------------
+      !
+      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
+      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
+
+      CALL wrk_dealloc( jpi,jpj, data_src )   ! integer
+      CALL wrk_dealloc( jpi,jpj, data_tmp )
+      !
+   END SUBROUTINE fld_weight
+
+
+   SUBROUTINE fld_interp( num, clvar, kw, kk, dta, nrec )
+      !!---------------------------------------------------------------------
+      !!                    ***  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)
+      !! 
+      INTEGER, DIMENSION(3) ::   rec1,recn   ! temporary arrays for start and length
+      INTEGER ::  jk, jn, jm           ! loop counters
+      INTEGER ::  ni, nj               ! lengths
+      INTEGER ::  jpimin,jpiwid        ! temporary indices
+      INTEGER ::  jpjmin,jpjwid        ! temporary indices
+      INTEGER ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices
+      !!----------------------------------------------------------------------
+      !
+      !! 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
+
+      ref_wgts(kw)%fly_dta(:,:,:) = 0.0
+      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) )
+      CASE(1)
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn)
+      CASE DEFAULT
+           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn)
+      END SELECT 
+
+      !! first four weights common to both bilinear and bicubic
+      !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft
+      !! note that we have to offset by 1 into fly_dta array because of halo
+      dta(:,:,:) = 0.0
+      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 :  
+      !!---------------------------------------------------------------------
+      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file
+      !!
+      INTEGER                        ::   ksec_week  ! output variable
+      INTEGER                        ::   ijul       !temp variable
+      INTEGER                        ::   ishift     !temp variable
+      CHARACTER(len=3),DIMENSION(7)  ::   cl_week 
+      !!----------------------------------------------------------------------
+      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/)
+      DO ijul = 1, 7
+         IF( cl_week(ijul) == TRIM(cdday) ) EXIT
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90	(revision 3437)
@@ -0,0 +1,576 @@
+MODULE geo2ocean
+   !!======================================================================
+   !!                     ***  MODULE  geo2ocean  ***
+   !! Ocean mesh    :  ???
+   !!======================================================================
+   !! History :  OPA  !  07-1996  (O. Marti)  Original code
+   !!   NEMO     1.0  !  02-2008  (G. Madec)  F90: Free form
+   !!            3.0  !  
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   repcmo      : 
+   !!   angle       :
+   !!   geo2oce     :
+   !!   repere      :   old routine suppress it ???
+   !!----------------------------------------------------------------------
+   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, repcmo, repere, geo2oce, oce2geo   ! only rot_rep should be used
+                                             ! repcmo and repere are keep only for compatibility.
+                                             ! they are only a useless overlay of rot_rep
+
+   PUBLIC   obs_rot
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   &
+      gsint, gcost,   &  ! cos/sin between model grid lines and NP direction at T point
+      gsinu, gcosu,   &  ! cos/sin between model grid lines and NP direction at U point
+      gsinv, gcosv,   &  ! cos/sin between model grid lines and NP direction at V point
+      gsinf, gcosf       ! cos/sin between model grid lines and NP direction 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 (se 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 repcmo ( pxu1, pyu1, pxv1, pyv1,   &
+                       px2 , py2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE repcmo  ***
+      !!
+      !! ** Purpose :   Change vector componantes from a geographic grid to a
+      !!      stretched coordinates grid.
+      !!
+      !! ** Method  :   Initialization of arrays at the first call.
+      !!
+      !! ** Action  : - px2 : first  componante (defined at u point)
+      !!              - py2 : second componante (defined at v point)
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxu1, pyu1   ! geographic vector componantes at u-point
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxv1, pyv1   ! geographic vector componantes at v-point
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point)
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point)
+      !!----------------------------------------------------------------------
+      
+      ! Change from geographic to stretched coordinate
+      ! ----------------------------------------------
+      CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 )
+      CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 )
+      
+   END SUBROUTINE repcmo
+
+
+   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.
+      !!
+      !! History :
+      !!   9.2  !  07-04  (S. Masson)  
+      !!                  (O. Marti ) Original code (repere and repcmo)
+      !!----------------------------------------------------------------------
+      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       ! specify the work to do:
+      !!                                                           ! 'en->i' east-north componantes to model i componante
+      !!                                                           ! 'en->j' east-north componantes to model j componante
+      !!                                                           ! 'ij->e' model i-j componantes to east componante
+      !!                                                           ! 'ij->n' model i-j componantes to east componante
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::   prot      
+      !!----------------------------------------------------------------------
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( lmust_init ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' rot_rep : geographic <--> stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~    coordinate transformation'
+         !
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+      ENDIF
+      
+      SELECT CASE (cdtodo)
+      CASE ('en->i')      ! 'en->i' est-north componantes to model i componante
+         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')      ! 'en->j' est-north componantes to model j componante
+         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')      ! 'ij->e' model i-j componantes to est componante
+         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')      ! 'ij->n' model i-j componantes to est componante
+         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  :
+      !!
+      !! ** 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
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj   ! dummy loop indices
+      INTEGER ::   ierr     ! local integer
+      REAL(wp) ::   &
+         zlam, zphi,            &  ! temporary scalars
+         zlan, zphh,            &  !    "         "
+         zxnpt, zynpt, znnpt,   &  ! x,y components and norm of the vector: T point to North Pole
+         zxnpu, zynpu, znnpu,   &  ! x,y components and norm of the vector: U point to North Pole
+         zxnpv, zynpv, znnpv,   &  ! x,y components and norm of the vector: V point to North Pole
+         zxnpf, zynpf, znnpf,   &  ! x,y components and norm of the vector: F point to North Pole
+         zxvvt, zyvvt, znvvt,   &  ! x,y components and norm of the vector: between V points below and above a T point
+         zxffu, zyffu, znffu,   &  ! x,y components and norm of the vector: between F points below and above a U point
+         zxffv, zyffv, znffv,   &  ! x,y components and norm of the vector: between F points left  and right a V point
+         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('STOP', 'angle_msh_geo: unable to allocate arrays' )
+
+      ! ============================= !
+      ! Compute the cosinus and sinus !
+      ! ============================= !
+      ! (computation done on the north stereographic polar plane)
+
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, jpi   ! vector opt.
+
+            ! north pole direction & modulous (at t-point)
+            zlam = glamt(ji,jj)
+            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
+
+            ! north pole direction & modulous (at u-point)
+            zlam = glamu(ji,jj)
+            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
+
+            ! north pole direction & modulous (at v-point)
+            zlam = glamv(ji,jj)
+            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
+
+            ! north pole direction & modulous (at f-point)
+            zlam = glamf(ji,jj)
+            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
+
+            ! j-direction: v-point segment direction (around t-point)
+            zlam = glamv(ji,jj  )
+            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 )
+
+            ! j-direction: f-point segment direction (around u-point)
+            zlam = glamf(ji,jj  )
+            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 )
+
+            ! i-direction: f-point segment direction (around v-point)
+            zlam = glamf(ji  ,jj)
+            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 )
+
+            ! j-direction: u-point segment direction (around f-point)
+            zlam = glamu(ji,jj+1)
+            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 scalar and vectorial 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
+
+            ! (caution, rotation of 90 degres)
+            gsinv(ji,jj) = ( zxnpv*zxffv + zynpv*zyffv ) / znffv
+            gcosv(ji,jj) =-( zxnpv*zyffv - zynpv*zxffv ) / znffv
+
+         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 wind stress from geocentric to east/north
+      !!
+      !! History :
+      !!        !         (O. Marti)  Original code
+      !!        !  91-03  (G. Madec)
+      !!        !  92-07  (M. Imbard)
+      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
+      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
+      !!   8.5  !  02-06  (G. Madec)  F90: Free form
+      !!   3.0  !  07-08  (G. Madec)  geo2oce suppress lon/lat agruments
+      !!----------------------------------------------------------------------
+      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('STOP', 'angle_msh_geo: 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
+!!$   ptv =   gcoslon(:,:,ig) * gcoslat(:,:,ig) * pxx    &
+!!$         + gsinlon(:,:,ig) * gcoslat(:,:,ig) * pyy    &
+!!$         + gsinlat(:,:,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( 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('STOP', 'angle_msh_geo: 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 repere ( px1, py1, px2, py2, kchoix, cd_type )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE repere  ***
+      !!        
+      !! ** Purpose :   Change vector componantes between a geopgraphic grid 
+      !!      and a stretched coordinates grid.
+      !!
+      !! ** Method  :   
+      !!
+      !! ** Action  :
+      !!
+      !! History :
+      !!        !  89-03  (O. Marti)  original code
+      !!        !  92-02  (M. Imbard)
+      !!        !  93-03  (M. Guyon)  symetrical conditions
+      !!        !  98-05  (B. Blanke)
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   px1, py1   ! two horizontal components to be rotated
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2, py2   ! the two horizontal components in the model repere
+      INTEGER , INTENT(in   )                     ::   kchoix     ! type of transformation
+      !                                                           ! = 1 change from geographic to model grid.
+      !                                                           ! =-1 change from model to geographic grid
+      CHARACTER(len=1), INTENT(in   ), OPTIONAL   ::   cd_type    ! define the nature of pt2d array grid-points
+      !
+      CHARACTER(len=1) ::   cl_type      ! define the nature of pt2d array grid-points (T point by default)
+      !!----------------------------------------------------------------------
+
+      cl_type = 'T'
+      IF( PRESENT(cd_type) )   cl_type = cd_type
+         !
+      SELECT CASE (kchoix)
+      CASE ( 1)      ! change from geographic to model grid.
+         CALL rot_rep( px1, py1, cl_type, 'en->i', px2 )
+         CALL rot_rep( px1, py1, cl_type, 'en->j', py2 )
+      CASE (-1)      ! change from model to geographic grid
+         CALL rot_rep( px1, py1, cl_type, 'ij->e', px2 )
+         CALL rot_rep( px1, py1, cl_type, 'ij->n', py2 )
+      CASE DEFAULT   ;   CALL ctl_stop( 'repere: Syntax Error in the definition of kchoix (1 OR -1' )
+      END SELECT
+      
+   END SUBROUTINE repere
+
+
+   SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE obs_rot  ***
+      !!
+      !! ** Purpose :   Copy gsinu, gcosu, gsinv and gsinv
+      !!                to input data for rotations of
+      !!                current at observation points
+      !!
+      !! History :
+      !!   9.2  !  09-02  (K. Mogensen)
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT )::   psinu, pcosu, psinv, pcosv   ! copy of data
+      !!----------------------------------------------------------------------
+
+      ! Initialization of gsin* and gcos* at first call
+      ! -----------------------------------------------
+
+      IF( lmust_init ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~   coordinate transformation'
+
+         CALL angle       ! initialization of the transformation
+         lmust_init = .FALSE.
+
+      ENDIF
+
+      psinu(:,:) = gsinu(:,:)
+      pcosu(:,:) = gcosu(:,:)
+      psinv(:,:) = gsinv(:,:)
+      pcosv(:,:) = gcosv(:,:)
+
+   END SUBROUTINE obs_rot
+
+  !!======================================================================
+END MODULE geo2ocean
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/oasis4_date.F90	(revision 3437)
@@ -0,0 +1,41 @@
+MODULE oasis4_date
+   !!======================================================================
+   !!                     ***  MODULE oasis_date  ***  
+   !!   Date and related information required to couple NEMO via OASIS4
+   !!   Made separate from cpl_oasis4 module to allow wider use.
+   !!======================================================================
+   !! History :  2.0  ! 2005-12  (R. Hill, Met. Office) Original code
+   !!----------------------------------------------------------------------
+#if defined key_oasis4
+   !!----------------------------------------------------------------------
+   !!   'key_oasis4'                                   coupled with OASIS-4
+   !!----------------------------------------------------------------------
+   !##################### WARNING coupled mode ###############################
+   !##################### WARNING coupled mode ###############################
+   !   Following line must be enabled if coupling with OASIS
+   !   USE PRISM
+   !##################### WARNING coupled mode ###############################
+   !##################### WARNING coupled mode ###############################
+
+   PRIVATE
+   IMPLICIT NONE
+
+   INTEGER, PUBLIC :: date_err, date_info   !: 
+
+   TYPE(PRISM_Time_struct), PUBLIC ::   dates            !: date info for send operation
+   TYPE(PRISM_Time_struct), PUBLIC ::   dates_bound(2)   !: date info for send operation
+   TYPE(PRISM_Time_struct), PUBLIC ::   dater            !: date info for receive operation
+   TYPE(PRISM_Time_struct), PUBLIC ::   dater_bound(2)   !: date info for receive operation
+   TYPE(PRISM_Time_struct), PUBLIC ::   tmpdate          !:
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option            Dummy module                   NO OASIS-4
+   !!----------------------------------------------------------------------
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE oasis4_date
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90	(revision 3437)
@@ -0,0 +1,146 @@
+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
+# if defined key_lim3
+   USE par_ice          ! LIM-3 parameters
+# endif
+# if defined key_lim2
+   USE par_ice_2        ! LIM-2 parameters
+# 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
+
+#if defined key_lim3 || defined key_lim2 
+   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   !: albedo of ice
+
+   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    !: 1st Qsr fraction penetrating inside ice cover    [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fr2_i0    !: 2nd Qsr fraction penetrating inside ice cover    [-]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice   !: sublimation-snow budget over ice             [kg/m2]
+
+# if defined key_lim3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice  !: air temperature
+# endif
+
+#elif defined key_cice
+   !
+   ! for consistency with LIM, these are declared with three dimensions
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qlw_ice            !: incoming long-wave
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qla_ice            !: latent flux over ice           [W/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice            !: solar heat flux over ice       [W/m2]
+   !
+   ! 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(:,:)   ::   emp_ice            !: sublimation-snow budget over ice    [kg/m2]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   tatm_ice           !: air temperature
+   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
+   !
+   ! finally, arrays corresponding to different ice categories
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   a_i                !: category ice fraction
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   topmelt           !: category topmelt
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   botmelt           !: category botmelt
+#endif
+
+   !!----------------------------------------------------------------------
+   !! 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  ***
+      !!----------------------------------------------------------------------
+#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)     ,     &
+         &      fr1_i0  (jpi,jpj)     , fr2_i0  (jpi,jpj)     ,     &
+#if defined key_lim3
+         &      emp_ice(jpi,jpj)      , tatm_ice(jpi,jpj)     , STAT= sbc_ice_alloc )
+#else
+         &      emp_ice(jpi,jpj)                              , STAT= sbc_ice_alloc )
+#endif
+#elif 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= sbc_ice_alloc )
+#endif
+         !
+      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
+   !!----------------------------------------------------------------------
+   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
+#endif
+
+   !!======================================================================
+END MODULE sbc_ice
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90	(revision 3437)
@@ -0,0 +1,160 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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_ana      = .FALSE.   !: analytical boundary condition flag
+   LOGICAL , PUBLIC ::   ln_flx      = .FALSE.   !: flux      formulation
+   LOGICAL , PUBLIC ::   ln_blk_clio = .FALSE.   !: CLIO bulk formulation
+   LOGICAL , PUBLIC ::   ln_blk_core = .FALSE.   !: CORE bulk formulation
+   LOGICAL , PUBLIC ::   ln_blk_mfs  = .FALSE.   !: MFS  bulk formulation
+   LOGICAL , PUBLIC ::   ln_cpl      = .FALSE.   !: coupled   formulation (overwritten by key_sbc_coupled )
+   LOGICAL , PUBLIC ::   ln_dm2dc    = .FALSE.   !: Daily mean to Diurnal Cycle short wave (qsr)
+   LOGICAL , PUBLIC ::   ln_rnf      = .FALSE.   !: runoffs / runoff mouths
+   LOGICAL , PUBLIC ::   ln_ssr      = .FALSE.   !: Sea Surface restoring on SST and/or SSS      
+   LOGICAL , PUBLIC ::   ln_apr_dyn  = .FALSE.   !: Atmospheric pressure forcing used on dynamics (ocean & ice)
+   INTEGER , PUBLIC ::   nn_ice      = 0         !: flag on ice in the surface boundary condition (=0/1/2/3)
+   INTEGER , PUBLIC ::   nn_fwb      = 0         !: FreshWater Budget: 
+   !                                             !:  = 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_cdgw     = .FALSE.   !: true if neutral drag coefficient read from wave model
+
+   !!----------------------------------------------------------------------
+   !!              Ocean Surface Boundary Condition fields
+   !!----------------------------------------------------------------------
+   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(:,:) ::   emps   , emps_b   !: freshwater budget: concentration/dillution   [Kg/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(:,:) ::   rnf    , rnf_b    !: river runoff   [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)
+#if defined key_cpl_carbon_cycle
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
+#endif
+
+   !!----------------------------------------------------------------------
+   !!                     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]
+
+   !! * 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(4)
+      !!---------------------------------------------------------------------
+      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) ,                        &
+         &      emps   (jpi,jpj) , emps_b(jpi,jpj) , emp_tot(jpi,jpj) , STAT=ierr(2) )
+         !
+      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
+         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
+         !
+      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
+#if defined key_cpl_carbon_cycle
+         &      atm_co2(jpi,jpj) ,                                        &
+#endif
+         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       &
+         &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )
+         !
+      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 ) 
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90	(revision 3437)
@@ -0,0 +1,317 @@
+MODULE sbcana
+   !!======================================================================
+   !!                       ***  MODULE  sbcana  ***
+   !! Ocean forcing:  analytical momentum, heat and freshwater forcings
+   !!=====================================================================
+   !! History :  3.0   ! 2006-06  (G. Madec)  Original code
+   !!            3.2   ! 2009-07  (G. Madec)  Style only
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_ana  : set an analytical ocean forcing
+   !!   sbc_gyre : set the GYRE configuration analytical forcing
+   !!----------------------------------------------------------------------
+   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   sbc_ana    ! routine called in sbcmod module
+   PUBLIC   sbc_gyre   ! routine called in sbcmod module
+
+   !                                !!* Namelist namsbc_ana *
+   INTEGER  ::   nn_tau000 = 1       ! nb of time-step during which the surface stress
+   !                                 ! increase from 0 to its nominal value 
+   REAL(wp) ::   rn_utau0  = 0._wp   ! constant wind stress value in i-direction
+   REAL(wp) ::   rn_vtau0  = 0._wp   ! constant wind stress value in j-direction
+   REAL(wp) ::   rn_qns0   = 0._wp   ! non solar heat flux
+   REAL(wp) ::   rn_qsr0   = 0._wp   !     solar heat flux
+   REAL(wp) ::   rn_emp0   = 0._wp   ! net freshwater flux
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_ana( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_ana ***
+      !!              
+      !! ** Purpose :   provide at each time-step the ocean surface boundary
+      !!              condition, i.e. the momentum, heat and freshwater fluxes.
+      !!
+      !! ** Method  :   Constant and uniform surface forcing specified from
+      !!              namsbc_ana namelist parameters. All the fluxes are time
+      !!              independant except the stresses which increase from zero
+      !!              during the first nn_tau000 time-step 
+      !!                CAUTION : never mask the surface stress field !
+      !!
+      !! ** Action  : - set the ocean surface boundary condition, i.e.  
+      !!                   utau, vtau, taum, wndm, qns, qsr, emp, emps
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time step
+      !
+      REAL(wp) ::   zfacto                ! local scalar
+      REAL(wp) ::   zrhoa  = 1.22_wp      ! Air density kg/m3
+      REAL(wp) ::   zcdrag = 1.5e-3_wp    ! drag coefficient
+      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
+      !!
+      NAMELIST/namsbc_ana/ nn_tau000, rn_utau0, rn_vtau0, rn_qns0, rn_qsr0, rn_emp0
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nit000 ) THEN
+         !
+         REWIND( numnam )                    ! Read Namelist namsbc : surface fluxes
+         READ  ( numnam, namsbc_ana )
+         !
+         IF(lwp) WRITE(numout,*)' '
+         IF(lwp) WRITE(numout,*)' sbc_ana : Constant surface fluxes read in namsbc_ana namelist'
+         IF(lwp) WRITE(numout,*)' ~~~~~~~ '
+         IF(lwp) WRITE(numout,*)'              spin up of the stress  nn_tau000 = ', nn_tau000, ' time-steps'
+         IF(lwp) WRITE(numout,*)'              constant i-stress      rn_utau0  = ', rn_utau0 , ' N/m2'
+         IF(lwp) WRITE(numout,*)'              constant j-stress      rn_vtau0  = ', rn_vtau0 , ' N/m2'
+         IF(lwp) WRITE(numout,*)'              non solar heat flux    rn_qns0   = ', rn_qns0  , ' W/m2'
+         IF(lwp) WRITE(numout,*)'              solar heat flux        rn_qsr0   = ', rn_qsr0  , ' W/m2'
+         IF(lwp) WRITE(numout,*)'              net heat flux          rn_emp0   = ', rn_emp0  , ' Kg/m2/s'
+         !
+         nn_tau000 = MAX( nn_tau000, 1 )     ! must be >= 1
+         !
+         qns (:,:) = rn_qns0
+         qsr (:,:) = rn_qsr0
+         emp (:,:) = rn_emp0
+         emps(:,:) = rn_emp0
+         !
+         utau(:,:) = rn_utau0
+         vtau(:,:) = rn_vtau0
+         taum(:,:) = SQRT ( rn_utau0 * rn_utau0 + rn_vtau0 * rn_vtau0 )
+         wndm(:,:) = SQRT ( taum(1,1) /  ( zrhoa * zcdrag ) )
+         !
+      ENDIF
+
+   
+      ! Increase the surface stress to its nominal value during the first nn_tau000 time-steps
+      IF( kt <= nn_tau000 ) THEN
+         zfacto = 0.5 * (  1. - COS( rpi * FLOAT( kt ) / FLOAT( nn_tau000 ) )  )
+         zcoef = 1. / ( zrhoa * zcdrag ) 
+         ztx = zfacto * rn_utau0
+         zty = zfacto * rn_vtau0
+         zmod = SQRT( ztx * ztx + zty * zty )
+         utau(:,:) = ztx
+         vtau(:,:) = zty
+         taum(:,:) = zmod
+         zmod = SQRT( zmod * zcoef )
+         wndm(:,:) = zmod
+      ENDIF
+      !
+   END SUBROUTINE sbc_ana
+
+
+   SUBROUTINE sbc_gyre( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_ana ***
+      !!              
+      !! ** 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, emps
+      !!
+      !! 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
+      emps(:,:) = emp(:,:)
+
+      ! Compute the emp flux such as its integration on the whole domain at each time is zero
+      IF( nbench /= 1 ) THEN
+         zsumemp = GLOB_SUM( emp(:,:) ) 
+         zsurf   = GLOB_SUM( tmask(:,:,1) ) 
+         ! Default GYRE configuration
+         zsumemp = zsumemp / zsurf
+      ELSE
+         ! Benchmark GYRE configuration (to allow the bit to bit comparison between Mpp/Mono case)
+         zsumemp = 0.e0   ;    zsurf = 0.e0
+      ENDIF
+
+      !salinity terms
+      emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)
+      emps(:,:) = emp(:,:)
+
+
+      ! ---------------------------- !
+      !       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 ) 
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         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,*)'sbc_gyre : 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 sbc_gyre
+
+   !!======================================================================
+END MODULE sbcana
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90	(revision 3437)
@@ -0,0 +1,168 @@
+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 obc_par         ! open boundary condition parameters
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition
+   USE dynspg_oce      ! surface pressure gradient variables
+   USE phycst          ! physical constants
+   USE fldread         ! read input fields
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! distribued memory computing library
+   USE iom             ! IOM library
+   USE lib_mpp         ! MPP library
+   USE restart         ! ocean restart
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_apr    ! routine called in sbcmod
+   
+   !                                         !!* namsbc_apr namelist (Atmospheric PRessure) *
+   LOGICAL, PUBLIC ::   ln_apr_obc = .FALSE.  !: inverse barometer added to OBC ssh data 
+   LOGICAL, PUBLIC ::   ln_ref_apr = .FALSE.  !: ref. pressure: global mean Patm (F) or a constant (F)
+
+   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) ::   rpref = 101000._wp   ! reference atmospheric pressure          [N/m2]
+   REAL(wp) ::   tarea                ! whole domain mean masked ocean surface
+   REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rau0)
+   
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 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 
+      REAL(wp)           ::   zpref   ! local scalar
+      !!
+      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read
+      !!
+      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr
+      !!----------------------------------------------------------------------
+      !
+      !
+      !                                         ! -------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
+         !                                      ! -------------------- !
+         !                                            !* set file information (default values)
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_apr = FLD_N( 'patm'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       )
+         cn_dir  = './'          ! directory in which the Patm data are 
+
+         REWIND( numnam )                             !* read in namlist namsbc_apr
+         READ  ( numnam, namsbc_apr ) 
+         !
+         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierror > 0 )   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( e1t(:,:) * e2t(:,:) )
+            IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2'
+         ELSE
+            IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rpref, ' N/m2'
+         ENDIF
+         !
+         r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization
+         !
+         !                                            !* control check
+         IF( ln_apr_obc  )   &
+            CALL ctl_stop( 'sbc_apr: inverse barometer added to OBC ssh data not yet implemented ' )
+         IF( ln_apr_obc .AND. .NOT. lk_obc )   &
+            CALL ctl_stop( 'sbc_apr: add inverse barometer to OBC requires to use key_obc' )
+         IF( ( ln_apr_obc ) .AND. .NOT. lk_dynspg_ts )   &
+            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY possible with time-splitting' )
+         IF( ( ln_apr_obc ) .AND. .NOT. ln_apr_dyn   )   &
+            CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' )
+      ENDIF
+
+      !                                         ! ========================== !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN      !    At each sbc time-step   !
+         !                                      ! ===========+++============ !
+         !
+         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields
+         !
+         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2
+         !
+         !                                                  !* update the reference atmospheric pressure (if necessary)
+         IF( ln_ref_apr )   rpref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1t(:,:) * e2t(:,:) ) / tarea
+         !
+         !                                                  !* Patm related forcing at kt
+         ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer)
+         apr   (:,:) =     sf_apr(1)%fnow(:,:,1)                        ! atmospheric pressure
+         !
+         CALL iom_put( "ssh_ib", ssh_ib )                   !* output the inverse barometer ssh
+      ENDIF
+
+      !                                         ! ---------------------------------------- !
+      IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !
+         !                                      ! ---------------------------------------- !
+         !                                            !* Restart: read in restart file
+         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh
+            !
+         ELSE                                         !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb set to nit000 values'
+            ssh_ibb(:,:) = ssh_ib(:,:)
+         ENDIF
+      ENDIF
+      !                                         ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !
+         !                                      ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )
+      ENDIF
+      !
+   END SUBROUTINE sbc_apr
+      
+   !!======================================================================
+END MODULE sbcapr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90	(revision 3437)
@@ -0,0 +1,981 @@
+MODULE sbcblk_clio
+   !!======================================================================
+   !!                   ***  MODULE  sbcblk_clio  ***
+   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
+   !!=====================================================================
+   !! History :  OPA  !  1997-06 (Louvain-La-Neuve)  Original code
+   !!                 !  2001-04 (C. Ethe) add flx_blk_declin
+   !!   NEMO     2.0  !  2002-08 (C. Ethe, G. Madec) F90: Free form and module
+   !!            3.0  !  2008-03 (C. Talandier, G. Madec) surface module + LIM3
+   !!            3.2  !  2009-04 (B. Lemaire) Introduce iom_put
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_blk_clio   : CLIO bulk formulation: read and update required input fields
+   !!   blk_clio_oce   : ocean CLIO bulk formulea: compute momentum, heat and freswater fluxes for the ocean
+   !!   blk_ice_clio   : ice   CLIO bulk formulea: compute momentum, heat and freswater fluxes for the sea-ice
+   !!   blk_clio_qsr_oce : shortwave radiation for ocean computed from the cloud cover
+   !!   blk_clio_qsr_ice : shortwave radiation for ice   computed from the cloud cover
+   !!   flx_blk_declin : solar declinaison
+   !!----------------------------------------------------------------------
+   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 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 albedo
+   USE prtctl          ! Print control
+#if defined key_lim3
+   USE ice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#elif defined key_lim2
+   USE ice_2
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_blk_clio        ! routine called by sbcmod.F90 
+   PUBLIC blk_ice_clio        ! routine called by sbcice_lim.F90 
+
+   INTEGER , PARAMETER ::   jpfld   = 7           ! maximum number of files to read 
+   INTEGER , PARAMETER ::   jp_utau = 1           ! index of wind stress (i-component)      (N/m2)    at U-point
+   INTEGER , PARAMETER ::   jp_vtau = 2           ! index of wind stress (j-component)      (N/m2)    at V-point
+   INTEGER , PARAMETER ::   jp_wndm = 3           ! index of 10m wind module                 (m/s)    at T-point
+   INTEGER , PARAMETER ::   jp_humi = 4           ! index of specific humidity               ( - )
+   INTEGER , PARAMETER ::   jp_ccov = 5           ! index of cloud cover                     ( - )
+   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin)
+   INTEGER , PARAMETER ::   jp_prec = 7           ! index of total precipitation (rain+snow) (Kg/m2/s)
+
+   TYPE(FLD),ALLOCATABLE,DIMENSION(:) :: sf  ! structure of input fields (file informations, fields read)
+
+   INTEGER, PARAMETER  ::   jpintsr = 24          ! number of time step between sunrise and sunset
+   !                                              ! uses for heat flux computation
+   LOGICAL ::   lbulk_init = .TRUE.               ! flag, bulk initialization done or not)
+
+#if ! defined key_lim3                          
+   ! in namicerun with LIM3
+   REAL(wp) ::   cai = 1.40e-3 ! best estimate of atm drag in order to get correct FS export in ORCA2-LIM
+   REAL(wp) ::   cao = 1.00e-3 ! chosen by default  ==> should depends on many things...  !!gmto be updated
+#endif
+
+   REAL(wp) ::   rdtbs2      !:   
+   
+   REAL(wp), DIMENSION(19)  ::  budyko            ! BUDYKO's coefficient (cloudiness effect on LW radiation)
+   DATA budyko / 1.00, 0.98, 0.95, 0.92, 0.89, 0.86, 0.83, 0.80, 0.78, 0.75,   &
+      &          0.72, 0.69, 0.67, 0.64, 0.61, 0.58, 0.56, 0.53, 0.50 /
+   REAL(wp), DIMENSION(20)  :: tauco              ! cloud optical depth coefficient
+   DATA tauco / 6.6, 6.6, 7.0, 7.2, 7.1, 6.8, 6.5, 6.6, 7.1, 7.6,   &
+      &         6.6, 6.1, 5.6, 5.5, 5.8, 5.8, 5.6, 5.6, 5.6, 5.6 /
+   !!
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sbudyko      ! cloudiness effect on LW radiation
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   stauc        ! cloud optical depth 
+   
+   REAL(wp) ::   eps20  = 1.e-20   ! constant values
+   
+   !! * 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 sbc_blk_clio( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_blk_clio  ***
+      !!                   
+      !! ** Purpose :   provide at each time step the surface ocean fluxes
+      !!      (momentum, heat, freshwater and runoff) 
+      !!
+      !! ** Method  : (1) READ each fluxes in NetCDF files:
+      !!      the i-component of the stress                (N/m2)
+      !!      the j-component of the stress                (N/m2)
+      !!      the 10m wind pseed module                    (m/s)
+      !!      the 10m air temperature                      (Kelvin)
+      !!      the 10m specific humidity                    (-)
+      !!      the cloud cover                              (-)
+      !!      the total precipitation (rain+snow)          (Kg/m2/s)
+      !!              (2) CALL blk_oce_clio
+      !!
+      !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the mesh referential
+      !!                      i.e. the (i,j) 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        10m wind module at T-point
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ifpr, jfpr   ! dummy indices
+      INTEGER  ::   ierr0, ierr1, ierr2, ierr3   ! return error code
+      !!
+      CHARACTER(len=100) ::  cn_dir                            !   Root directory for location of CLIO files
+      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read
+      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_wndm, sn_tair      ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_humi, sn_ccov, sn_prec               !   "                                 "
+      !!
+      NAMELIST/namsbc_clio/ cn_dir, sn_utau, sn_vtau, sn_wndm, sn_humi,   &
+         &                          sn_ccov, sn_tair, sn_prec
+      !!---------------------------------------------------------------------
+
+      !                                         ! ====================== !
+      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 !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_utau = FLD_N( 'utau'   ,    24     , 'utau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_vtau = FLD_N( 'vtau'   ,    24     , 'vtau'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_wndm = FLD_N( 'mwnd10m',    24     , 'm_10'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_ccov = FLD_N( 'ccover' ,    -1     , 'cloud'  ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       ) 
+
+         REWIND( numnam )                    ! ... read in namlist namsbc_clio
+         READ  ( numnam, namsbc_clio )
+
+         ! store namelist information in an array
+         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau   ;   slf_i(jp_wndm) = sn_wndm
+         slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi
+         slf_i(jp_ccov) = sn_ccov   ;   slf_i(jp_prec) = sn_prec
+         
+         ! set sf structure
+         ALLOCATE( sf(jpfld), STAT=ierr0 )
+         IF( ierr0 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate sf structure' )
+         DO ifpr= 1, jpfld
+            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) , STAT=ierr1)
+            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr2 )
+         END DO
+         IF( ierr1+ierr2 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate sf array structure' )
+         ! fill sf with slf_i and control print
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' )
+         
+         ! allocate sbcblk clio arrays
+         ALLOCATE( sbudyko(jpi,jpj) , stauc(jpi,jpj), STAT=ierr3 )
+         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_clio: unable to allocate arrays' )
+         !
+      ENDIF
+      !                                         ! ====================== !
+      !                                         !    At each time-step   !
+      !                                         ! ====================== !
+      !
+      CALL fld_read( kt, nn_fsbc, sf )                ! input fields provided at the current time-step
+      !
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_clio( sf, sst_m )
+      !
+   END SUBROUTINE sbc_blk_clio
+
+
+   SUBROUTINE blk_oce_clio( sf, pst )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_oce_clio  ***
+      !!                 
+      !!  ** Purpose :   Compute momentum, heat and freshwater fluxes at ocean surface
+      !!               using CLIO bulk formulea
+      !!         
+      !!  ** Method  :   The flux of heat at the ocean surfaces are derived
+      !!       from semi-empirical ( or bulk ) formulae which relate the flux to 
+      !!       the properties of the surface and of the lower atmosphere. Here, we
+      !!       follow the work of Oberhuber, 1988   
+      !!               - momentum flux (stresses) directly read in files at U- and V-points
+      !!               - compute ocean/ice albedos (call albedo_oce/albedo_ice)  
+      !!               - compute shortwave radiation for ocean (call blk_clio_qsr_oce)
+      !!               - compute long-wave radiation for the ocean
+      !!               - compute the turbulent heat fluxes over the ocean
+      !!               - deduce the evaporation over the ocean
+      !!  ** Action  :   Fluxes over the ocean:
+      !!               - 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, qsr    non-slor and solar heat flux
+      !!               - emp, emps   evaporation minus precipitation
+      !!  ** Nota    :   sf has to be a dummy argument for AGRIF on NEC
+      !!----------------------------------------------------------------------
+      TYPE(fld), INTENT(in), DIMENSION(:)       ::   sf    ! input data
+      REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) ::   pst   ! surface temperature                      [Celcius]
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      !!
+      REAL(wp) ::   zrhova, zcsho, zcleo, zcldeff               ! temporary scalars
+      REAL(wp) ::   zqsato, zdteta, zdeltaq, ztvmoy, zobouks    !    -         -
+      REAL(wp) ::   zpsims, zpsihs, zpsils, zobouku, zxins, zpsimu   !    -         -
+      REAL(wp) ::   zpsihu, zpsilu, zstab,zpsim, zpsih, zpsil   !    -         -
+      REAL(wp) ::   zvatmg, zcmn, zchn, zcln, zcmcmn, zdenum    !    -         -
+      REAL(wp) ::   zdtetar, ztvmoyr, zlxins, zchcm, zclcm      !    -         -
+      REAL(wp) ::   zmt1, zmt2, zmt3, ztatm3, ztamr, ztaevbk    !    -         -
+      REAL(wp) ::   zsst, ztatm, zcco1, zpatm, zcmax, zrmax     !    -         -
+      REAL(wp) ::   zrhoa, zev, zes, zeso, zqatm, zevsqr        !    -         -
+      REAL(wp) ::   ztx2, zty2                                  !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqlw        ! long-wave heat flux over ocean
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqla        ! latent heat flux over ocean
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zqsb        ! sensible heat flux over ocean
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_oce_clio')
+      !
+      CALL wrk_alloc( jpi,jpj, zqlw, zqla, zqsb )
+
+      zpatm = 101000._wp      ! atmospheric pressure  (assumed constant here)
+
+      !------------------------------------!
+      !   momentum fluxes  (utau, vtau )   !
+      !------------------------------------!
+!CDIR COLLAPSE
+      utau(:,:) = sf(jp_utau)%fnow(:,:,1)
+!CDIR COLLAPSE
+      vtau(:,:) = sf(jp_vtau)%fnow(:,:,1)
+
+      !------------------------------------!
+      !   wind stress module (taum )       !
+      !------------------------------------!
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
+            zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
+            taum(ji,jj) = 0.5 * SQRT( ztx2 * ztx2 + zty2 * zty2 )
+         END DO
+      END DO
+      CALL lbc_lnk( taum, 'T', 1. )
+
+      !------------------------------------!
+      !   store the wind speed  (wndm )    !
+      !------------------------------------!
+!CDIR COLLAPSE
+      wndm(:,:) = sf(jp_wndm)%fnow(:,:,1)
+
+      !------------------------------------------------!
+      !   Shortwave radiation for ocean and snow/ice   !
+      !------------------------------------------------!
+      
+      CALL blk_clio_qsr_oce( qsr )
+
+      !------------------------!
+      !   Other ocean fluxes   !
+      !------------------------!
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !
+            zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST
+            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land)
+            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover)
+            zrhoa = zpatm / ( 287.04 * ztatm )              ! air density (equation of state for dry air) 
+            ztamr = ztatm - rtt                             ! Saturation water vapour
+            zmt1  = SIGN( 17.269,  ztamr )                  !           ||
+            zmt2  = SIGN( 21.875,  ztamr )                  !          \  /
+            zmt3  = SIGN( 28.200, -ztamr )                  !           \/
+            zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev    = sf(jp_humi)%fnow(ji,jj,1) * zes        ! vapour pressure  
+            zevsqr = SQRT( zev * 0.01 )                     ! square-root of vapour pressure
+            zqatm = 0.622 * zev / ( zpatm - 0.378 * zev )   ! specific humidity 
+
+            !--------------------------------------!
+            !  long-wave radiation over the ocean  !  ( Berliand 1952 ; all latitudes )
+            !--------------------------------------!
+            ztatm3  = ztatm * ztatm * ztatm
+            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
+            ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr ) 
+            !
+            zqlw(ji,jj) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( zsst - ztatm ) ) 
+
+            !--------------------------------------------------
+            !  Latent and sensible heat fluxes over the ocean 
+            !--------------------------------------------------
+            !                                                          ! vapour pressure at saturation of ocean
+            zeso =  611.0 * EXP ( 17.2693884 * ( zsst - rtt ) * tmask(ji,jj,1) / ( zsst - 35.86 ) )
+
+            zqsato = ( 0.622 * zeso ) / ( zpatm - 0.378 * zeso )       ! humidity close to the ocean surface (at saturation)
+
+            ! Drag coefficients from Large and Pond (1981,1982)
+            !                                                          ! Stability parameters
+            zdteta  = zsst - ztatm
+            zdeltaq = zqatm - zqsato
+            ztvmoy  = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm )
+            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, eps20 )
+            zdtetar = zdteta / zdenum
+            ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum
+            !                                                          ! case of stable atmospheric conditions
+            zobouks = -70.0 * 10. * ( zdtetar + 3.2e-3 * ztvmoyr )
+            zobouks = MAX( 0.e0, zobouks )
+            zpsims = -7.0 * zobouks
+            zpsihs =  zpsims
+            zpsils =  zpsims
+            !                                                          ! case of unstable atmospheric conditions
+            zobouku = MIN(  0.e0, -100.0 * 10.0 * ( zdtetar + 2.2e-3 * ztvmoyr )  )
+            zxins   = ( 1. - 16. * zobouku )**0.25
+            zlxins  = LOG( ( 1. + zxins * zxins ) / 2. )
+            zpsimu  = 2. * LOG( ( 1 + zxins ) * 0.5 )  + zlxins - 2. * ATAN( zxins ) + rpi * 0.5
+            zpsihu  = 2. * zlxins
+            zpsilu  = zpsihu
+            !                                                          ! intermediate values
+            zstab   = MAX( 0.e0, SIGN( 1.e0, zdteta ) )
+            zpsim   = zstab * zpsimu + ( 1.0 - zstab ) * zpsims
+            zpsih   = zstab * zpsihu + ( 1.0 - zstab ) * zpsihs
+            zpsil   = zpsih
+            
+            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, eps20 )
+            zcmn           = vkarmn / LOG ( 10. / zvatmg )
+            zchn           = 0.0327 * zcmn
+            zcln           = 0.0346 * zcmn
+            zcmcmn         = 1. / ( 1. - zcmn * zpsim / vkarmn )
+            ! sometimes the ratio zchn * zpsih / ( vkarmn * zcmn ) is too close to 1 and zchcm becomes very very big
+            zcmax = 0.1               ! choice for maximum value of the heat transfer coefficient, guided by my intuition
+            zrmax = 1 - 3.e-4 / zcmax ! maximum value of the ratio
+            zchcm = zcmcmn / ( 1. - MIN ( zchn * zpsih / ( vkarmn * zcmn ) , zrmax ) )
+            zclcm          = zchcm
+            !                                                          ! transfert coef. (Large and Pond 1981,1982)
+            zcsho          = zchn * zchcm                                
+            zcleo          = zcln * zclcm 
+
+            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj,1)
+
+            ! sensible heat flux
+            zqsb(ji,jj) = zrhova * zcsho * 1004.0  * ( zsst - ztatm )  
+         
+            ! latent heat flux (bounded by zero)
+            zqla(ji,jj) = MAX(  0.e0, zrhova * zcleo * 2.5e+06 * ( zqsato - zqatm )  )
+            !               
+         END DO
+      END DO
+      
+      ! ----------------------------------------------------------------------------- !
+      !     III    Total FLUXES                                                       !
+      ! ----------------------------------------------------------------------------- !
+
+!CDIR COLLAPSE
+      emp (:,:) = zqla(:,:) / cevap - sf(jp_prec)%fnow(:,:,1) / rday * tmask(:,:,1)
+      qns (:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)         ! Downward Non Solar flux
+      emps(:,:) = emp(:,:)
+      !
+      CALL iom_put( "qlw_oce",   zqlw )   ! output downward longwave  heat over the ocean
+      CALL iom_put( "qsb_oce", - zqsb )   ! output downward sensible  heat over the ocean
+      CALL iom_put( "qla_oce", - zqla )   ! output downward latent    heat over the ocean
+      CALL iom_put( "qns_oce",   qns  )   ! output downward non solar heat over the ocean
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce_clio: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_clio: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce_clio: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
+         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce_clio: utau   : ', mask1=umask,   &
+            &         tab2d_2=vtau , clinfo2=' vtau : ', mask2=vmask )
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, zqlw, zqla, zqsb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_oce_clio')
+      !
+   END SUBROUTINE blk_oce_clio
+
+
+   SUBROUTINE blk_ice_clio(  pst   , palb_cs, palb_os ,       &
+      &                      p_taui, p_tauj, p_qns , p_qsr,   &
+      &                      p_qla , p_dqns, p_dqla,          &
+      &                      p_tpr , p_spr ,                  &
+      &                      p_fr1 , p_fr2 , cd_grid, pdim  )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_clio  ***
+      !!                 
+      !!  ** Purpose :   Computation of the heat fluxes at ocean and snow/ice
+      !!       surface the solar heat at ocean and snow/ice surfaces and the 
+      !!       sensitivity of total heat fluxes to the SST variations
+      !!         
+      !!  ** Method  :   The flux of heat at the ice and ocean surfaces are derived
+      !!       from semi-empirical ( or bulk ) formulae which relate the flux to 
+      !!       the properties of the surface and of the lower atmosphere. Here, we
+      !!       follow the work of Oberhuber, 1988   
+      !!
+      !!  ** Action  :   call albedo_oce/albedo_ice to compute ocean/ice albedo 
+      !!          computation of snow precipitation
+      !!          computation of solar flux at the ocean and ice surfaces
+      !!          computation of the long-wave radiation for the ocean and sea/ice
+      !!          computation of turbulent heat fluxes over water and ice
+      !!          computation of evaporation over water
+      !!          computation of total heat fluxes sensitivity over ice (dQ/dT)
+      !!          computation of latent heat flux sensitivity over ice (dQla/dT)
+      !!
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   pst      ! ice surface temperature                   [Kelvin]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_cs  ! ice albedo (clear    sky) (alb_ice_cs)         [%]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:)   ::   palb_os  ! ice albedo (overcast sky) (alb_ice_os)         [%]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_taui   ! surface ice stress at I-point (i-component) [N/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tauj   ! surface ice stress at I-point (j-component) [N/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qns    ! non solar heat flux over ice (T-point)      [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qsr    !     solar heat flux over ice (T-point)      [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_qla    ! latent    heat flux over ice (T-point)      [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqns   ! non solar heat sensistivity  (T-point)      [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:)   ::   p_dqla   ! latent    heat sensistivity  (T-point)      [W/m2]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_tpr    ! total precipitation          (T-point)   [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_spr    ! solid precipitation          (T-point)   [Kg/m2/s]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr1    ! 1sr fraction of qsr penetration in ice         [%]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   p_fr2    ! 2nd fraction of qsr penetration in ice         [%]
+      CHARACTER(len=1), INTENT(in   )             ::   cd_grid  ! type of sea-ice grid ("C" or "B" grid)
+      INTEGER, INTENT(in   )                      ::   pdim     ! number of ice categories
+      !!
+      INTEGER  ::   ji, jj, jl    ! dummy loop indices
+      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
+      !!
+      REAL(wp) ::   zcoef, zmt1, zmt2, zmt3, ztatm3     ! temporary scalars
+      REAL(wp) ::   ztaevbk, zind1, zind2, zind3, ztamr         !    -         -
+      REAL(wp) ::   zesi, zqsati, zdesidt                       !    -         -
+      REAL(wp) ::   zdqla, zcldeff, zev, zes, zpatm, zrhova     !    -         -
+      REAL(wp) ::   zcshi, zclei, zrhovaclei, zrhovacshi        !    -         -
+      REAL(wp) ::   ztice3, zticemb, zticemb2, zdqlw, zdqsb     !    -         -
+      !!
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   ztatm   ! Tair in Kelvin
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zqatm   ! specific humidity
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zevsqr  ! vapour pressure square-root
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   zrhoa   ! air density
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw, z_qsb
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_clio')
+      !
+      CALL wrk_alloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
+      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb )
+
+      ijpl  = pdim                           ! number of ice categories
+      zpatm = 101000.                        ! atmospheric pressure  (assumed constant  here)
+
+#if defined key_lim3      
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
+#endif
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      !------------------------------------!
+      !   momentum fluxes  (utau, vtau )   !
+      !------------------------------------!
+
+      SELECT CASE( cd_grid )
+      CASE( 'C' )                          ! C-grid ice dynamics
+         zcoef  = cai / cao                         ! Change from air-sea stress to air-ice stress
+         p_taui(:,:) = zcoef * utau(:,:)
+         p_tauj(:,:) = zcoef * vtau(:,:)
+      CASE( 'I' )                          ! I-grid ice dynamics:  I-point (i.e. F-point lower-left corner)
+         zcoef  = 0.5_wp * cai / cao                ! Change from air-sea stress to air-ice stress
+         DO jj = 2, jpj         ! stress from ocean U- and V-points to ice U,V point
+            DO ji = 2, jpi   ! I-grid : no vector opt.
+               p_taui(ji,jj) = zcoef * ( utau(ji-1,jj  ) + utau(ji-1,jj-1) )
+               p_tauj(ji,jj) = zcoef * ( vtau(ji  ,jj-1) + vtau(ji-1,jj-1) )
+            END DO
+         END DO
+         CALL lbc_lnk( p_taui(:,:), 'I', -1. )   ;   CALL lbc_lnk( p_tauj(:,:), 'I', -1. )   ! I-point
+      END SELECT
+
+
+      !  Determine cloud optical depths as a function of latitude (Chou et al., 1981).
+      !  and the correction factor for taking into account  the effect of clouds 
+      !------------------------------------------------------
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins 
+      
+            zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) )         ! air density (equation of state for dry air) 
+      
+            ztamr = ztatm(ji,jj) - rtt                               ! Saturation water vapour
+            zmt1  = SIGN( 17.269,  ztamr )
+            zmt2  = SIGN( 21.875,  ztamr )
+            zmt3  = SIGN( 28.200, -ztamr )
+            zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &
+               &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+
+            zev = sf(jp_humi)%fnow(ji,jj,1) * zes                    ! vapour pressure  
+            zevsqr(ji,jj) = SQRT( zev * 0.01 )                       ! square-root of vapour pressure
+            zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev )     ! specific humidity 
+
+            !----------------------------------------------------
+            !   Computation of snow precipitation (Ledley, 1985) |
+            !----------------------------------------------------
+            zmt1  =   253.0 - ztatm(ji,jj)            ;   zind1 = MAX( 0.e0, SIGN( 1.e0, zmt1 ) )
+            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) )
+            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) )
+            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s
+               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s]
+               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   &
+               &                                 + ( 1.0 - zind2 ) *  zind3 * zmt3  )   ) 
+
+            !----------------------------------------------------!
+            !  fraction of net penetrative shortwave radiation   !
+            !----------------------------------------------------!
+            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer
+            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
+            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1) 
+            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1)
+         END DO
+      END DO
+      CALL iom_put( 'snowpre', p_spr )   ! Snow precipitation 
+      
+      !-----------------------------------------------------------!
+      !  snow/ice Shortwave radiation   (abedo already computed)  !
+      !-----------------------------------------------------------!
+      CALL blk_clio_qsr_ice( palb_cs, palb_os, p_qsr )
+
+      !                                     ! ========================== !
+      DO jl = 1, ijpl                       !  Loop over ice categories  !
+         !                                  ! ========================== !
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+         DO jj = 1 , jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               !-------------------------------------------!
+               !  long-wave radiation over ice categories  !  ( Berliand 1952 ; all latitudes )
+               !-------------------------------------------!
+               ztatm3  = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj)
+               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)    
+               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) ) 
+               !
+               z_qlw(ji,jj,jl) = - emic * stefan * ( ztaevbk + 4. * ztatm3 * ( pst(ji,jj,jl) - ztatm(ji,jj) ) ) 
+
+               !----------------------------------------
+               !  Turbulent heat fluxes over snow/ice     ( Latent and sensible ) 
+               !----------------------------------------        
+
+               ! vapour pressure at saturation of ice (tmask to avoid overflow in the exponential)
+               zesi =  611.0 * EXP( 21.8745587 * tmask(ji,jj,1) * ( pst(ji,jj,jl) - rtt )/ ( pst(ji,jj,jl) - 7.66 ) )
+               ! humidity close to the ice surface (at saturation)
+               zqsati   = ( 0.622 * zesi ) / ( zpatm - 0.378 * zesi )
+               
+               !  computation of intermediate values
+               zticemb  = pst(ji,jj,jl) - 7.66
+               zticemb2 = zticemb * zticemb  
+               ztice3   = pst(ji,jj,jl) * pst(ji,jj,jl) * pst(ji,jj,jl)
+               zdesidt  = zesi * ( 9.5 * LOG( 10.0 ) * ( rtt - 7.66 )  / zticemb2 )
+               
+               !  Transfer cofficients assumed to be constant (Parkinson 1979 ; Maykut 1982)
+               zcshi    = 1.75e-03
+               zclei    = zcshi
+               
+               !  sensible and latent fluxes over ice
+               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1)      ! computation of intermediate values
+               zrhovaclei = zrhova * zcshi * 2.834e+06
+               zrhovacshi = zrhova * zclei * 1004.0
+            
+               !  sensible heat flux
+               z_qsb(ji,jj,jl) = zrhovacshi * ( pst(ji,jj,jl) - ztatm(ji,jj) )
+            
+               !  latent heat flux 
+               p_qla(ji,jj,jl) = MAX(  0.e0, zrhovaclei * ( zqsati - zqatm(ji,jj) )  )
+              
+               !  sensitivity of non solar fluxes (dQ/dT) (long-wave, sensible and latent fluxes)
+               zdqlw = 4.0 * emic * stefan * ztice3
+               zdqsb = zrhovacshi
+               zdqla = zrhovaclei * ( zdesidt * ( zqsati * zqsati / ( zesi * zesi ) ) * ( zpatm / 0.622 ) )   
+               !
+               p_dqla(ji,jj,jl) = zdqla                           ! latent flux sensitivity
+               p_dqns(ji,jj,jl) = -( zdqlw + zdqsb + zdqla )      !  total non solar sensitivity
+            END DO
+            !
+         END DO
+         !
+      END DO
+      !
+      ! ----------------------------------------------------------------------------- !
+      !    Total FLUXES                                                       !
+      ! ----------------------------------------------------------------------------- !
+      !
+!CDIR COLLAPSE
+      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux
+!CDIR COLLAPSE
+      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                     ! total precipitation [kg/m2/s]
+      !
+!!gm : not necessary as all input data are lbc_lnk...
+      CALL lbc_lnk( p_fr1  (:,:) , 'T', 1. )
+      CALL lbc_lnk( p_fr2  (:,:) , 'T', 1. )
+      DO jl = 1, ijpl
+         CALL lbc_lnk( p_qns (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( p_dqns(:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( p_qla (:,:,jl) , 'T', 1. )
+         CALL lbc_lnk( p_dqla(:,:,jl) , 'T', 1. )
+      END DO
+
+!!gm : mask is not required on forcing
+      DO jl = 1, ijpl
+         p_qns (:,:,jl) = p_qns (:,:,jl) * tmask(:,:,1)
+         p_qla (:,:,jl) = p_qla (:,:,jl) * tmask(:,:,1)
+         p_dqns(:,:,jl) = p_dqns(:,:,jl) * tmask(:,:,1)
+         p_dqla(:,:,jl) = p_dqla(:,:,jl) * tmask(:,:,1)
+      END DO
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=z_qsb  , clinfo1=' blk_ice_clio: z_qsb  : ', tab3d_2=z_qlw  , clinfo2=' z_qlw  : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=p_qla  , clinfo1=' blk_ice_clio: z_qla  : ', tab3d_2=p_qsr  , clinfo2=' p_qsr  : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=p_dqns , clinfo1=' blk_ice_clio: p_dqns : ', tab3d_2=p_qns  , clinfo2=' p_qns  : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=p_dqla , clinfo1=' blk_ice_clio: p_dqla : ', tab3d_2=pst    , clinfo2=' pst    : ', kdim=ijpl)
+         CALL prt_ctl(tab2d_1=p_tpr  , clinfo1=' blk_ice_clio: p_tpr  : ', tab2d_2=p_spr  , clinfo2=' p_spr  : ')
+         CALL prt_ctl(tab2d_1=p_taui , clinfo1=' blk_ice_clio: p_taui : ', tab2d_2=p_tauj , clinfo2=' p_tauj : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, ztatm, zqatm, zevsqr, zrhoa )
+      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_clio')
+      !
+   END SUBROUTINE blk_ice_clio
+
+
+   SUBROUTINE blk_clio_qsr_oce( pqsr_oce )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_clio_qsr_oce  ***
+      !!                 
+      !!  ** Purpose :   Computation of the shortwave radiation at the ocean and the
+      !!               snow/ice surfaces. 
+      !!         
+      !!  ** Method  : - computed qsr from the cloud cover for both ice and ocean 
+      !!               - also initialise sbudyko and stauc once for all 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj)     ::   pqsr_oce    ! shortwave radiation  over the ocean
+      !!
+      INTEGER, PARAMETER  ::   jp24 = 24   ! sampling of the daylight period (sunrise to sunset) into 24 equal parts
+      !!      
+      INTEGER  ::   ji, jj, jt    ! dummy loop indices 
+      INTEGER  ::   indaet            !  = -1, 0, 1 for odd, normal and leap years resp.
+      INTEGER  ::   iday              ! integer part of day
+      INTEGER  ::   indxb, indxc      ! index for cloud depth coefficient
+
+      REAL(wp)  ::   zalat , zclat, zcmue, zcmue2    ! local scalars 
+      REAL(wp)  ::   zmt1, zmt2, zmt3                ! 
+      REAL(wp)  ::   zdecl, zsdecl , zcdecl          ! 
+      REAL(wp)  ::   za_oce, ztamr                   !
+
+      REAL(wp) ::   zdl, zlha                        ! local scalars
+      REAL(wp) ::   zlmunoon, zcldcor, zdaycor       !   
+      REAL(wp) ::   zxday, zdist, zcoef, zcoef1      !
+      REAL(wp) ::   zes
+      
+      REAL(wp), DIMENSION(:,:), POINTER ::   zev          ! vapour pressure
+      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset     ! 2D workspace
+      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_clio_qsr_oce')
+      !
+      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc )
+
+      IF( lbulk_init ) THEN             !   Initilization at first time step only
+         rdtbs2 = nn_fsbc * rdt * 0.5
+         ! cloud optical depths as a function of latitude (Chou et al., 1981).
+         ! and the correction factor for taking into account  the effect of clouds 
+         DO jj = 1, jpj
+            DO ji = 1 , jpi
+               zalat          = ( 90.e0 - ABS( gphit(ji,jj) ) ) /  5.e0
+               zclat          = ( 95.e0 -      gphit(ji,jj)   ) / 10.e0
+               indxb          = 1 + INT( zalat )
+               indxc          = 1 + INT( zclat )
+               zdl            = zclat - INT( zclat )
+               !  correction factor to account for the effect of clouds
+               sbudyko(ji,jj) = budyko(indxb)
+               stauc  (ji,jj) = ( 1.e0 - zdl ) * tauco( indxc ) + zdl * tauco( indxc + 1 )
+            END DO
+         END DO
+         lbulk_init = .FALSE.
+      ENDIF
+
+
+      ! Saturated water vapour and vapour pressure
+      ! ------------------------------------------
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt
+            zmt1  = SIGN( 17.269,  ztamr )
+            zmt2  = SIGN( 21.875,  ztamr )
+            zmt3  = SIGN( 28.200, -ztamr )
+            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
+         END DO
+      END DO
+
+      !-----------------------------------!
+      !  Computation of solar irradiance  !
+      !-----------------------------------!
+!!gm : hard coded  leap year ???
+      indaet   = 1                                    ! = -1, 0, 1 for odd, normal and leap years resp.
+      zxday = nday_year + rdtbs2 / rday               ! day of the year at which the fluxes are calculated
+      iday  = INT( zxday )                            ! (centred at the middle of the ice time step)
+      CALL flx_blk_declin( indaet, iday, zdecl )      ! solar declination of the current day
+      zsdecl = SIN( zdecl * rad )                     ! its sine
+      zcdecl = COS( zdecl * rad )                     ! its cosine
+
+
+      !  correction factor added for computation of shortwave flux to take into account the variation of
+      !  the distance between the sun and the earth during the year (Oberhuber 1988)
+      zdist    = zxday * 2. * rpi / REAL(nyear_len(1), wp)
+      zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !  product of sine (cosine) of latitude and sine (cosine) of solar declination
+            zps(ji,jj) = SIN( gphit(ji,jj) * rad ) * zsdecl
+            zpc(ji,jj) = COS( gphit(ji,jj) * rad ) * zcdecl
+            !  computation of the both local time of sunrise and sunset
+            zlsrise(ji,jj) = ACOS( - SIGN( 1.e0, zps(ji,jj) )    &
+               &                   * MIN(  1.e0, SIGN( 1.e0, zps(ji,jj) ) * ( zps(ji,jj) / zpc(ji,jj) )  )   )
+            zlsset (ji,jj) = - zlsrise(ji,jj)
+            !  dividing the solar day into jp24 segments of length zdlha
+            zdlha  (ji,jj) = ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jp24, wp )
+         END DO
+      END DO
+
+
+      !---------------------------------------------!
+      !  shortwave radiation absorbed by the ocean  !
+      !---------------------------------------------!
+      pqsr_oce(:,:)   = 0.e0      ! set ocean qsr to zero      
+
+      ! compute and sum ocean qsr over the daylight (i.e. between sunrise and sunset)
+!CDIR NOVERRCHK   
+      DO jt = 1, jp24
+         zcoef = FLOAT( jt ) - 0.5
+!CDIR NOVERRCHK     
+!CDIR COLLAPSE
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
+               zcmue              = MAX( 0.e0 ,   zps(ji,jj) + zpc(ji,jj) * zlha  )   ! cos of local solar altitude
+               zcmue2             = 1368.0 * zcmue * zcmue
+
+               ! ocean albedo depending on the cloud cover (Payne, 1972)
+               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky
+                  &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast
+
+                  ! solar heat flux absorbed by the ocean (Zillman, 1972)
+               pqsr_oce(ji,jj) = pqsr_oce(ji,jj)                                         &
+                  &            + ( 1.0 - za_oce ) * zdlha(ji,jj) * zcmue2                &
+                  &            / ( ( zcmue + 2.7 ) * zev(ji,jj) + 1.085 * zcmue +  0.10 )
+            END DO
+         END DO
+      END DO
+      ! Taking into account the ellipsity of the earth orbit, the clouds AND masked if sea-ice cover > 0%
+      zcoef1 = srgamma * zdaycor / ( 2. * rpi )
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad                         ! local noon solar altitude
+            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &     ! cloud correction (Reed 1977)
+               &                          + 0.0019 * zlmunoon )                 )
+            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)    ! and zcoef1: ellipsity
+         END DO
+      END DO
+
+      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_clio_qsr_oce')
+      !
+   END SUBROUTINE blk_clio_qsr_oce
+
+
+   SUBROUTINE blk_clio_qsr_ice( pa_ice_cs, pa_ice_os, pqsr_ice )
+      !!---------------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_clio_qsr_ice  ***
+      !!                 
+      !!  ** Purpose :   Computation of the shortwave radiation at the ocean and the
+      !!               snow/ice surfaces. 
+      !!         
+      !!  ** Method  : - computed qsr from the cloud cover for both ice and ocean 
+      !!               - also initialise sbudyko and stauc once for all 
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_cs   ! albedo of ice under clear sky
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pa_ice_os   ! albedo of ice under overcast sky
+      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pqsr_ice    ! shortwave radiation over the ice/snow
+      !!
+      INTEGER, PARAMETER  ::   jp24 = 24   ! sampling of the daylight period (sunrise to sunset) into 24 equal parts
+      !!
+      INTEGER  ::   ji, jj, jl, jt    ! dummy loop indices
+      INTEGER  ::   ijpl              ! number of ice categories (3rd dim of pqsr_ice)
+      INTEGER  ::   indaet            !  = -1, 0, 1 for odd, normal and leap years resp.
+      INTEGER  ::   iday              ! integer part of day
+      !!
+      REAL(wp) ::   zcmue, zcmue2, ztamr          ! temporary scalars 
+      REAL(wp) ::   zmt1, zmt2, zmt3              !    -         -
+      REAL(wp) ::   zdecl, zsdecl, zcdecl         !    -         -
+      REAL(wp) ::   zlha, zdaycor, zes            !    -         -
+      REAL(wp) ::   zxday, zdist, zcoef, zcoef1   !    -         -
+      REAL(wp) ::   zqsr_ice_cs, zqsr_ice_os      !    -         -
+
+      REAL(wp), DIMENSION(:,:), POINTER ::   zev                      ! vapour pressure
+      REAL(wp), DIMENSION(:,:), POINTER ::   zdlha, zlsrise, zlsset   ! 2D workspace
+      REAL(wp), DIMENSION(:,:), POINTER ::   zps, zpc   ! sine (cosine) of latitude per sine (cosine) of solar declination 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_clio_qsr_ice')
+      !
+      CALL wrk_alloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc )
+
+      ijpl = SIZE(pqsr_ice, 3 )      ! number of ice categories
+      
+      ! Saturated water vapour and vapour pressure
+      ! ------------------------------------------
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi           
+            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt           
+            zmt1  = SIGN( 17.269,  ztamr )
+            zmt2  = SIGN( 21.875,  ztamr )
+            zmt3  = SIGN( 28.200, -ztamr )
+            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour
+               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  )
+            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                 ! vapour pressure  
+         END DO
+      END DO
+
+      !-----------------------------------!
+      !  Computation of solar irradiance  !
+      !-----------------------------------!
+!!gm : hard coded  leap year ???
+      indaet   = 1                                    ! = -1, 0, 1 for odd, normal and leap years resp.
+      zxday = nday_year + rdtbs2 / rday               ! day of the year at which the fluxes are calculated
+      iday  = INT( zxday )                            ! (centred at the middle of the ice time step)
+      CALL flx_blk_declin( indaet, iday, zdecl )      ! solar declination of the current day
+      zsdecl = SIN( zdecl * rad )                     ! its sine
+      zcdecl = COS( zdecl * rad )                     ! its cosine
+
+      
+      !  correction factor added for computation of shortwave flux to take into account the variation of
+      !  the distance between the sun and the earth during the year (Oberhuber 1988)
+      zdist    = zxday * 2. * rpi / REAL(nyear_len(1), wp)
+      zdaycor  = 1.0 + 0.0013 * SIN( zdist ) + 0.0342 * COS( zdist )
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !  product of sine (cosine) of latitude and sine (cosine) of solar declination
+            zps(ji,jj) = SIN( gphit(ji,jj) * rad ) * zsdecl
+            zpc(ji,jj) = COS( gphit(ji,jj) * rad ) * zcdecl
+            !  computation of the both local time of sunrise and sunset
+            zlsrise(ji,jj) = ACOS( - SIGN( 1.e0, zps(ji,jj) )    &
+               &                   * MIN(  1.e0, SIGN( 1.e0, zps(ji,jj) ) * ( zps(ji,jj) / zpc(ji,jj) )  )   ) 
+            zlsset (ji,jj) = - zlsrise(ji,jj)
+            !  dividing the solar day into jp24 segments of length zdlha
+            zdlha  (ji,jj) = ( zlsrise(ji,jj) - zlsset(ji,jj) ) / REAL( jp24, wp )
+         END DO
+      END DO
+
+
+      !---------------------------------------------!
+      !  shortwave radiation absorbed by the ice    !
+      !---------------------------------------------!
+      ! compute and sum ice qsr over the daylight for each ice categories
+      pqsr_ice(:,:,:) = 0.e0
+      zcoef1 = zdaycor / ( 2. * rpi )       ! Correction for the ellipsity of the earth orbit
+      
+      !                    !----------------------------! 
+      DO jl = 1, ijpl      !  loop over ice categories  !
+         !                 !----------------------------! 
+!CDIR NOVERRCHK   
+         DO jt = 1, jp24   
+            zcoef = FLOAT( jt ) - 0.5
+!CDIR NOVERRCHK     
+!CDIR COLLAPSE
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  zlha = COS(  zlsrise(ji,jj) - zcoef * zdlha(ji,jj)  )                  ! local hour angle
+                  zcmue              = MAX( 0.e0 ,   zps(ji,jj) + zpc(ji,jj) * zlha  )   ! cos of local solar altitude
+                  zcmue2             = 1368.0 * zcmue * zcmue
+                  
+                  !  solar heat flux absorbed by the ice/snow system (Shine and Crane 1984 adapted to high albedo) 
+                  zqsr_ice_cs =  ( 1.0 - pa_ice_cs(ji,jj,jl) ) * zdlha(ji,jj) * zcmue2        &   ! clear sky
+                     &        / ( ( 1.0 + zcmue ) * zev(ji,jj) + 1.2 * zcmue + 0.0455 )
+                  zqsr_ice_os = zdlha(ji,jj) * SQRT( zcmue )                                  &   ! overcast sky
+                     &        * ( 53.5 + 1274.5 * zcmue )      * ( 1.0 - 0.996  * pa_ice_os(ji,jj,jl) )    &
+                     &        / (  1.0 + 0.139  * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) )       
+             
+                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs    &
+                     &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  )
+               END DO
+            END DO
+         END DO
+         !
+         ! Correction : Taking into account the ellipsity of the earth orbit
+         pqsr_ice(:,:,jl) = pqsr_ice(:,:,jl) * zcoef1 * tmask(:,:,1)
+         !
+         !                 !--------------------------------! 
+      END DO               !  end loop over ice categories  !
+      !                    !--------------------------------! 
+
+
+!!gm  : this should be suppress as input data have been passed through lbc_lnk
+      DO jl = 1, ijpl
+         CALL lbc_lnk( pqsr_ice(:,:,jl) , 'T', 1. )
+      END DO
+      !
+      CALL wrk_dealloc( jpi,jpj, zev, zdlha, zlsrise, zlsset, zps, zpc )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_clio_qsr_ice')
+      !
+   END SUBROUTINE blk_clio_qsr_ice
+
+
+   SUBROUTINE flx_blk_declin( ky, kday, pdecl )
+      !!---------------------------------------------------------------------------
+      !!               ***  ROUTINE flx_blk_declin  ***
+      !!          
+      !! ** Purpose :   Computation of the solar declination for the day
+      !!       
+      !! ** Method  :   ???
+      !!---------------------------------------------------------------------
+      INTEGER , INTENT(in   ) ::   ky      ! = -1, 0, 1 for odd, normal and leap years resp.
+      INTEGER , INTENT(in   ) ::   kday    ! day of the year ( kday = 1 on january 1)
+      REAL(wp), INTENT(  out) ::   pdecl   ! solar declination
+      !!
+      REAL(wp) ::   a0  =  0.39507671      ! coefficients for solar declinaison computation
+      REAL(wp) ::   a1  = 22.85684301      !     "              ""                 "
+      REAL(wp) ::   a2  = -0.38637317      !     "              ""                 "
+      REAL(wp) ::   a3  =  0.15096535      !     "              ""                 "
+      REAL(wp) ::   a4  = -0.00961411      !     "              ""                 "
+      REAL(wp) ::   b1  = -4.29692073      !     "              ""                 "
+      REAL(wp) ::   b2  =  0.05702074      !     "              ""                 "
+      REAL(wp) ::   b3  = -0.09028607      !     "              ""                 "
+      REAL(wp) ::   b4  =  0.00592797
+      !!
+      REAL(wp) ::   zday   ! corresponding day of type year (cf. ky)
+      REAL(wp) ::   zp     ! temporary scalars
+      !!---------------------------------------------------------------------
+            
+      IF    ( ky == 1 )  THEN   ;   zday = REAL( kday, wp ) - 0.5
+      ELSEIF( ky == 3 )  THEN   ;   zday = REAL( kday, wp ) - 1.
+      ELSE                      ;   zday = REAL( kday, wp )
+      ENDIF
+      
+      zp = rpi * ( 2.0 * zday - 367.0 ) / REAL(nyear_len(1), wp)
+      
+      pdecl  = a0                                                                      &
+         &   + a1 * COS( zp ) + a2 * COS( 2. * zp ) + a3 * COS( 3. * zp ) + a4 * COS( 4. * zp )   &
+         &   + b1 * SIN( zp ) + b2 * SIN( 2. * zp ) + b3 * SIN( 3. * zp ) + b4 * SIN( 4. * zp )
+      !
+   END SUBROUTINE flx_blk_declin
+
+   !!======================================================================
+END MODULE sbcblk_clio
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90	(revision 3437)
@@ -0,0 +1,950 @@
+MODULE sbcblk_core
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_core  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (U. Schweckendiek)  Original code
+   !!            2.0  !  2005-04  (L. Brodeau, A.M. Treguier) additions: 
+   !!                           -  new bulk routine for efficiency
+   !!                           -  WINDS ARE NOW ASSUMED TO BE AT T POINTS in input files !!!!
+   !!                           -  file names and file characteristics in namelist 
+   !!                           -  Implement reading of 6-hourly fields   
+   !!            3.0  !  2006-06  (G. Madec) sbc rewritting   
+   !!             -   !  2006-12  (L. Brodeau) Original code for TURB_CORE_2Z
+   !!            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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_blk_core  : bulk formulation as ocean surface boundary condition
+   !!                   (forced mode, CORE bulk formulea)
+   !!   blk_oce_core  : ocean: computes momentum, heat and freshwater fluxes
+   !!   blk_ice_core  : ice  : computes momentum, heat and freshwater fluxes
+   !!   turb_core     : computes the CORE turbulent transfer coefficients 
+   !!----------------------------------------------------------------------
+   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 sbcdcy          ! surface boundary condition: diurnal cycle
+   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
+   USE sbcwave,ONLY :  cdn_wave !wave module 
+#if defined key_lim3 || defined key_cice
+   USE sbc_ice         ! Surface boundary condition: ice fields
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_blk_core         ! routine called in sbcmod module
+   PUBLIC   blk_ice_core         ! routine called in sbc_ice_lim module
+   PUBLIC   turb_core_2z         ! routine calles in sbcblk_mfs module
+
+   INTEGER , PARAMETER ::   jpfld   = 9           ! 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_humi = 3           ! index of specific humidity               ( - )
+   INTEGER , PARAMETER ::   jp_qsr  = 4           ! index of solar heat                      (W/m2)
+   INTEGER , PARAMETER ::   jp_qlw  = 5           ! index of Long wave                       (W/m2)
+   INTEGER , PARAMETER ::   jp_tair = 6           ! index of 10m air temperature             (Kelvin)
+   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_tdif = 9           ! 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)
+         
+   !                                             !!! CORE bulk parameters
+   REAL(wp), PARAMETER ::   rhoa =    1.22        ! air density
+   REAL(wp), PARAMETER ::   cpa  = 1000.5         ! specific heat of air
+   REAL(wp), PARAMETER ::   Lv   =    2.5e6       ! latent heat of vaporization
+   REAL(wp), PARAMETER ::   Ls   =    2.839e6     ! latent heat of sublimation
+   REAL(wp), PARAMETER ::   Stef =    5.67e-8     ! Stefan Boltzmann constant
+   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice
+   REAL(wp), PARAMETER ::   albo =    0.066       ! ocean albedo assumed to be contant
+
+   !                                  !!* Namelist namsbc_core : CORE bulk parameters
+   LOGICAL  ::   ln_2m     = .FALSE.   ! logical flag for height of air temp. and hum
+   LOGICAL  ::   ln_taudif = .FALSE.   ! logical flag to use the "mean of stress module - module of mean stress" data
+   REAL(wp) ::   rn_pfac   = 1.        ! multiplication factor for precipitation
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_blk_core( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_blk_core  ***
+      !!                   
+      !! ** 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 specific humidity               ( - )
+      !!      the solar heat                      (W/m2)
+      !!      the Long wave                       (W/m2)
+      !!      the 10m air temperature             (Kelvin)
+      !!      the total precipitation (rain+snow) (Kg/m2/s)
+      !!      the snow (solid prcipitation)       (kg/m2/s)
+      !!   OPTIONAL parameter (see ln_taudif namelist flag):
+      !!      the tau diff associated to HF tau   (N/m2)   at T-point 
+      !!              (2) CALL blk_oce_core
+      !!
+      !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the mesh referential
+      !!                      i.e. the (i,j) 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        10m wind module at T-point
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ierror   ! return error code
+      INTEGER  ::   ifpr     ! dummy loop indice
+      INTEGER  ::   jfld     ! dummy loop arguments
+      !!
+      CHARACTER(len=100) ::  cn_dir   !   Root directory for location of core 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_tdif                                 !   "                                 "
+      NAMELIST/namsbc_core/ cn_dir , ln_2m  , ln_taudif, rn_pfac,           &
+         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           &
+         &                  sn_qlw , sn_tair, sn_prec  , sn_snow, sn_tdif
+      !!---------------------------------------------------------------------
+
+      !                                         ! ====================== !
+      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 !
+         !            !    name    !  (hours)  !  name    !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_wndi = FLD_N( 'uwnd10m',    24     , 'u_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_wndj = FLD_N( 'vwnd10m',    24     , 'v_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qsr  = FLD_N( 'qsw'    ,    24     , 'qsw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_qlw  = FLD_N( 'qlw'    ,    24     , 'qlw'    ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_tair = FLD_N( 'tair10m',    24     , 't_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_humi = FLD_N( 'humi10m',    24     , 'q_10'   ,  .false.   , .false. ,   'yearly'  , ''       , ''       )
+         sn_prec = FLD_N( 'precip' ,    -1     , 'precip' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_snow = FLD_N( 'snow'   ,    -1     , 'snow'   ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         sn_tdif = FLD_N( 'taudif' ,    24     , 'taudif' ,  .true.    , .false. ,   'yearly'  , ''       , ''       )
+         !
+         REWIND( numnam )                          ! read in namlist namsbc_core
+         READ  ( numnam, namsbc_core )
+         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
+         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   & 
+            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
+         IF( ln_dm2dc .AND. sn_qsr%ln_tint ) THEN
+            CALL ctl_warn( 'sbc_blk_core: ln_dm2dc is taking care of the temporal interpolation of daily qsr',   &
+                 &         '              ==> We force time interpolation = .false. for qsr' )
+            sn_qsr%ln_tint = .false.
+         ENDIF
+         !                                         ! store namelist information in an array
+         slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
+         slf_i(jp_qsr ) = sn_qsr    ;   slf_i(jp_qlw ) = sn_qlw
+         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_tdif) = sn_tdif
+         !                 
+         lhftau = ln_taudif                        ! do we use HF tau information?
+         jfld = jpfld - COUNT( (/.NOT. lhftau/) )
+         !
+         ALLOCATE( sf(jfld), STAT=ierror )         ! set sf structure
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_blk_core: 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 sf with slf_i and control print
+         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulation for ocean surface boundary condition', 'namsbc_core' )
+         !
+      ENDIF
+
+      CALL fld_read( kt, nn_fsbc, sf )        ! input fields provided at the current time-step
+
+      !                                                        ! surface ocean fluxes computed with CLIO bulk formulea
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )
+
+#if defined key_cice
+      IF( MOD( kt - 1, nn_fsbc ) == 0 )   THEN
+         qlw_ice(:,:,1)   = sf(jp_qlw)%fnow(:,:,1) 
+         qsr_ice(:,:,1)   = sf(jp_qsr)%fnow(:,:,1)
+         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_core
+   
+   
+   SUBROUTINE blk_oce_core( sf, pst, pu, pv )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_core  ***
+      !!
+      !! ** Purpose :   provide the momentum, heat and freshwater fluxes at
+      !!      the ocean surface at each time step
+      !!
+      !! ** Method  :   CORE 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)
+      !!              - evap    : Evaporation over the ocean            (kg/m2/s)
+      !!              - emp(s)  : evaporation minus precipitation       (kg/m2/s)
+      !!
+      !!  ** Nota  :   sf has to be a dummy argument for AGRIF on NEC
+      !!---------------------------------------------------------------------
+      TYPE(fld), INTENT(in), 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) ::   zcoef_qsatw, zztmp   ! local variable
+      REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point
+      REAL(wp), DIMENSION(:,:), POINTER ::   zqsatw            ! 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
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_oce_core')
+      !
+      CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap )
+      CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      !
+      ! local scalars ( place there for vector optimisation purposes)
+      zcoef_qsatw = 0.98 * 640380. / rhoa
+      
+      zst(:,:) = pst(:,:) + rt0      ! converte 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)
+      zwnd_i(:,:) = 0.e0  
+      zwnd_j(:,:) = 0.e0
+#if defined key_vectopt_loop
+!CDIR COLLAPSE
+#endif
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vect. opt.
+            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  )
+            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  )
+         END DO
+      END DO
+      CALL lbc_lnk( zwnd_i(:,:) , 'T', -1. )
+      CALL lbc_lnk( zwnd_j(:,:) , 'T', -1. )
+      ! ... scalar wind ( = | U10m - U_oce | ) at T-point (masked)
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      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
+!CDIR COLLAPSE
+      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave
+      ! ----------------------------------------------------------------------------- !
+      !     II    Turbulent FLUXES                                                    !
+      ! ----------------------------------------------------------------------------- !
+
+      ! ... specific humidity at SST and IST
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+      zqsatw(:,:) = zcoef_qsatw * EXP( -5107.4 / zst(:,:) ) 
+
+      ! ... NCAR Bulk formulae, computation of Cd, Ch, Ce at T-point :
+      IF( ln_2m ) THEN
+         !! If air temp. and spec. hum. are given at different height (2m) than wind (10m) :
+         CALL TURB_CORE_2Z(2.,10., zst   , sf(jp_tair)%fnow,         &
+            &                      zqsatw, sf(jp_humi)%fnow, wndm,   &
+            &                      Cd    , Ch              , Ce  ,   &
+            &                      zt_zu , zq_zu                   )
+      ELSE
+         !! If air temp. and spec. hum. are given at same height than wind (10m) :
+!gm bug?  at the compiling phase, add a copy in temporary arrays...  ==> check perf
+!         CALL TURB_CORE_1Z( 10., zst   (:,:), sf(jp_tair)%fnow(:,:),              &
+!            &                    zqsatw(:,:), sf(jp_humi)%fnow(:,:), wndm(:,:),   &
+!            &                    Cd    (:,:),             Ch  (:,:), Ce  (:,:)  )
+!gm bug
+! ARPDBG - this won't compile with gfortran. Fix but check performance
+! as per comment above.
+         CALL TURB_CORE_1Z( 10., zst   , sf(jp_tair)%fnow(:,:,1),       &
+            &                    zqsatw, sf(jp_humi)%fnow(:,:,1), wndm, &
+            &                    Cd    , Ch              , Ce    )
+      ENDIF
+
+      ! ... tau module, i and j component
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zztmp = rhoa * wndm(ji,jj) * Cd(ji,jj)
+            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 ) THEN 
+!CDIR COLLAPSE
+         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1)
+      ENDIF
+      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
+      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  ) )
+            vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( zwnd_j(ji,jj) + zwnd_j(ji  ,jj+1) )
+         END DO
+      END DO
+      CALL lbc_lnk( utau(:,:), 'U', -1. )
+      CALL lbc_lnk( vtau(:,:), 'V', -1. )
+
+      !  Turbulent fluxes over ocean
+      ! -----------------------------
+      IF( ln_2m ) THEN
+         ! Values of temp. and hum. adjusted to 10m must be used instead of 2m values
+         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - zq_zu(:,:) ) * wndm(:,:) )   ! Evaporation
+         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - zt_zu(:,:) ) * wndm(:,:)     ! Sensible Heat
+      ELSE
+!CDIR COLLAPSE
+         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation
+!CDIR COLLAPSE
+         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat
+      ENDIF
+!CDIR COLLAPSE
+      zqla (:,:) = Lv * zevap(:,:)                                                              ! Latent Heat
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab2d_1=zqla  , clinfo1=' blk_oce_core: zqla   : ', tab2d_2=Ce , clinfo2=' Ce  : ' )
+         CALL prt_ctl( tab2d_1=zqsb  , clinfo1=' blk_oce_core: zqsb   : ', tab2d_2=Ch , clinfo2=' Ch  : ' )
+         CALL prt_ctl( tab2d_1=zqlw  , clinfo1=' blk_oce_core: zqlw   : ', tab2d_2=qsr, clinfo2=' qsr : ' )
+         CALL prt_ctl( tab2d_1=zqsatw, clinfo1=' blk_oce_core: zqsatw : ', tab2d_2=zst, clinfo2=' zst : ' )
+         CALL prt_ctl( tab2d_1=utau  , clinfo1=' blk_oce_core: utau   : ', mask1=umask,   &
+            &          tab2d_2=vtau  , clinfo2=              ' vtau : '  , mask2=vmask )
+         CALL prt_ctl( tab2d_1=wndm  , clinfo1=' blk_oce_core: wndm   : ')
+         CALL prt_ctl( tab2d_1=zst   , clinfo1=' blk_oce_core: zst    : ')
+      ENDIF
+       
+      ! ----------------------------------------------------------------------------- !
+      !     III    Total FLUXES                                                       !
+      ! ----------------------------------------------------------------------------- !
+     
+!CDIR COLLAPSE
+      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux
+!CDIR COLLAPSE
+      emp(:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1)
+!CDIR COLLAPSE
+      emps(:,:) = emp(:,:)
+      !
+      CALL iom_put( "qlw_oce",   zqlw )                 ! output downward longwave heat over the ocean
+      CALL iom_put( "qsb_oce", - zqsb )                 ! output downward sensible heat over the ocean
+      CALL iom_put( "qla_oce", - zqla )                 ! output downward latent   heat over the ocean
+      CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean
+      !
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab2d_1=zqsb , clinfo1=' blk_oce_core: zqsb   : ', tab2d_2=zqlw , clinfo2=' zqlw  : ')
+         CALL prt_ctl(tab2d_1=zqla , clinfo1=' blk_oce_core: zqla   : ', tab2d_2=qsr  , clinfo2=' qsr   : ')
+         CALL prt_ctl(tab2d_1=pst  , clinfo1=' blk_oce_core: pst    : ', tab2d_2=emp  , clinfo2=' emp   : ')
+         CALL prt_ctl(tab2d_1=utau , clinfo1=' blk_oce_core: utau   : ', mask1=umask,   &
+            &         tab2d_2=vtau , clinfo2=              ' vtau  : ' , mask2=vmask )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zqsatw, zqlw, zqsb, zqla, zevap )
+      CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_oce_core')
+      !
+   END SUBROUTINE blk_oce_core
+   
+   
+   SUBROUTINE blk_ice_core(  pst   , pui   , pvi   , palb ,   &
+      &                      p_taui, p_tauj, p_qns , p_qsr,   &
+      &                      p_qla , p_dqns, p_dqla,          &
+      &                      p_tpr , p_spr ,                  &
+      &                      p_fr1 , p_fr2 , cd_grid, pdim  ) 
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE blk_ice_core  ***
+      !!
+      !! ** Purpose :   provide the surface boundary condition over sea-ice
+      !!
+      !! ** Method  :   compute momentum, heat and freshwater exchanged
+      !!                between atmosphere and sea-ice using CORE bulk
+      !!                formulea, ice variables and read atmmospheric fields.
+      !!                NB: ice drag coefficient is assumed to be a constant
+      !! 
+      !! caution : the net upward water flux has with mm/day unit
+      !!---------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pst      ! ice surface temperature (>0, =rt0 over land) [Kelvin]
+      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pui      ! ice surface velocity (i- and i- components      [m/s]
+      REAL(wp), DIMENSION(:,:)  , INTENT(in   ) ::   pvi      !    at I-point (B-grid) or U & V-point (C-grid)
+      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   palb     ! ice albedo (clear sky) (alb_ice_cs)               [%]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_taui   ! i- & j-components of surface ice stress        [N/m2]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tauj   !   at I-point (B-grid) or U & V-point (C-grid)
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qns    ! non solar heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qsr    !     solar heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_qla    ! latent    heat flux over ice (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqns   ! non solar heat sensistivity  (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:,:), INTENT(  out) ::   p_dqla   ! latent    heat sensistivity  (T-point)         [W/m2]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_tpr    ! total precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_spr    ! solid precipitation          (T-point)      [Kg/m2/s]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr1    ! 1sr fraction of qsr penetration in ice (T-point)  [%]
+      REAL(wp), DIMENSION(:,:)  , INTENT(  out) ::   p_fr2    ! 2nd fraction of qsr penetration in ice (T-point)  [%]
+      CHARACTER(len=1)          , INTENT(in   ) ::   cd_grid  ! ice grid ( C or B-grid)
+      INTEGER                   , INTENT(in   ) ::   pdim     ! number of ice categories
+      !!
+      INTEGER  ::   ji, jj, jl    ! dummy loop indices
+      INTEGER  ::   ijpl          ! number of ice categories (size of 3rd dim of input arrays)
+      REAL(wp) ::   zst2, zst3
+      REAL(wp) ::   zcoef_wnorm, zcoef_wnorm2, zcoef_dqlw, zcoef_dqla, zcoef_dqsb
+      REAL(wp) ::   zztmp                                        ! temporary variable
+      REAL(wp) ::   zcoef_frca                                   ! fractional cloud amount
+      REAL(wp) ::   zwnorm_f, zwndi_f , zwndj_f                  ! relative wind module and components at F-point
+      REAL(wp) ::             zwndi_t , zwndj_t                  ! relative wind components at T-point
+      !!
+      REAL(wp), DIMENSION(:,:)  , POINTER ::   z_wnds_t          ! wind speed ( = | U10m - U_ice | ) at T-point
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qlw             ! long wave heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_qsb             ! sensible  heat flux over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqlw            ! long wave heat sensitivity over ice
+      REAL(wp), DIMENSION(:,:,:), POINTER ::   z_dqsb            ! sensible  heat sensitivity over ice
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('blk_ice_core')
+      !
+      CALL wrk_alloc( jpi,jpj, z_wnds_t )
+      CALL wrk_alloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+
+      ijpl  = pdim                            ! number of ice categories
+
+      ! local scalars ( place there for vector optimisation purposes)
+      zcoef_wnorm  = rhoa * Cice
+      zcoef_wnorm2 = rhoa * Cice * 0.5
+      zcoef_dqlw   = 4.0 * 0.95 * Stef
+      zcoef_dqla   = -Ls * Cice * 11637800. * (-5897.8)
+      zcoef_dqsb   = rhoa * cpa * Cice
+      zcoef_frca   = 1.0  - 0.3
+
+!!gm brutal....
+      z_wnds_t(:,:) = 0.e0
+      p_taui  (:,:) = 0.e0
+      p_tauj  (:,:) = 0.e0
+!!gm end
+
+#if defined key_lim3
+      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)   ! LIM3: make Tair available in sea-ice. WARNING allocated after call to ice_init
+#endif
+      ! ----------------------------------------------------------------------------- !
+      !    Wind components and module relative to the moving ocean ( U10m - U_ice )   !
+      ! ----------------------------------------------------------------------------- !
+      SELECT CASE( cd_grid )
+      CASE( 'I' )                  ! B-grid ice dynamics :   I-point (i.e. F-point with sea-ice indexation)
+         !                           and scalar wind at T-point ( = | U10m - U_ice | ) (masked)
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1   ! B grid : NO vector opt
+               ! ... 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)  ) - pui(ji,jj)
+               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   &
+                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj)
+               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )
+               ! ... ice stress at I-point
+               p_taui(ji,jj) = zwnorm_f * zwndi_f
+               p_tauj(ji,jj) = zwnorm_f * zwndj_f
+               ! ... scalar wind at T-point (fld being at T-point)
+               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   &
+                  &                                          + pui(ji,jj  ) + pui(ji+1,jj  )  )
+               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   &
+                  &                                          + pvi(ji,jj  ) + pvi(ji+1,jj  )  )
+               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         CALL lbc_lnk( p_taui  , 'I', -1. )
+         CALL lbc_lnk( p_tauj  , 'I', -1. )
+         CALL lbc_lnk( z_wnds_t, 'T',  1. )
+         !
+      CASE( 'C' )                  ! C-grid ice dynamics :   U & V-points (same as ocean)
+#if defined key_vectopt_loop
+!CDIR COLLAPSE
+#endif
+         DO jj = 2, jpj
+            DO ji = fs_2, jpi   ! vect. opt.
+               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  )
+               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  )
+               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1)
+            END DO
+         END DO
+#if defined key_vectopt_loop
+!CDIR COLLAPSE
+#endif
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vect. opt.
+               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) )
+               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          &
+                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) )
+            END DO
+         END DO
+         CALL lbc_lnk( p_taui  , 'U', -1. )
+         CALL lbc_lnk( p_tauj  , 'V', -1. )
+         CALL lbc_lnk( z_wnds_t, 'T',  1. )
+         !
+      END SELECT
+
+      zztmp = 1. / ( 1. - albo )
+      !                                     ! ========================== !
+      DO jl = 1, ijpl                       !  Loop over ice categories  !
+         !                                  ! ========================== !
+!CDIR NOVERRCHK
+!CDIR COLLAPSE
+         DO jj = 1 , jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               ! ----------------------------!
+               !      I   Radiative FLUXES   !
+               ! ----------------------------!
+               zst2 = pst(ji,jj,jl) * pst(ji,jj,jl)
+               zst3 = pst(ji,jj,jl) * zst2
+               ! Short Wave (sw)
+               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj)
+               ! Long  Wave (lw)
+               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(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) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) )
+               ! Latent Heat
+               p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                           
+                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) )
+               ! Latent heat sensitivity for ice (Dqla/Dt)
+               p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) )
+               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice)
+               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj)
+
+               ! ----------------------------!
+               !     III    Total FLUXES     !
+               ! ----------------------------!
+               ! Downward Non Solar flux
+               p_qns (ji,jj,jl) =     z_qlw (ji,jj,jl) - z_qsb (ji,jj,jl) - p_qla (ji,jj,jl)      
+               ! Total non solar heat flux sensitivity for ice
+               p_dqns(ji,jj,jl) = - ( z_dqlw(ji,jj,jl) + z_dqsb(ji,jj,jl) + p_dqla(ji,jj,jl) )    
+            END DO
+            !
+         END DO
+         !
+      END DO
+      !
+      !--------------------------------------------------------------------
+      ! 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 )
+    
+!CDIR COLLAPSE
+      p_fr1(:,:) = ( 0.18 * ( 1.0 - zcoef_frca ) + 0.35 * zcoef_frca )
+!CDIR COLLAPSE
+      p_fr2(:,:) = ( 0.82 * ( 1.0 - zcoef_frca ) + 0.65 * zcoef_frca )
+       
+!CDIR COLLAPSE
+      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s]
+!CDIR COLLAPSE
+      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s]
+      CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation 
+      !
+      IF(ln_ctl) THEN
+         CALL prt_ctl(tab3d_1=p_qla   , clinfo1=' blk_ice_core: p_qla  : ', tab3d_2=z_qsb   , clinfo2=' z_qsb  : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=z_qlw   , clinfo1=' blk_ice_core: z_qlw  : ', tab3d_2=p_dqla  , clinfo2=' p_dqla : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=z_dqsb  , clinfo1=' blk_ice_core: z_dqsb : ', tab3d_2=z_dqlw  , clinfo2=' z_dqlw : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=p_dqns  , clinfo1=' blk_ice_core: p_dqns : ', tab3d_2=p_qsr   , clinfo2=' p_qsr  : ', kdim=ijpl)
+         CALL prt_ctl(tab3d_1=pst     , clinfo1=' blk_ice_core: pst    : ', tab3d_2=p_qns   , clinfo2=' p_qns  : ', kdim=ijpl)
+         CALL prt_ctl(tab2d_1=p_tpr   , clinfo1=' blk_ice_core: p_tpr  : ', tab2d_2=p_spr   , clinfo2=' p_spr  : ')
+         CALL prt_ctl(tab2d_1=p_taui  , clinfo1=' blk_ice_core: p_taui : ', tab2d_2=p_tauj  , clinfo2=' p_tauj : ')
+         CALL prt_ctl(tab2d_1=z_wnds_t, clinfo1=' blk_ice_core: z_wnds_t : ')
+      ENDIF
+
+      CALL wrk_dealloc( jpi,jpj, z_wnds_t )
+      CALL wrk_dealloc( jpi,jpj,pdim, z_qlw, z_qsb, z_dqlw, z_dqsb ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('blk_ice_core')
+      !
+   END SUBROUTINE blk_ice_core
+  
+
+   SUBROUTINE TURB_CORE_1Z(zu, sst, T_a, q_sat, q_a,   &
+      &                        dU , Cd , Ch   , Ce   )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_core  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface
+      !!                fluxes according to Large & Yeager (2004)
+      !!
+      !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D
+      !!      Momentum, Latent and sensible heat exchange coefficients
+      !!      Caution: this procedure should only be used in cases when air
+      !!      temperature (T_air), air specific humidity (q_air) and wind (dU)
+      !!      are provided at the same height 'zzu'!
+      !!
+      !! References :   Large & Yeager, 2004 : ???
+      !!----------------------------------------------------------------------
+      REAL(wp)                , INTENT(in   ) ::   zu      ! altitude of wind measurement       [m]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sst     ! sea surface temperature         [Kelvin]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   T_a     ! potential air temperature       [Kelvin]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_sat   ! sea surface specific humidity   [kg/kg]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   q_a     ! specific air humidity           [kg/kg]
+      REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   dU      ! wind module |U(zu)-U(0)|        [m/s]
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Cd      ! transfert coefficient for momentum       (tau)
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ch      ! transfert coefficient for temperature (Q_sens)
+      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   Ce      ! transfert coefficient for evaporation  (Q_lat)
+      !!
+      INTEGER :: j_itt
+      INTEGER , PARAMETER ::   nb_itt = 3
+      REAL(wp), PARAMETER ::   grav   = 9.8   ! gravity                       
+      REAL(wp), PARAMETER ::   kappa  = 0.4   ! von Karman s constant
+
+      REAL(wp), DIMENSION(:,:), POINTER  ::   dU10          ! dU                                   [m/s]
+      REAL(wp), DIMENSION(:,:), POINTER  ::   dT            ! air/sea temperature differeence      [K]
+      REAL(wp), DIMENSION(:,:), POINTER  ::   dq            ! air/sea humidity difference          [K]
+      REAL(wp), DIMENSION(:,:), POINTER  ::   Cd_n10        ! 10m neutral drag coefficient
+      REAL(wp), DIMENSION(:,:), POINTER  ::   Ce_n10        ! 10m neutral latent coefficient
+      REAL(wp), DIMENSION(:,:), POINTER  ::   Ch_n10        ! 10m neutral sensible coefficient
+      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd_n10   ! root square of Cd_n10
+      REAL(wp), DIMENSION(:,:), POINTER  ::   sqrt_Cd       ! root square of Cd
+      REAL(wp), DIMENSION(:,:), POINTER  ::   T_vpot        ! virtual potential temperature        [K]
+      REAL(wp), DIMENSION(:,:), POINTER  ::   T_star        ! turbulent scale of tem. fluct.
+      REAL(wp), DIMENSION(:,:), POINTER  ::   q_star        ! turbulent humidity of temp. fluct.
+      REAL(wp), DIMENSION(:,:), POINTER  ::   U_star        ! turb. scale of velocity fluct.
+      REAL(wp), DIMENSION(:,:), POINTER  ::   L             ! Monin-Obukov length                  [m]
+      REAL(wp), DIMENSION(:,:), POINTER  ::   zeta          ! stability parameter at height zu
+      REAL(wp), DIMENSION(:,:), POINTER  ::   U_n10         ! neutral wind velocity at 10m         [m]   
+      REAL(wp), DIMENSION(:,:), POINTER  ::   xlogt, xct, zpsi_h, zpsi_m
+      
+      INTEGER , DIMENSION(:,:), POINTER  ::   stab          ! 1st guess stability test integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_1Z')
+      !
+      CALL wrk_alloc( jpi,jpj, stab )   ! integer
+      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
+      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m )
+
+      !! * Start
+      !! Air/sea differences
+      dU10 = max(0.5, dU)     ! we don't want to fall under 0.5 m/s
+      dT = T_a - sst          ! assuming that T_a is allready the potential temp. at zzu
+      dq = q_a - q_sat
+      !!    
+      !! Virtual potential temperature
+      T_vpot = T_a*(1. + 0.608*q_a)
+      !!
+      !! Neutral Drag Coefficient
+      stab    = 0.5 + sign(0.5,dT)    ! stable : stab = 1 ; unstable : stab = 0 
+      IF  ( ln_cdgw ) THEN
+        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1)
+        Cd_n10(:,:) =   cdn_wave
+      ELSE
+        Cd_n10  = 1E-3 * ( 2.7/dU10 + 0.142 + dU10/13.09 )    !   L & Y eq. (6a)
+      ENDIF
+      sqrt_Cd_n10 = sqrt(Cd_n10)
+      Ce_n10  = 1E-3 * ( 34.6 * sqrt_Cd_n10 )               !   L & Y eq. (6b)
+      Ch_n10  = 1E-3*sqrt_Cd_n10*(18*stab + 32.7*(1-stab)) !   L & Y eq. (6c), (6d)
+      !!
+      !! Initializing transfert coefficients with their first guess neutral equivalents :
+      Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd)
+
+      !! * Now starting iteration loop
+      DO j_itt=1, nb_itt
+         !! Turbulent scales :
+         U_star  = sqrt_Cd*dU10                !   L & Y eq. (7a)
+         T_star  = Ch/sqrt_Cd*dT               !   L & Y eq. (7b)
+         q_star  = Ce/sqrt_Cd*dq               !   L & Y eq. (7c)
+
+         !! Estimate the Monin-Obukov length :
+         L  = (U_star**2)/( kappa*grav*(T_star/T_vpot + q_star/(q_a + 1./0.608)) )
+
+         !! Stability parameters :
+         zeta  = zu/L ;  zeta   = sign( min(abs(zeta),10.0), zeta )
+         zpsi_h  = psi_h(zeta)
+         zpsi_m  = psi_m(zeta)
+
+         IF  ( ln_cdgw ) THEN
+           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd;
+         ELSE
+           !! Shifting the wind speed to 10m and neutral stability :
+           U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a)
+
+           !! Updating the neutral 10m transfer coefficients :
+           Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)              !  L & Y eq. (6a)
+           sqrt_Cd_n10 = sqrt(Cd_n10)
+           Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                           !  L & Y eq. (6b)
+           stab    = 0.5 + sign(0.5,zeta)
+           Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab))           !  L & Y eq. (6c), (6d)
+
+           !! Shifting the neutral  10m transfer coefficients to ( zu , zeta ) :
+           !!
+           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10) - zpsi_m)
+           Cd  = Cd_n10/(xct*xct) ;  sqrt_Cd = sqrt(Cd)
+         ENDIF
+         !!
+         xlogt = log(zu/10.) - zpsi_h
+         !!
+         xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10
+         Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct
+         !!
+         xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10
+         Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct
+         !!
+      END DO
+      !!
+      CALL wrk_dealloc( jpi,jpj, stab )   ! integer
+      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
+      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta, U_n10, xlogt, xct, zpsi_h, zpsi_m )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_1Z')
+      !
+    END SUBROUTINE TURB_CORE_1Z
+
+
+    SUBROUTINE TURB_CORE_2Z(zt, zu, sst, T_zt, q_sat, q_zt, dU, Cd, Ch, Ce, T_zu, q_zu)
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE  turb_core  ***
+      !!
+      !! ** Purpose :   Computes turbulent transfert coefficients of surface 
+      !!                fluxes according to Large & Yeager (2004).
+      !!
+      !! ** Method  :   I N E R T I A L   D I S S I P A T I O N   M E T H O D
+      !!      Momentum, Latent and sensible heat exchange coefficients
+      !!      Caution: this procedure should only be used in cases when air
+      !!      temperature (T_air) and air specific humidity (q_air) are at 2m
+      !!      whereas wind (dU) is at 10m.
+      !!
+      !! References :   Large & Yeager, 2004 : ???
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in   )                     ::   zt       ! height for T_zt and q_zt                   [m]
+      REAL(wp), INTENT(in   )                     ::   zu       ! height for dU                              [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) ::   q_sat    ! 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) ::   dU       ! relative wind module |U(zu)-U(0)|       [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     ! air temp. shifted at zu                     [K]
+      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   q_zu     ! spec. hum.  shifted at zu               [kg/kg]
+
+      INTEGER :: j_itt
+      INTEGER , PARAMETER :: nb_itt = 3              ! number of itterations
+      REAL(wp), PARAMETER ::   grav   = 9.8          ! gravity                       
+      REAL(wp), PARAMETER ::   kappa  = 0.4          ! von Karman's constant
+      
+      REAL(wp), DIMENSION(:,:), POINTER ::   dU10          ! dU                                [m/s]
+      REAL(wp), DIMENSION(:,:), POINTER ::   dT            ! air/sea temperature differeence   [K]
+      REAL(wp), DIMENSION(:,:), POINTER ::   dq            ! air/sea humidity difference       [K]
+      REAL(wp), DIMENSION(:,:), POINTER ::   Cd_n10        ! 10m neutral drag coefficient
+      REAL(wp), DIMENSION(:,:), POINTER ::   Ce_n10        ! 10m neutral latent coefficient
+      REAL(wp), DIMENSION(:,:), POINTER ::   Ch_n10        ! 10m neutral sensible coefficient
+      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd_n10   ! root square of Cd_n10
+      REAL(wp), DIMENSION(:,:), POINTER ::   sqrt_Cd       ! root square of Cd
+      REAL(wp), DIMENSION(:,:), POINTER ::   T_vpot        ! virtual potential temperature        [K]
+      REAL(wp), DIMENSION(:,:), POINTER ::   T_star        ! turbulent scale of tem. fluct.
+      REAL(wp), DIMENSION(:,:), POINTER ::   q_star        ! turbulent humidity of temp. fluct.
+      REAL(wp), DIMENSION(:,:), POINTER ::   U_star        ! turb. scale of velocity fluct.
+      REAL(wp), DIMENSION(:,:), POINTER ::   L             ! Monin-Obukov length                  [m]
+      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 ::   U_n10         ! neutral wind velocity at 10m        [m]
+      REAL(wp), DIMENSION(:,:), POINTER ::   xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m
+
+      INTEGER , DIMENSION(:,:), POINTER ::   stab          ! 1st stability test integer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('TURB_CORE_2Z')
+      !
+      CALL wrk_alloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
+      CALL wrk_alloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 )
+      CALL wrk_alloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m )
+      CALL wrk_alloc( jpi,jpj, stab )   ! interger
+
+      !! Initial air/sea differences
+      dU10 = max(0.5, dU)      !  we don't want to fall under 0.5 m/s
+      dT = T_zt - sst 
+      dq = q_zt - q_sat
+
+      !! Neutral Drag Coefficient :
+      stab = 0.5 + sign(0.5,dT)                 ! stab = 1  if dT > 0  -> STABLE
+      IF( ln_cdgw ) THEN
+        cdn_wave = cdn_wave - rsmall*(tmask(:,:,1)-1)
+        Cd_n10(:,:) =   cdn_wave
+      ELSE
+        Cd_n10  = 1E-3*( 2.7/dU10 + 0.142 + dU10/13.09 ) 
+      ENDIF
+      sqrt_Cd_n10 = sqrt(Cd_n10)
+      Ce_n10  = 1E-3*( 34.6 * sqrt_Cd_n10 )
+      Ch_n10  = 1E-3*sqrt_Cd_n10*(18*stab + 32.7*(1 - stab))
+
+      !! Initializing transf. coeff. with their first guess neutral equivalents :
+      Cd = Cd_n10 ;  Ce = Ce_n10 ;  Ch = Ch_n10 ;  sqrt_Cd = sqrt(Cd)
+
+      !! Initializing z_u values with z_t values :
+      T_zu = T_zt ;  q_zu = q_zt
+
+      !!  * Now starting iteration loop
+      DO j_itt=1, nb_itt
+         dT = T_zu - sst ;  dq = q_zu - q_sat ! Updating air/sea differences
+         T_vpot = T_zu*(1. + 0.608*q_zu)    ! Updating virtual potential temperature at zu
+         U_star = sqrt_Cd*dU10                ! Updating turbulent scales :   (L & Y eq. (7))
+         T_star  = Ch/sqrt_Cd*dT              !
+         q_star  = Ce/sqrt_Cd*dq              !
+         !!
+         L = (U_star*U_star) &                ! Estimate the Monin-Obukov length at height zu
+              & / (kappa*grav/T_vpot*(T_star*(1.+0.608*q_zu) + 0.608*T_zu*q_star))
+         !! Stability parameters :
+         zeta_u  = zu/L  ;  zeta_u = sign( min(abs(zeta_u),10.0), zeta_u )
+         zeta_t  = zt/L  ;  zeta_t = sign( min(abs(zeta_t),10.0), zeta_t )
+         zpsi_hu = psi_h(zeta_u)
+         zpsi_ht = psi_h(zeta_t)
+         zpsi_m  = psi_m(zeta_u)
+         !!
+         !! Shifting the wind speed to 10m and neutral stability : (L & Y eq.(9a))
+!        U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u)))
+         U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m))
+         !!
+         !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c))
+!        T_zu = T_zt - T_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t))
+         T_zu = T_zt - T_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht)
+!        q_zu = q_zt - q_star/kappa*(log(zt/zu) + psi_h(zeta_u) - psi_h(zeta_t))
+         q_zu = q_zt - q_star/kappa*(log(zt/zu) + zpsi_hu - zpsi_ht)
+         !!
+         !! q_zu cannot have a negative value : forcing 0
+         stab = 0.5 + sign(0.5,q_zu) ;  q_zu = stab*q_zu
+         !!
+         IF( ln_cdgw ) THEN
+            sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd;
+         ELSE
+           !! Updating the neutral 10m transfer coefficients :
+           Cd_n10  = 1E-3 * (2.7/U_n10 + 0.142 + U_n10/13.09)    ! L & Y eq. (6a)
+           sqrt_Cd_n10 = sqrt(Cd_n10)
+           Ce_n10  = 1E-3 * (34.6 * sqrt_Cd_n10)                 ! L & Y eq. (6b)
+           stab    = 0.5 + sign(0.5,zeta_u)
+           Ch_n10  = 1E-3*sqrt_Cd_n10*(18.*stab + 32.7*(1-stab)) ! L & Y eq. (6c-6d)
+           !!
+           !!
+           !! Shifting the neutral 10m transfer coefficients to (zu,zeta_u) :
+           xct = 1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)
+           Cd = Cd_n10/(xct*xct) ; sqrt_Cd = sqrt(Cd)
+         ENDIF
+         !!
+         xlogt = log(zu/10.) - zpsi_hu
+         !!
+         xct = 1. + Ch_n10*xlogt/kappa/sqrt_Cd_n10
+         Ch  = Ch_n10*sqrt_Cd/sqrt_Cd_n10/xct
+         !!
+         xct = 1. + Ce_n10*xlogt/kappa/sqrt_Cd_n10
+         Ce  = Ce_n10*sqrt_Cd/sqrt_Cd_n10/xct
+         !!
+         !!
+      END DO
+      !!
+      CALL wrk_dealloc( jpi,jpj, dU10, dT, dq, Cd_n10, Ce_n10, Ch_n10, sqrt_Cd_n10, sqrt_Cd, L )
+      CALL wrk_dealloc( jpi,jpj, T_vpot, T_star, q_star, U_star, zeta_u, zeta_t, U_n10 )
+      CALL wrk_dealloc( jpi,jpj, xlogt, xct, zpsi_hu, zpsi_ht, zpsi_m )
+      CALL wrk_dealloc( jpi,jpj, stab )   ! interger
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('TURB_CORE_2Z')
+      !
+    END SUBROUTINE TURB_CORE_2Z
+
+
+    FUNCTION psi_m(zta)   !! Psis, L & Y eq. (8c), (8d), (8e)
+      !-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: zta
+
+      REAL(wp), PARAMETER :: pi = 3.141592653589793_wp
+      REAL(wp), DIMENSION(jpi,jpj)             :: psi_m
+      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit
+      !-------------------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, X2, X, stabit )
+
+      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.0) ;  X  = sqrt(X2)
+      stabit    = 0.5 + sign(0.5,zta)
+      psi_m = -5.*zta*stabit  &                                                          ! Stable
+         &    + (1. - stabit)*(2*log((1. + X)/2) + log((1. + X2)/2) - 2*atan(X) + pi/2)  ! Unstable 
+
+      CALL wrk_dealloc( jpi,jpj, X2, X, stabit )
+      !
+    END FUNCTION psi_m
+
+
+    FUNCTION psi_h( zta )    !! Psis, L & Y eq. (8c), (8d), (8e)
+      !-------------------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   zta
+      !
+      REAL(wp), DIMENSION(jpi,jpj)             ::   psi_h
+      REAL(wp), DIMENSION(:,:), POINTER        :: X2, X, stabit
+      !-------------------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj, X2, X, stabit )
+
+      X2 = sqrt(abs(1. - 16.*zta))  ;  X2 = max(X2 , 1.) ;  X  = sqrt(X2)
+      stabit    = 0.5 + sign(0.5,zta)
+      psi_h = -5.*zta*stabit  &                                       ! Stable
+         &    + (1. - stabit)*(2.*log( (1. + X2)/2. ))                 ! Unstable
+
+      CALL wrk_dealloc( jpi,jpj, X2, X, stabit )
+      !
+    END FUNCTION psi_h
+  
+   !!======================================================================
+END MODULE sbcblk_core
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90	(revision 3437)
@@ -0,0 +1,653 @@
+MODULE sbcblk_mfs
+   !!======================================================================
+   !!                       ***  MODULE  sbcblk_mfs  ***
+   !! Ocean forcing:  momentum, heat and freshwater flux formulation
+   !!=====================================================================
+   !! History :  3.3  !   2010-05 (P. Oddo) Original Code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_blk_mfs  : bulk formulation as ocean surface boundary condition
+   !!                   (forced mode, mfs bulk formulae)
+   !!   blk_oce_mfs  : ocean: computes momentum, heat and freshwater fluxes
+   !!----------------------------------------------------------------------
+   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 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
+   USE sbcwave,ONLY : cdn_wave !wave module
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_blk_mfs       ! routine called in sbcmod module
+      
+   INTEGER , PARAMETER ::   jpfld   = 7         ! 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_clc  = 3         ! index of total cloud cover               ( % )
+   INTEGER , PARAMETER ::   jp_msl  = 4         ! index of mean sea level pressure         (Pa)
+   INTEGER , PARAMETER ::   jp_tair = 5         ! index of 10m air temperature             (Kelvin)
+   INTEGER , PARAMETER ::   jp_rhm  = 6         ! index of dew point temperature           (Kelvin)
+   INTEGER , PARAMETER ::   jp_prec = 7         ! index of total precipitation (rain+snow) (Kg/m2/s)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf ! structure of input fields (file informations, fields read)
+         
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 
+   !! $Id: sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo $
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE sbc_blk_mfs( kt )
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE sbc_blk_mfs  ***
+      !!                   
+      !! ** Purpose :   provide at each time step the surface ocean fluxes
+      !!      (momentum, heat, freshwater, runoff is added later in the code) 
+      !!
+      !! ** Method  : (1) READ Atmospheric data from 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 2m Dew point Temperature        (k)
+      !!      the Cloud COver                     (%)
+      !!      the 2m air temperature              (Kelvin)
+      !!      the Mean Sea Level Preesure         (hPa)
+      !!      the Climatological Precipitation    (kg/m2/s)
+      !!              (2) CALL blk_oce_mfs
+      !!
+      !!      Computes:
+      !!      Solar Radiation using Reed formula (1975, 1977)
+      !!      Net Long wave radiation using Bignami et al. (1995)
+      !!      Latent and Sensible heat using Kondo (1975)
+      !!      Drag coeff using Hllerman and Rosenstein (1983)
+      !!      C A U T I O N : never mask the surface stress fields
+      !!                      the stress is assumed to be in the mesh referential
+      !!                      i.e. the (i,j) 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        10m wind module at T-point
+      !!              - qns, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
+      !!----------------------------------------------------------------------
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  sh_now   ! specific humidity at T-point 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  catm     ! Cover 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  alonl    ! Lon 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  alatl    ! Lat 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gsst     ! SST 
+      !!---------------------------------------------------------------------
+      !! Local fluxes variables
+      !!---------------------------------------------------------------------
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  qbw     ! Net Long wave 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ha      ! Sesnible 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  elat    ! Latent 
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  evap    ! evaporation rate 
+
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !!
+      INTEGER  :: ierror                          ! return error code
+      INTEGER  :: ifpr     ! dummy loop indice
+      INTEGER  :: jj,ji    ! dummy loop arguments
+      REAL(wp) :: act_hour
+      !!--------------------------------------------------------------------
+      !! Variables for specific humidity computation
+      !!--------------------------------------------------------------------
+      REAL(wp) :: onsea,par1,par2
+      DATA onsea,par1,par2 / 0.98, 640380., -5107.4 /
+      !!                      par1 [Kg/m3], par2 [K]
+
+      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_clc, sn_msl       ! informations about the fields to be read
+      TYPE(FLD_N) ::   sn_tair , sn_rhm, sn_prec              !   "                                 "
+      !!---------------------------------------------------------------------
+      NAMELIST/namsbc_mfs/ cn_dir ,                                          &
+         &                  sn_wndi , sn_wndj, sn_clc   , sn_msl ,           &
+         &                  sn_tair , sn_rhm , sn_prec 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_blk_mfs')
+      !
+      !                                         ! ====================== !
+      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
+         !                                      ! ====================== !
+      ALLOCATE( sh_now(jpi,jpj), catm(jpi,jpj), alonl(jpi,jpj), alatl(jpi,jpj),     &
+         &        gsst(jpi,jpj),  qbw(jpi,jpj),    ha(jpi,jpj),  elat(jpi,jpj),     &
+         &        evap(jpi,jpj), STAT=ierror )
+
+         IF( ierror /= 0 )   CALL ctl_warn('sbc_blk_mfs: failed to allocate arrays')
+            !
+            ! 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   !
+            !            !    name     !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
+            sn_wndi = FLD_N( 'ecmwf'   ,    24     ,  'u10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_wndj = FLD_N( 'ecmwf'   ,    24     ,  'v10'     ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_clc  = FLD_N( 'ecmwf'   ,    24     ,  'clc'     ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_msl  = FLD_N( 'ecmwf'   ,    24     ,  'msl'     ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_tair = FLD_N( 'ecmwf'   ,    24     ,  't2'      ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_rhm  = FLD_N( 'ecmwf'   ,    24     ,  'rh'      ,  .false.   , .false. ,   'daily'   , ''       , ''         )
+            sn_prec = FLD_N( 'precip_cmap' ,  -1   ,  'precip'  ,  .true.    ,  .true. ,   'yearly'  , ''       , ''         )
+            !
+            REWIND( numnam )                    ! ... read in namlist namsbc_mfs
+            READ  ( numnam, namsbc_mfs )
+            !
+            ! store namelist information in an array
+            slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj
+            slf_i(jp_clc ) = sn_clc    ;   slf_i(jp_msl ) = sn_msl
+            slf_i(jp_tair) = sn_tair   ;   slf_i(jp_rhm)  = sn_rhm
+            slf_i(jp_prec) = sn_prec   ;  
+            !
+            ALLOCATE( sf(jpfld), STAT=ierror )         ! set sf structure
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_blk_mfs: unable to allocate sf structure' )   ;   RETURN
+            ENDIF
+            DO ifpr= 1, jpfld
+               ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
+               IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
+            END DO
+            ! fill sf with slf_i and control print
+            CALL fld_fill( sf, slf_i, cn_dir,'sbc_blk_mfs','bulk formulation for ocean SBC', 'namsbc_mfs' )
+            !
+         ENDIF
+
+         CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step
+
+         catm(:,:)   = 0.0    ! initializze cloud cover variable
+         sh_now(:,:) = 0.0    ! initializze specifif humidity variable
+
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+         ! Calculate Specific Humidity 
+         !-------------------------------------------------
+            sh_now(ji,jj) = (1/1.22) * onsea * par1 * EXP(par2/sf(jp_rhm)%fnow(ji,jj,1))
+
+         ! Normalize Clouds
+         !-------------------------------------------------
+            catm(ji,jj)   = max(0.0,min(1.0,sf(jp_clc)%fnow(ji,jj,1)*0.01))
+
+            END DO
+         END DO
+
+         ! wind module at 10m 
+         !--------------------------------------------------
+         wndm(:,:) = SQRT(  sf(jp_wndi)%fnow(:,:,1) * sf(jp_wndi)%fnow(:,:,1)   &
+              &             + sf(jp_wndj)%fnow(:,:,1) * sf(jp_wndj)%fnow(:,:,1)  )
+
+         ! Some conv for fluxes computation
+         !-------------------------------------------------
+         alonl(:,:) = glamt(:,:) * rad
+         alatl(:,:) = gphit(:,:) * rad
+         gsst(:,:)  = tsn(:,:,1,jp_tem)  * tmask(:,:,1)
+
+         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+
+         ! Force to zero the output of fluxes 
+         !-------------------------------------------------
+          qsr(:,:)  = 0.0 ; qbw(:,:)  = 0.0 ; 
+          ha(:,:)   = 0.0 ; elat(:,:) = 0.0 ; 
+          evap(:,:) = 0.0 ; utau(:,:) = 0.0 ; 
+          vtau(:,:) = 0.0
+
+          CALL lbc_lnk( sf(jp_wndi)%fnow(:,:,1), 'T', -1. )
+          CALL lbc_lnk( sf(jp_wndj)%fnow(:,:,1), 'T', -1. )
+
+          act_hour = (( nsec_year / rday ) - INT (nsec_year / rday)) * rjjhh
+
+          CALL fluxes_mfs(alatl,alonl,act_hour,                                &     ! input static
+                            gsst(:,:),sf(jp_tair)%fnow(:,:,1),sh_now(:,:),     &     ! input dynamic
+                            sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),  &     ! input dynamic
+                            sf(jp_msl)%fnow(:,:,1) , catm(:,:) ,               &     ! input dynamic
+                            qsr,qbw,ha,elat,evap,utau,vtau)                          ! output
+
+         ! Shortwave radiation
+         !--------------------------------------------------
+          qsr(:,:) = qsr(:,:) * tmask(:,:,1)
+
+         ! total non solar heat flux over water
+         !--------------------------------------------------
+          qns(:,:) = -1. * ( qbw(:,:) + ha(:,:) + elat(:,:) )
+          qns(:,:) = qns(:,:)*tmask(:,:,1)
+
+         ! mask the wind module at 10m 
+         !--------------------------------------------------
+          wndm(:,:) = wndm(:,:) * tmask(:,:,1)
+
+         !   wind stress module (taum) into T-grid
+         !--------------------------------------------------
+          taum(:,:) = SQRT( utau(:,:) * utau(:,:) + vtau(:,:) * vtau(:,:) ) * tmask(:,:,1)
+
+          CALL lbc_lnk( taum, 'T', 1. )
+
+         ! Interpolate utau, vtau into the grid_V and grid_V
+         !-------------------------------------------------
+
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1
+               utau(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( utau(ji,jj) * tmask(ji,jj,1) &
+               &                                + utau(ji+1,jj) * tmask(ji+1,jj,1) )
+               vtau(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( vtau(ji,jj) * tmask(ji,jj,1) &
+               &                                + vtau(ji,jj+1) * tmask(ji,jj+1,1) )
+            END DO
+         END DO
+
+         CALL lbc_lnk( utau(:,:), 'U', -1. )
+         CALL lbc_lnk( vtau(:,:), 'V', -1. )
+
+         ! for basin budget and cooerence
+         !--------------------------------------------------
+!CDIR COLLAPSE
+           emp (:,:) = evap(:,:) - sf(jp_prec)%fnow(:,:,1) * tmask(:,:,1)
+!CDIR COLLAPSE
+           emps(:,:) = emp(:,:)
+
+         CALL iom_put( "qlw_oce",   qbw  )                 ! output downward longwave heat over the ocean
+         CALL iom_put( "qsb_oce", - ha   )                 ! output downward sensible heat over the ocean
+         CALL iom_put( "qla_oce", - elat )                 ! output downward latent   heat over the ocean
+         CALL iom_put( "qns_oce",   qns  )                 ! output downward non solar heat over the ocean
+
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_blk_mfs')
+      !
+   END SUBROUTINE sbc_blk_mfs
+  
+ 
+   SUBROUTINE fluxes_mfs(alat,alon,hour,                               &
+        sst,tnow,shnow,unow,vnow,mslnow,cldnow,qsw,qbw,ha,elat,        &
+        evap,taux,tauy)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE fluxes_mfs  ***
+      !!
+      !! --- it provides SURFACE HEAT and MOMENTUM FLUXES in MKS :
+      !!
+      !!  1)   Water flux (WFLUX)                 [ watt/m*m ]
+      !!  2)   Short wave flux (QSW)              [ watt/m*m ] Reed 1977
+      !!  3)   Long wave flux backward (QBW)      [ watt/m*m ]
+      !!  4)   Latent heat of evaporation (ELAT)  [ watt/m*m ]
+      !!  5)   Sensible heat flux   (HA)          [ watt/m*m ]
+      !!  6)   Wind stress x-component   (TAUX)   [ newton/m*m ]
+      !!  7)   Wind stress y-component   (TAUY)   [ newton/m*m ]
+      !!
+      !!----------------------------------------------------------------------
+      USE sbcblk_core, ONLY: turb_core_2z ! For wave coupling and Tair/rh from 2 to 10m
+
+      REAL(wp), INTENT(in   ) :: hour
+      REAL(wp), INTENT(in   ), DIMENSION (:,:) :: sst, unow, alat , alon
+      REAL(wp), INTENT(in   ), DIMENSION (:,:) :: vnow, cldnow, mslnow
+      REAL(wp), INTENT(out  ), DIMENSION (:,:) :: qsw, qbw, ha, elat
+      REAL(wp), INTENT(out  ), DIMENSION (:,:) :: evap,taux,tauy
+      REAL(wp), INTENT(inout), DIMENSION (:,:) :: tnow , shnow
+
+      INTEGER :: ji,jj 
+      REAL(wp)  :: wair, vtnow, ea, deltemp, s, stp , fh , fe
+      REAL(wp)  :: esre, cseep
+
+      REAL(wp), DIMENSION (:,:), POINTER ::   rspeed, sh10now, t10now, cdx, ce, shms
+      REAL(wp), DIMENSION (:,:), POINTER ::   rhom, sstk, ch, rel_windu, rel_windv
+      !!----------------------------------------------------------------------
+      !!     coefficients ( in MKS )  :
+      !!----------------------------------------------------------------------
+
+      REAL(wp), PARAMETER ::  ps = 1013.    ! --- surface air pressure
+      REAL(wp), PARAMETER ::  expsi=0.622   ! --- expsi
+      REAL(wp), PARAMETER ::  rd=287.       ! --- dry air gas constant
+      REAL(wp), PARAMETER ::  cp=1005.      ! --- specific heat capacity
+      REAL(wp), PARAMETER ::  onsea=0.98    ! --- specific humidity factors
+      REAL(wp), PARAMETER ::  par1=640380.  ! [Kg/m3]
+      REAL(wp), PARAMETER ::  par2=-5107.4  ! [K]
+
+      !---------------------------------------------------------------------
+      !--- define Kondo parameters
+      !---------------------------------------------------------------------
+
+      REAL(wp), DIMENSION(5) :: a_h = (/0.0,0.927,1.15,1.17,1.652/)
+      REAL(wp), DIMENSION(5) :: a_e = (/0.0,0.969,1.18,1.196,1.68/)
+      REAL(wp), DIMENSION(5) :: b_h = (/1.185,0.0546,0.01,0.0075,-0.017/)
+      REAL(wp), DIMENSION(5) :: b_e = (/1.23,0.0521,0.01,0.008,-0.016/)
+      REAL(wp), DIMENSION(5) :: c_h = (/0.0,0.0,0.0,-0.00045,0.0/)
+      REAL(wp), DIMENSION(5) :: c_e = (/0.0,0.0,0.0,-0.0004,0.0/)
+      REAL(wp), DIMENSION(5) :: p_h = (/-0.157,1.0,1.0,1.0,1.0/)
+      REAL(wp), DIMENSION(5) :: p_e = (/-0.16,1.0,1.0,1.0,1.0/)
+      INTEGER :: kku                        !index varing with wind speed
+      !
+      IF( nn_timing == 1 )  CALL timing_start('fluxes_mfs')
+      !
+      CALL wrk_alloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms )
+      CALL wrk_alloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv )
+
+      !!----------------------------------------------------------------------
+      !! ------------------ (i)      short wave
+      !!----------------------------------------------------------------------
+
+       CALL qshort(hour,alat,alon,cldnow,qsw)
+
+          rel_windu(:,:) = 0.0_wp
+          rel_windv(:,:) = 0.0_wp
+
+       DO jj = 2, jpj
+          DO ji = fs_2, jpi
+           rel_windu(ji,jj) = unow(ji,jj) - 0.5_wp * ( ssu_m(ji-1,jj) + ssu_m(ji,jj) )
+           rel_windv(ji,jj) = vnow(ji,jj) - 0.5_wp * ( ssv_m(ji,jj-1) + ssv_m(ji,jj) )
+          END DO
+       END DO
+
+       rspeed(:,:)= SQRT(rel_windu(:,:)*rel_windu(:,:)   &
+         &                   + rel_windv(:,:)*rel_windv(:,:)) 
+
+       sstk(:,:) = sst(:,:) + rtt                          !- SST data in Kelvin degrees
+       shms(:,:) = (1/1.22)*onsea*par1*EXP(par2/sstk(:,:)) !- Saturation Specific Humidity
+
+      ! --- Transport temperature and humidity from 2m to 10m
+      !----------------------------------------------------------------------
+
+      t10now(:,:) = 0.0           ;   sh10now(:,:)= 0.0
+      ! Note that air temp is converted in potential temp
+      CALL turb_core_2z(2.,10.,sstk,tnow+2*0.0098,shms,shnow,rspeed,        &
+         &              Cdx,Ch,Ce,t10now,sh10now )
+      tnow(:,:)  = t10now(:,:)    ;    shnow(:,:) = sh10now(:,:)
+
+      !!----------------------------------------------------------------------
+      !! ------------------ (ii)    net long wave
+      !!----------------------------------------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            wair = shnow(ji,jj) / (1 - shnow(ji,jj))    ! mixing ratio of the air (Wallace and Hobbs)
+            vtnow = (tnow(ji,jj)*(expsi+wair))/(expsi*(1.+wair))   ! virtual temperature of air
+            rhom(ji,jj) = 100.*(ps/rd)/vtnow                       ! density of the moist air
+            ea   = (wair  / (wair  + 0.622 )) * mslnow(ji,jj)
+
+            qbw(ji,jj) = emic*stefan*( sstk(ji,jj)**4. )                    &
+                 - ( stefan*( tnow(ji,jj)**4. ) * ( 0.653 + 0.00535*ea ) )  &
+                   * ( 1. + 0.1762*( cldnow(ji,jj)**2. ) )
+
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+      !!----------------------------------------------------------------------
+      !! ------------------ (iii)   sensible heat
+      !!----------------------------------------------------------------------
+
+      !! --- calculates the term :      ( Ts - Ta )
+      !!----------------------------------------------------------------------
+            deltemp = sstk(ji,jj) - tnow (ji,jj)
+
+      !!----------------------------------------------------------------------
+      !! --- variable turbulent exchange coefficients ( from Kondo 1975 )
+      !! --- calculate the Neutral Transfer Coefficent using an empiric formula
+      !! --- by Kondo et al. Then it applies the diabatic approximation.
+      !!----------------------------------------------------------------------
+
+            s = deltemp/(wndm(ji,jj)**2.)   !! --- calculate S 
+            stp = s*abs(s)/(abs(s)+0.01)    !! --- calculate the Stability Parameter 
+
+      !!----------------------------------------------------------------------
+      !! --- for stable condition (sst-t_air < 0):
+      !!----------------------------------------------------------------------
+
+            IF (s.lt.0. .and. ((stp.gt.-3.3).and.(stp.lt.0.))) THEN
+                fh = 0.1_wp+0.03_wp*stp+0.9_wp*exp(4.8_wp*stp)
+                fe = fh
+            ELSE IF (s.lt.0. .and. stp.le.-3.3) THEN
+                fh = 0._wp
+                fe = fh
+            ELSE                                       ! --- for unstable condition 
+                fh = 1.0_wp+0.63_wp*sqrt(stp)
+                fe = fh
+            ENDIF
+
+      !!----------------------------------------------------------------------
+      !! --- calculate the coefficient CH,CE,CD
+      !!----------------------------------------------------------------------
+
+            IF (wndm(ji,jj) >= 0. .AND. wndm(ji,jj) <= 2.2)       THEN
+                kku=1
+            ELSE IF (wndm(ji,jj) > 2.2 .AND. wndm(ji,jj) <= 5.0)  THEN
+                kku=2
+            ELSE IF (wndm(ji,jj) > 5.0 .AND. wndm(ji,jj) <= 8.0)  THEN
+                kku=3
+            ELSE IF (wndm(ji,jj) > 8.0 .AND. wndm(ji,jj) <= 25.0) THEN
+                kku=4
+            ELSE IF (wndm(ji,jj) > 25.0 )                         THEN
+                kku=5
+            ENDIF
+
+            ch(ji,jj) = ( a_h(kku) + b_h(kku) * wndm(ji,jj) ** p_h(kku)      &
+                        + c_h(kku) * (wndm(ji,jj)-8 ) **2) * fh
+
+            ce(ji,jj) = ( a_e(kku) + b_e(kku) * wndm(ji,jj) ** p_e(kku)      &
+                        + c_e(kku) * (wndm(ji,jj)-8 ) **2) * fe
+
+            ch(ji,jj) = ch(ji,jj) / 1000.0
+            ce(ji,jj) = ce(ji,jj) / 1000.0
+
+            IF (wndm(ji,jj)<0.3) THEN
+               ch(ji,jj) = 1.3e-03 * fh
+               ce(ji,jj) = 1.5e-03 * fe
+            ELSE IF(wndm(ji,jj)>50.0) THEN
+               ch(ji,jj) = 1.25e-03 * fh
+               ce(ji,jj) = 1.30e-03 * fe
+            ENDIF
+
+      !!----------------------------------------------------------------------
+      !! --- calculates the SENSIBLE HEAT FLUX in MKS ( watt/m*m )
+      !!----------------------------------------------------------------------
+
+            HA(ji,jj) = rhom(ji,jj)*cp*ch(ji,jj)*wndm(ji,jj)*deltemp
+
+      !!----------------------------------------------------------------------
+      !! ------------------ (iv)  latent heat
+      !! --- calculates the LATENT HEAT FLUX  ( watt/m*m )
+      !! --- ELAT = L*rho*Ce*|V|*[qs(Ts)-qa(t2d)]
+      !!----------------------------------------------------------------------
+
+            esre  = shms(ji,jj) - shnow(ji,jj)   ! --- calculates the term : qs(Ta)-qa(t2d)
+
+            cseep = ce(ji,jj) * wndm(ji,jj) * esre     ! --- calculates the term : Ce*|V|*[qs(Ts)-qa(t2d)]
+
+            evap(ji,jj) = (cseep * rhom(ji,jj))  ! in [kg/m2/sec] !! --- calculates the EVAPORATION RATE [m/yr]
+
+            elat(ji,jj) = rhom(ji,jj) * cseep * heatlat(sst(ji,jj))
+
+      !!----------------------------------------------------------------------
+      !! --- calculates the Drag Coefficient
+      !!----------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !! --- deltemp should be (Ts - Ta) in the formula estimating
+      !! --- drag coefficient
+      !!----------------------------------------------------------------------
+
+              IF( .NOT. ln_cdgw ) THEN
+                 cdx(ji,jj) = cd_HR(wndm(ji,jj),deltemp)
+              ENDIF
+
+          END DO
+      END DO
+
+      !!----------------------------------------------------------------------
+      !! --- calculates the wind stresses in MKS ( newton/m*m )
+      !! ---            taux= rho*Cd*|V|u      tauy= rho*Cd*|V|v
+      !!----------------------------------------------------------------------
+
+       taux(:,:)= rhom(:,:) * cdx(:,:) * rspeed(:,:) * rel_windu(:,:)
+       tauy(:,:)= rhom(:,:) * cdx(:,:) * rspeed(:,:) * rel_windv(:,:)
+
+      CALL wrk_dealloc( jpi,jpj, rspeed, sh10now, t10now, cdx, ce, shms )
+      CALL wrk_dealloc( jpi,jpj, rhom, sstk, ch, rel_windu, rel_windv )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('fluxes_mfs')
+      !
+   END SUBROUTINE fluxes_mfs
+
+
+      REAL(wp) FUNCTION cd_HR(speed,delt)
+      !!----------------------------------------------------------------------
+      !! --- calculates the Drag Coefficient as a function of the abs. value
+      !! --- of the wind velocity ( Hellermann and Rosenstein )
+      !!----------------------------------------------------------------------
+
+       REAL(wp), INTENT(in) :: speed,delt
+       REAL(wp), PARAMETER  :: a1=0.934e-3 , a2=0.788e-4, a3=0.868e-4     
+       REAL(wp), PARAMETER  :: a4=-0.616e-6, a5=-.120e-5, a6=-.214e-5
+
+        cd_HR = a1 + a2*speed + a3*delt + a4*speed*speed        &
+           + a5*delt*delt  + a6*speed*delt
+
+      END FUNCTION cd_HR
+
+      REAL(wp) function HEATLAT(t)
+      !!----------------------------------------------------------------------
+      !! --- calculates the Latent Heat of Vaporization ( J/kg ) as function of
+      !! --- the temperature ( Celsius degrees )
+      !! --- ( from A. Gill  pag. 607 )
+      !!
+      !! --- Constant Latent Heat of Vaporization ( Rosati,Miyakoda 1988 )
+      !!     L = 2.501e+6  (MKS)
+      !!----------------------------------------------------------------------
+
+      REAL(wp) , intent(in) :: t
+
+      heatlat = 2.5008e+6 -2.3e+3*t
+
+      END FUNCTION HEATLAT
+
+
+   SUBROUTINE qshort(hour,alat,alon,cldnow,qsw)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE qshort  ***
+      !!
+      !! ** Purpose :   Compute Solar Radiation
+      !!
+      !! ** Method  :   Compute Solar Radiation according Astronomical
+      !!                formulae
+      !!
+      !! References :   Reed RK (1975) and Reed RK (1977)
+      !!
+      !! Note: alat,alon - (lat, lon)  in radians
+      !!----------------------------------------------------------------------
+        REAL(wp), INTENT (in) :: hour
+
+        REAL(wp), INTENT(in ), DIMENSION(:,:) :: alat,alon
+        REAL(wp), INTENT(in ), DIMENSION(:,:) :: cldnow
+        REAL(wp), INTENT(out), DIMENSION(:,:) :: qsw
+        REAL(wp), DIMENSION(12) :: alpham
+
+        REAL(wp), PARAMETER ::   eclips=23.439* (3.141592653589793_wp / 180._wp)
+        REAL(wp), PARAMETER ::   solar = 1350.
+        REAL(wp), PARAMETER ::   tau = 0.7
+        REAL(wp), PARAMETER ::   aozone = 0.09
+        REAL(wp), PARAMETER ::   yrdays = 360.
+        REAL(wp) :: days, th0,th02,th03, sundec, thsun, coszen, qatten
+        REAL(wp) :: qzer, qdir,qdiff,qtot,tjul,sunbet
+        REAL(wp) :: albedo
+        INTEGER :: jj, ji
+
+      !!----------------------------------------------------------------------
+      !! --- albedo monthly values from Payne (1972) as means of the values
+      !! --- at 40N and 30N for the Atlantic Ocean ( hence the same latitudinal
+      !! --- band of the Mediterranean Sea ) :
+      !!----------------------------------------------------------------------
+
+        data alpham /0.095,0.08,0.065,0.065,0.06,0.06,0.06,0.06,        &
+                    0.065,0.075,0.09,0.10/
+
+      !!----------------------------------------------------------------------
+      !!   days is the number of days elapsed until the day=nday_year
+      !!----------------------------------------------------------------------
+        days = nday_year -1.
+        th0  = 2.*rpi*days/yrdays
+        th02 = 2.*th0
+        th03 = 3.*th0
+
+      !! --- sun declination :
+      !!----------------------------------------------------------------------
+        sundec = 0.006918 - 0.399912*cos(th0) + 0.070257*sin(th0) -   &
+                          0.006758*cos(th02) + 0.000907*sin(th02) -   &
+                          0.002697*cos(th03) + 0.001480*sin(th03)
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+
+      !! --- sun hour angle :
+      !!----------------------------------------------------------------------
+          thsun = (hour -12.)*15.*rad + alon(ji,jj)
+
+      !! --- cosine of the solar zenith angle :
+      !!----------------------------------------------------------------------
+          coszen =sin(alat(ji,jj))*sin(sundec)                 &
+                    +cos(alat(ji,jj))*cos(sundec)*cos(thsun)
+
+          IF(coszen .LE. 5.035D-04) THEN
+            coszen = 0.0
+            qatten = 0.0
+          ELSE
+            qatten = tau**(1./coszen)
+          END IF
+
+          qzer  = coszen * solar *                                 &
+                  (1.0+1.67E-2*cos(rpi*2.*(days-3.0)/365.0))**2
+          qdir  = qzer * qatten
+          qdiff = ((1.-aozone)*qzer - qdir) * 0.5
+          qtot  =  qdir + qdiff
+          tjul = (days -81.)*rad
+
+      !! --- sin of the solar noon altitude in radians :
+      !!----------------------------------------------------------------------
+          sunbet=sin(alat(ji,jj))*sin(eclips*sin(tjul)) +   &
+                 cos(alat(ji,jj))*cos(eclips*sin(tjul))
+
+      !! --- solar noon altitude in degrees :
+      !!----------------------------------------------------------------------
+
+         sunbet = asin(sunbet)/rad
+
+      !!----------------------------------------------------------------------
+      !! --- calculates the albedo according to Payne (1972)
+      !!----------------------------------------------------------------------
+
+         albedo = alpham(nmonth)
+
+      !!----------------------------------------------------------------------
+      !! --- ( radiation as from Reed(1977), Simpson and Paulson(1979) )
+      !! --- calculates SHORT WAVE FLUX ( watt/m*m )
+      !! --- ( Rosati,Miyakoda 1988 ; eq. 3.8 )
+      !!----------------------------------------------------------------------
+
+          IF(cldnow(ji,jj).LT.0.3) THEN
+             qsw(ji,jj) = qtot * (1.-albedo)
+          ELSE
+             qsw(ji,jj) = qtot*(1.-0.62*cldnow(ji,jj)              &
+                                + .0019*sunbet)*(1.-albedo)
+          ENDIF
+
+         END DO
+      END DO
+
+   END SUBROUTINE qshort
+
+
+   !!======================================================================
+
+END MODULE sbcblk_mfs
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90	(revision 3437)
@@ -0,0 +1,1602 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_oasis3 || defined key_oasis4
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3' or 'key_oasis4'   Coupled Ocean/Atmosphere formulation
+   !!----------------------------------------------------------------------
+   !!   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 sbc_ice         ! Surface boundary condition: ice fields
+   USE sbcdcy          ! surface boundary condition: diurnal cycle
+   USE phycst          ! physical constants
+#if defined key_lim3
+   USE par_ice         ! ice parameters
+   USE ice             ! ice variables
+#endif
+#if defined key_lim2
+   USE par_ice_2       ! ice parameters
+   USE ice_2           ! ice variables
+#endif
+#if defined key_oasis3
+   USE cpl_oasis3      ! OASIS3 coupling
+#endif
+#if defined key_oasis4
+   USE cpl_oasis4      ! OASIS4 coupling
+#endif
+   USE geo2ocean       ! 
+   USE restart         !
+   USE oce   , ONLY : tsn, un, vn
+   USE albedo          !
+   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)
+#if defined key_cpl_carbon_cycle
+   USE p4zflx, ONLY : oce_co2
+#endif
+   USE diaar5, ONLY :   lk_diaar5
+#if defined key_cice
+   USE ice_domain_size, only: ncat
+#endif
+   IMPLICIT NONE
+   PRIVATE
+
+   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
+
+   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 ::   jprcv      = 33            ! total number of fields received
+
+   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction 
+   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 ::   jpsnd      = 15            ! total number of fields sended
+
+   !                                                         !!** 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                        
+
+   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)
+
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(    :) ::   nrcvinfo           ! OASIS info argument
+
+#if ! defined key_lim2   &&   ! defined key_lim3
+   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)
+#endif
+
+#if defined key_cice
+   INTEGER, PARAMETER ::   jpl = ncat
+#elif ! defined key_lim2   &&   ! defined key_lim3
+   INTEGER, PARAMETER ::   jpl = 1 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   emp_ice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qsr_ice
+#endif
+
+#if ! defined key_lim3   &&  ! defined key_cice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  a_i
+#endif
+
+#if ! defined key_lim3
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ht_i, ht_s
+#endif
+
+#if ! defined key_cice
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  topmelt, botmelt
+#endif
+
+   !! 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),jn
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv),  STAT=ierr(1) )
+      !
+#if ! defined key_lim2 && ! defined key_lim3
+      ! quick patch to be able to run the coupled model without sea-ice...
+      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_lim3 && ! defined key_cice
+      ALLOCATE( a_i(jpi,jpj,jpl) , STAT=ierr(3) )
+#endif
+
+#if defined key_cice || defined key_lim2
+      ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(4) )
+#endif
+      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 recieved 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
+      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_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx  , sn_rcv_co2
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_init')
+      !
+      CALL wrk_alloc( jpi,jpj, zacs, zaos )
+
+      ! ================================ !
+      !      Namelist informations       !
+      ! ================================ !
+
+      ! default definitions
+      !                    !     description       !  multiple  !    vector   !      vector          ! vector !
+      !                    !                       ! categories !  reference  !    orientation       ! grids  !
+      ! send
+      sn_snd_temp   = FLD_C( 'weighted oce and ice',    'no'    ,     ''      ,         ''           ,   ''   ) 
+      sn_snd_alb    = FLD_C( 'weighted ice'        ,    'no'    ,     ''      ,         ''           ,   ''   ) 
+      sn_snd_thick  = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   ) 
+      sn_snd_crt    = FLD_C( 'none'                ,    'no'    , 'spherical' , 'eastward-northward' ,  'T'   )     
+      sn_snd_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''           ,   ''   )     
+      ! receive
+      sn_rcv_w10m   = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_taumod = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_tau    = FLD_C( 'oce only'            ,    'no'    , 'cartesian' , 'eastward-northward',  'U,V'  )  
+      sn_rcv_dqnsdt = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_qsr    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_qns    = FLD_C( 'oce and ice'         ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_emp    = FLD_C( 'conservative'        ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_rnf    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_cal    = FLD_C( 'coupled'             ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_iceflx = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    )
+      sn_rcv_co2    = FLD_C( 'none'                ,    'no'    ,     ''      ,         ''          ,   ''    )
+
+      REWIND( numnam )                    ! ... read namlist namsbc_cpl
+      READ  ( numnam, namsbc_cpl )
+
+      IF(lwp) THEN                        ! control print
+         WRITE(numout,*)
+         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist '
+         WRITE(numout,*)'~~~~~~~~~~~~'
+         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,*)'      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,*)'  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,*)'      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   ), ')'
+      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%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%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
+       
+      !                                                      ! ------------------------- !
+      !                                                      !    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( 'oce only'      )   ;   srcv(                                 jpr_oemp   )%laction = .TRUE. 
+      CASE( 'conservative'  )   ;   srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE.
+      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' )   srcv(jpr_rnf)%laction = .TRUE.
+! This isn't right - really just want ln_rnf_emp changed
+!                                                 IF( TRIM( sn_rcv_rnf%cldes ) == 'climato' )   THEN   ;   ln_rnf = .TRUE.
+!                                                 ELSE                                                 ;   ln_rnf = .FALSE.
+!                                                 ENDIF
+      srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE.
+
+      !                                                      ! ------------------------- !
+      !                                                      !    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( '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( '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) &
+         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' )
+      !                                                      ! ------------------------- !
+      !                                                      !    Ice Qsr penetration    !   
+      !                                                      ! ------------------------- !
+      ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 
+      ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )
+      ! Coupled case: since cloud cover is not received from atmosphere 
+      !               ===> defined as constant value -> definition done in sbc_cpl_init
+      fr1_i0(:,:) = 0.18
+      fr2_i0(:,:) = 0.82
+      !                                                      ! ------------------------- !
+      !                                                      !      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' )    srcv(jpr_co2 )%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
+
+      ! 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(jn)%nct) )
+
+      ! ================================ !
+      !     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( 'oce only'             )   ;   ssnd(   jps_toce             )%laction = .TRUE.
+      CASE( '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( '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_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
+
+      SELECT CASE ( TRIM( sn_snd_thick%cldes ) )
+      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
+         ELSE
+            IF ( jpl > 1 ) THEN
+               CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' )
+            ENDIF
+         ENDIF
+      CASE ( 'weighted ice and snow' ) 
+         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_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
+
+      !                                                      ! ------------------------- !
+      !                                                      !          CO2 flux         !
+      !                                                      ! ------------------------- !
+      ssnd(jps_co2)%clname = 'O_CO2FLX' ;  IF( TRIM(sn_snd_co2%cldes) == 'coupled' )    ssnd(jps_co2 )%laction = .TRUE.
+      !
+      ! ================================ !
+      !   initialisation of the coupler  !
+      ! ================================ !
+
+      CALL cpl_prism_define(jprcv, jpsnd)            
+      !
+      IF( ln_dm2dc .AND. ( cpl_prism_freq( jpr_qsroce ) + cpl_prism_freq( jpr_qsrmix ) /= 86400 ) )   &
+         &   CALL ctl_stop( 'sbc_cpl_init: diurnal cycle reconstruction (ln_dm2dc) needs daily couping for solar radiation' )
+
+      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, wndm   wind stres and wind speed module at T-point
+      !!                        qns , qsr    non solar and solar ocean heat fluxes   ('ocean only case)
+      !!                        emp = emps   evap. - precip. (- runoffs) (- calving) ('ocean only case)
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean model time step index
+      INTEGER, INTENT(in) ::   k_fsbc   ! frequency of sbc (-> ice model) computation 
+      INTEGER, INTENT(in) ::   k_ice    ! ice management in the sbc (=0/1/2/3)
+      !!
+      LOGICAL ::    llnewtx, llnewtau      ! update wind stress components and module??
+      INTEGER  ::   ji, jj, jn             ! dummy loop indices
+      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra 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 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv')
+      !
+      CALL wrk_alloc( jpi,jpj, ztx, zty )
+
+      IF( kt == nit000 )   CALL sbc_cpl_init( k_ice )          ! initialisation
+
+      !                                                 ! Receive all the atmos. fields (including ice information)
+      isec = ( kt - nit000 ) * NINT( rdttra(1) )             ! date of exchanges
+      DO jn = 1, jprcv                                       ! received fields sent by the atmosphere
+         IF( srcv(jn)%laction )   CALL cpl_prism_rcv( jn, isec, frcv(jn)%z3, 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
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+               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.0e0, 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 ) 
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi 
+                  wndm(ji,jj) = SQRT( frcv(jpr_taum)%z3(ji,jj,1) * zcoef )
+               END DO
+            END DO
+         ENDIF
+      ELSE
+         IF ( nrcvinfo(jpr_w10m) == OASIS_Rcv ) wndm(:,:) = frcv(jpr_w10m)%z3(:,:,1)
+      ENDIF
+
+      ! 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
+         !
+         utau(:,:) = frcv(jpr_otx1)%z3(:,:,1)
+         vtau(:,:) = frcv(jpr_oty1)%z3(:,:,1)
+         taum(:,:) = frcv(jpr_taum)%z3(:,:,1)
+         CALL iom_put( "taum_oce", taum )   ! output wind stress module
+         !  
+      ENDIF
+
+#if defined key_cpl_carbon_cycle
+      !                                                              ! atmosph. CO2 (ppm)
+      IF( srcv(jpr_co2)%laction )   atm_co2(:,:) = frcv(jpr_co2)%z3(:,:,1)
+#endif
+
+      !                                                      ! ========================= !
+      IF( k_ice <= 1 ) THEN                                  !  heat & freshwater fluxes ! (Ocean only case)
+         !                                                   ! ========================= !
+         !
+         !                                                       ! non solar heat flux over the ocean (qns)
+         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(jpr_qnsoce)%z3(:,:,1)
+         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1)
+         ! add the latent heat of solid precip. melting
+         IF( srcv(jpr_snow  )%laction )   qns(:,:) = qns(:,:) - frcv(jpr_snow)%z3(:,:,1) * lfus              
+
+         !                                                       ! solar flux over the ocean          (qsr)
+         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(jpr_qsroce)%z3(:,:,1)
+         IF( srcv(jpr_qsrmix)%laction )   qsr(:,:) = frcv(jpr_qsrmix)%z3(:,:,1)
+         IF( ln_dm2dc )   qsr(:,:) = sbc_dcy( qsr )                           ! modify qsr to include the diurnal cycle
+         !
+         !                                                       ! total freshwater fluxes over the ocean (emp, emps)
+         SELECT CASE( TRIM( sn_rcv_emp%cldes ) )                                    ! evaporation - precipitation
+         CASE( 'conservative' )
+            emp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ( frcv(jpr_rain)%z3(:,:,1) + frcv(jpr_snow)%z3(:,:,1) )
+         CASE( 'oce only', 'oce and ice' )
+            emp(:,:) = frcv(jpr_oemp)%z3(:,:,1)
+         CASE default
+            CALL ctl_stop( 'sbc_cpl_rcv: wrong definition of sn_rcv_emp%cldes' )
+         END SELECT
+         !
+         !                                                        ! runoffs and calving (added in emp)
+         IF( srcv(jpr_rnf)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
+         IF( srcv(jpr_cal)%laction )   emp(:,:) = emp(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         !
+!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
+!!gm                                       at least should be optional...
+!!         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN     ! add to the total freshwater budget
+!!            ! remove negative runoff
+!!            zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
+!!            zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
+!!            IF( lk_mpp )   CALL mpp_sum( zcumulpos )   ! sum over the global domain
+!!            IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
+!!            IF( zcumulpos /= 0. ) THEN                 ! distribute negative runoff on positive runoff grid points
+!!               zcumulneg = 1.e0 + zcumulneg / zcumulpos
+!!               frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
+!!            ENDIF     
+!!            ! add runoff to e-p 
+!!            emp(:,:) = emp(:,:) - frcv(jpr_rnf)%z3(:,:,1)
+!!         ENDIF
+!!gm  end of internal cooking
+         !
+         emps(:,:) = emp(:,:)                                        ! concentration/dilution = emp
+  
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, ztx, zty )
+      !
+      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 
+      !!
+      !!                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, here 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 
+      !!             runoffs and calving directly enter the ocean.
+      !!              * solid precipitation (sprecip), used to add to qns_tot 
+      !!             the heat lost associated to melting solid precipitation
+      !!             over the ocean fraction.
+      !!       ===>> CAUTION here this changes the net heat flux received from
+      !!             the atmosphere
+      !!
+      !!                  - 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.
+      !!
+      !! ** 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) (-runoff)(-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   ! ice albedo 
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature     [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature     [Kelvin]
+      !
+      INTEGER ::   jl   ! dummy loop index
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zcptn, ztmp, zicefr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_ice_flx')
+      !
+      CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr )
+
+      zicefr(:,:) = 1.- p_frld(:,:)
+      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem)
+      !
+      !                                                      ! ========================= !
+      !                                                      !    freshwater budget      !   (emp)
+      !                                                      ! ========================= !
+      !
+      !                                                           ! total Precipitations - total Evaporation (emp_tot)
+      !                                                           ! solid precipitation  - sublimation       (emp_ice)
+      !                                                           ! solid Precipitation                      (sprecip)
+      SELECT CASE( TRIM( sn_rcv_emp%cldes ) )
+      CASE( 'conservative'  )   ! received fields: jpr_rain, jpr_snow, jpr_ievp, jpr_tevp
+         sprecip(:,:) = frcv(jpr_snow)%z3(:,:,1)                 ! May need to ensure positive here
+         tprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + sprecip (:,:) ! May need to ensure positive here
+         emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:)
+         emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1)
+                           CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation 
+         IF( lk_diaar5 )   CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip. 
+         ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)
+                           CALL iom_put( 'evap_ao_cea'  , ztmp                            )   ! ice-free oce evap (cell average)
+         IF( lk_diaar5 )   CALL iom_put( 'hflx_evap_cea', ztmp(:,:         ) * zcptn(:,:) )   ! heat flux from from evap (cell ave)
+      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp
+         emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)
+         emp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1)
+         sprecip(:,:) = - frcv(jpr_semp)%z3(:,:,1) + frcv(jpr_ievp)%z3(:,:,1)
+      END SELECT
+
+      CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow
+      CALL iom_put( 'snow_ao_cea', sprecip(:,:         ) * p_frld(:,:)    )   ! Snow        over ice-free ocean  (cell average)
+      CALL iom_put( 'snow_ai_cea', sprecip(:,:         ) * zicefr(:,:)    )   ! Snow        over sea-ice         (cell average)
+      CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average)
+      !   
+      !                                                           ! runoffs and calving (put in emp_tot)
+      IF( srcv(jpr_rnf)%laction ) THEN 
+         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)
+                           CALL iom_put( 'runoffs'      , frcv(jpr_rnf)%z3(:,:,1)              )   ! rivers
+         IF( lk_diaar5 )   CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from rivers
+      ENDIF
+      IF( srcv(jpr_cal)%laction ) THEN 
+         emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1)
+         CALL iom_put( 'calving', frcv(jpr_cal)%z3(:,:,1) )
+      ENDIF
+      !
+!!gm :  this seems to be internal cooking, not sure to need that in a generic interface 
+!!gm                                       at least should be optional...
+!!       ! remove negative runoff                            ! sum over the global domain
+!!       zcumulpos = SUM( MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) ) 
+!!       zcumulneg = SUM( MIN( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * e1t(:,:) * e2t(:,:) * tmask_i(:,:) )
+!!       IF( lk_mpp )   CALL mpp_sum( zcumulpos )
+!!       IF( lk_mpp )   CALL mpp_sum( zcumulneg ) 
+!!       IF( zcumulpos /= 0. ) THEN                          ! distribute negative runoff on positive runoff grid points
+!!          zcumulneg = 1.e0 + zcumulneg / zcumulpos
+!!          frcv(jpr_rnf)%z3(:,:,1) = MAX( frcv(jpr_rnf)%z3(:,:,1), 0.e0 ) * zcumulneg
+!!       ENDIF     
+!!       emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1)   ! add runoff to e-p 
+!!
+!!gm  end of internal cooking
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns)
+      !                                                      ! ========================= !
+      CASE( 'oce only' )                                     ! the required field is directly provided
+         qns_tot(:,:  ) = frcv(jpr_qnsoce)%z3(:,:,1)
+      CASE( 'conservative' )                                      ! the required fields are directly provided
+         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+            qns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl)
+         ELSE
+            ! Set all category values equal for the moment
+            DO jl=1,jpl
+               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      CASE( 'oce and ice' )       ! the total flux is computed from ocean and ice fluxes
+         qns_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN
+            DO jl=1,jpl
+               qns_tot(:,:   ) = qns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)   
+               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,jl)
+            ENDDO
+         ELSE
+            DO jl=1,jpl
+               qns_tot(:,:   ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)
+               qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      CASE( 'mixed oce-ice' )     ! the ice flux is cumputed from the total flux, the SST and ice informations
+! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
+         qns_tot(:,:  ) = frcv(jpr_qnsmix)%z3(:,:,1)
+         qns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1)    &
+            &            + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,:  ) ) * p_frld(:,:)   &
+            &                                                   +          pist(:,:,1)   * zicefr(:,:) ) )
+      END SELECT
+      ztmp(:,:) = p_frld(:,:) * sprecip(:,:) * lfus               ! add the latent heat of solid precip. melting
+      qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)                     ! over free ocean 
+      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average)
+!!gm
+!!    currently it is taken into account in leads budget but not in the qns_tot, and thus not in 
+!!    the flux that enter the ocean....
+!!    moreover 1 - it is not diagnose anywhere.... 
+!!             2 - it is unclear for me whether this heat lost is taken into account in the atmosphere or not...
+!!
+!! similar job should be done for snow and precipitation temperature
+      !                                     
+      IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting 
+         ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus               ! add the latent heat of iceberg melting 
+         qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:)
+         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from calving
+      ENDIF
+
+      !                                                      ! ========================= !
+      SELECT CASE( TRIM( sn_rcv_qsr%cldes ) )                !      solar heat fluxes    !   (qsr)
+      !                                                      ! ========================= !
+      CASE( 'oce only' )
+         qsr_tot(:,:  ) = MAX(0.0,frcv(jpr_qsroce)%z3(:,:,1))
+      CASE( 'conservative' )
+         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            qsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl)
+         ELSE
+            ! Set all category values equal for the moment
+            DO jl=1,jpl
+               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+         qsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1)
+      CASE( 'oce and ice' )
+         qsr_tot(:,:  ) =  p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)
+         IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN
+            DO jl=1,jpl
+               qsr_tot(:,:   ) = qsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)   
+               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,jl)
+            ENDDO
+         ELSE
+            DO jl=1,jpl
+               qsr_tot(:,:   ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)
+               qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      CASE( 'mixed oce-ice' )
+         qsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1)
+! ** NEED TO SORT OUT HOW THIS SHOULD WORK IN THE MULTI-CATEGORY CASE - CURRENTLY NOT ALLOWED WHEN INTERFACE INITIALISED **
+!       Create solar heat flux over ice using incoming solar heat flux and albedos
+!       ( see OASIS3 user guide, 5th edition, p39 )
+         qsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) )   &
+            &            / (  1.- ( albedo_oce_mix(:,:  ) * p_frld(:,:)       &
+            &                     + palbi         (:,:,1) * zicefr(:,:) ) )
+      END SELECT
+      IF( ln_dm2dc ) THEN   ! modify qsr to include the diurnal cycle
+         qsr_tot(:,:  ) = sbc_dcy( qsr_tot(:,:  ) )
+         DO jl=1,jpl
+            qsr_ice(:,:,jl) = sbc_dcy( qsr_ice(:,:,jl) )
+         ENDDO
+      ENDIF
+
+      SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) )
+      CASE ('coupled')
+         IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN
+            dqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)
+         ELSE
+            ! Set all category values equal for the moment
+            DO jl=1,jpl
+               dqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)
+            ENDDO
+         ENDIF
+      END SELECT
+
+      SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) )
+      CASE ('coupled')
+         topmelt(:,:,:)=frcv(jpr_topm)%z3(:,:,:)
+         botmelt(:,:,:)=frcv(jpr_botm)%z3(:,:,:)
+      END SELECT
+
+      CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr )
+      !
+      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_prism_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), 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(rdttra(1))        ! date of exchanges
+
+      zfr_l(:,:) = 1.- fr_i(:,:)
+
+      !                                                      ! ------------------------- !
+      !                                                      !    Surface temperature    !   in Kelvin
+      !                                                      ! ------------------------- !
+      SELECT CASE( sn_snd_temp%cldes)
+      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0
+      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)   
+         SELECT CASE( sn_snd_temp%clcat )
+         CASE( 'yes' )   
+            ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CASE( 'no' )
+            ztmp3(:,:,:) = 0.0
+            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(:,:) = ( tsn(:,:,1,1) + 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
+      IF( ssnd(jps_toce)%laction )   CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      IF( ssnd(jps_tice)%laction )   CALL cpl_prism_snd( jps_tice, isec, ztmp3, info )
+      IF( ssnd(jps_tmix)%laction )   CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      !
+      !                                                      ! ------------------------- !
+      !                                                      !           Albedo          !
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_albice)%laction ) THEN                         ! ice 
+         ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl)
+         CALL cpl_prism_snd( jps_albice, isec, ztmp3, info )
+      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_prism_snd( jps_albmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      ENDIF
+      !                                                      ! ------------------------- !
+      !                                                      !  Ice fraction & Thickness ! 
+      !                                                      ! ------------------------- !
+      ! Send ice fraction field 
+      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_prism_snd( jps_fice, isec, ztmp3, info )
+
+      ! Send ice and snow thickness field 
+      SELECT CASE( sn_snd_thick%cldes)
+      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'         )   
+         ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl)
+         ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl)
+      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' )
+      END SELECT
+      IF( ssnd(jps_hice)%laction )   CALL cpl_prism_snd( jps_hice, isec, ztmp3, info )
+      IF( ssnd(jps_hsnw)%laction )   CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info )
+      !
+#if defined key_cpl_carbon_cycle
+      !                                                      ! ------------------------- !
+      !                                                      !  CO2 flux from PISCES     ! 
+      !                                                      ! ------------------------- !
+      IF( ssnd(jps_co2)%laction )   CALL cpl_prism_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info )
+      !
+#endif
+      !                                                      ! ------------------------- !
+      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)
+         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. )
+         !
+         !
+         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_prism_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info )   ! ocean x current 1st grid
+         IF( ssnd(jps_ocy1)%laction )   CALL cpl_prism_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info )   ! ocean y current 1st grid
+         IF( ssnd(jps_ocz1)%laction )   CALL cpl_prism_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info )   ! ocean z current 1st grid
+         !
+         IF( ssnd(jps_ivx1)%laction )   CALL cpl_prism_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info )   ! ice   x current 1st grid
+         IF( ssnd(jps_ivy1)%laction )   CALL cpl_prism_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info )   ! ice   y current 1st grid
+         IF( ssnd(jps_ivz1)%laction )   CALL cpl_prism_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info )   ! ice   z current 1st grid
+         ! 
+      ENDIF
+      !
+      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
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                            NO coupling
+   !!----------------------------------------------------------------------
+   USE par_kind        ! kind definition
+CONTAINS
+   SUBROUTINE sbc_cpl_snd( kt )
+      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt
+   END SUBROUTINE sbc_cpl_snd
+   !
+   SUBROUTINE sbc_cpl_rcv( kt, k_fsbc, k_ice )     
+      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', kt, k_fsbc, k_ice
+   END SUBROUTINE sbc_cpl_rcv
+   !
+   SUBROUTINE sbc_cpl_ice_tau( p_taui, p_tauj )     
+      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)
+      p_taui(:,:) = 0.   ;   p_tauj(:,:) = 0. ! stupid definition to avoid warning message when compiling...
+      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?'
+   END SUBROUTINE sbc_cpl_ice_tau
+   !
+   SUBROUTINE sbc_cpl_ice_flx( p_frld , palbi   , psst    , pist  )
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ) ::   p_frld     ! lead fraction                [0 to 1]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   palbi   ! ice albedo
+      REAL(wp), INTENT(in   ), DIMENSION(:,:  ), OPTIONAL ::   psst    ! sea surface temperature      [Celcius]
+      REAL(wp), INTENT(in   ), DIMENSION(:,:,:), OPTIONAL ::   pist    ! ice surface temperature      [Kelvin]
+      WRITE(*,*) 'sbc_cpl_snd: You should not have seen this print! error?', p_frld(1,1), palbi(1,1,1), psst(1,1), pist(1,1,1) 
+   END SUBROUTINE sbc_cpl_ice_flx
+   
+#endif
+
+   !!======================================================================
+END MODULE sbccpl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcdcy.F90	(revision 3437)
@@ -0,0 +1,231 @@
+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 ) RESULT( zqsrout )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_dcy  ***
+      !!
+      !! ** Purpose : introduce a diurnal cycle of qsr from daily values
+      !!
+      !! ** Method  : see Appendix A of Bernie et al. 2007.
+      !!
+      !! ** Action  : redistribute daily QSR on each time step following the diurnal cycle
+      !!
+      !! reference  : Bernie, DJ, E Guilyardi, G Madec, JM Slingo, and SJ Woolnough, 2007
+      !!              Impact of resolving the diurnal cycle in an ocean--atmosphere GCM. 
+      !!              Part 1: a diurnally forced OGCM. Climate Dynamics 29:6, 575-590.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pqsrin    ! input daily QSR flux 
+      !!
+      INTEGER  ::   ji, jj                                       ! dummy loop indices
+      REAL(wp) ::   ztwopi, zinvtwopi, zconvrad 
+      REAL(wp) ::   zlo, zup, zlousd, zupusd
+      REAL(wp) ::   zdsws, zdecrad, ztx, zsin, zcos
+      REAL(wp) ::   ztmp, ztmp1, ztmp2, ztest
+      REAL(wp), DIMENSION(jpi,jpj) ::   zqsrout                  ! output QSR flux with diurnal cycle
+      !---------------------------statement functions------------------------
+      REAL(wp) ::   fintegral, pt1, pt2, paaa, pbbb, pccc        ! dummy statement function arguments
+      fintegral( pt1, pt2, paaa, pbbb, pccc ) =                         &
+         &   paaa * pt2 + zinvtwopi * pbbb * SIN(pccc + ztwopi * pt2)   &
+         & - paaa * pt1 - zinvtwopi * pbbb * SIN(pccc + ztwopi * pt1)
+      !!---------------------------------------------------------------------
+      !
+      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 * rdttra(1) ) / rday
+      zup = zlo + ( REAL(nn_fsbc, wp)     * rdttra(1) ) / rday
+      !                                          
+      IF( nday_qsr == -1 ) THEN       ! first time step only               
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'sbc_dcy : introduce diurnal cycle from daily mean qsr'
+            WRITE(numout,*) '~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+         ! 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 - glamt(:,:) / 360.
+         rtmd(:,:) = MOD( (rtmd(:,:) + 1.), 1. )
+      ENDIF
+
+      ! If this is a new day, we have to update the dawn, dusk and scaling function  
+      !----------------------
+    
+      !     2.1 dawn and dusk  
+
+      ! nday is the number of days since the beginning of the current month 
+      IF( nday_qsr /= nday ) THEN 
+         ! save the day of the year and the daily mean of qsr
+         nday_qsr = nday 
+         ! number of days since the previous winter solstice (supposed to be always 21 December)         
+         zdsws = REAL(11 + nday_year, wp)
+         ! declination of the earths orbit
+         zdecrad = (-23.5 * zconvrad) * COS( zdsws * ztwopi / REAL(nyear_len(1),wp) )
+         ! Compute A and B needed to compute the time integral of the diurnal cycle
+        
+         zsin = SIN( zdecrad )   ;   zcos = COS( zdecrad )
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               ztmp = zconvrad * gphit(ji,jj)
+               raa(ji,jj) = SIN( ztmp ) * zsin
+               rbb(ji,jj) = COS( ztmp ) * zcos
+            END DO  
+         END DO  
+
+         ! Compute the time of dawn and dusk
+
+         ! rab to test if the day time is equal to 0, less than 24h of full day        
+         rab(:,:) = -raa(:,:) / rbb(:,:)
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+         ! When is it night?
+                  ztx = zinvtwopi * (ACOS(rab(ji,jj)) - rcc(ji,jj))
+                  ztest = -rbb(ji,jj) * SIN( rcc(ji,jj) + ztwopi * ztx )
+         ! is it dawn or dusk?
+                  IF ( ztest > 0 ) THEN
+                     rdawn(ji,jj) = ztx
+                     rdusk(ji,jj) = rtmd(ji,jj) + ( rtmd(ji,jj) - rdawn(ji,jj) )
+                  ELSE
+                     rdusk(ji,jj) = ztx
+                     rdawn(ji,jj) = rtmd(ji,jj) - ( rdusk(ji,jj) - rtmd(ji,jj) )
+                  ENDIF
+               ELSE
+                  rdawn(ji,jj) = rtmd(ji,jj) + 0.5
+                  rdusk(ji,jj) = rdawn(ji,jj)
+               ENDIF
+             END DO  
+         END DO  
+         rdawn(:,:) = MOD( (rdawn(:,:) + 1._wp), 1._wp )
+         rdusk(:,:) = MOD( (rdusk(:,:) + 1._wp), 1._wp )
+
+         !     2.2 Compute the scalling function:
+         !         S* = the inverse of the time integral of the diurnal cycle from dawm to dusk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF ( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+                  IF ( rdawn(ji,jj) < rdusk(ji,jj) ) THEN      ! day time in one part
+                     rscal(ji,jj) = fintegral(rdawn(ji,jj), rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ELSE                                         ! day time in two parts
+                     rscal(ji,jj) = fintegral(0., rdusk(ji,jj), raa(ji,jj), rbb(ji,jj), rcc(ji,jj))   &
+                        &         + fintegral(rdawn(ji,jj), 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ENDIF
+               ELSE
+                  IF ( raa(ji,jj) > rbb(ji,jj) ) THEN         ! 24h day
+                     rscal(ji,jj) = fintegral(0., 1., raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                     rscal(ji,jj) = 1. / rscal(ji,jj)
+                  ELSE                                          ! No day
+                     rscal(ji,jj) = 0.e0
+                  ENDIF
+               ENDIF
+            END DO  
+         END DO  
+         !
+         ztmp = rday / ( rdttra(1) * REAL(nn_fsbc, wp) )
+         rscal(:,:) = rscal(:,:) * ztmp
+         !
+      ENDIF 
+
+         !     3. update qsr with the diurnal cycle
+         !     ------------------------------------
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( ABS(rab(ji,jj)) < 1 ) THEN         ! day duration is less than 24h
+               !
+               IF( rdawn(ji,jj) < rdusk(ji,jj) ) THEN       ! day time in one part
+                  zlousd = MAX(zlo, rdawn(ji,jj))
+                  zlousd = MIN(zlousd, zup)
+                  zupusd = MIN(zup, rdusk(ji,jj))
+                  zupusd = MAX(zupusd, zlo)
+                  ztmp = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  !
+               ELSE                                         ! day time in two parts
+                  zlousd = MIN(zlo, rdusk(ji,jj))
+                  zupusd = MIN(zup, rdusk(ji,jj))
+                  ztmp1 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zlousd = MAX(zlo, rdawn(ji,jj))
+                  zupusd = MAX(zup, rdawn(ji,jj))
+                  ztmp2 = fintegral(zlousd, zupusd, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  ztmp = ztmp1 + ztmp2
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+               ENDIF
+            ELSE                                   ! 24h light or 24h night
+               !
+               IF( raa(ji,jj) > rbb(ji,jj) ) THEN           ! 24h day
+                  ztmp = fintegral(zlo, zup, raa(ji,jj), rbb(ji,jj), rcc(ji,jj)) 
+                  zqsrout(ji,jj) = pqsrin(ji,jj) * ztmp * rscal(ji,jj)
+                  !
+               ELSE                                         ! No day
+                  zqsrout(ji,jj) = 0.e0
+               ENDIF
+            ENDIF
+         END DO  
+      END DO  
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sbc_dcy')
+      !
+   END FUNCTION sbc_dcy
+
+   !!======================================================================
+END MODULE sbcdcy
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90	(revision 3437)
@@ -0,0 +1,177 @@
+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 "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 mesh referential
+      !!                   i.e. the (i,j) 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, qsr    non-slor and solar heat flux
+      !!              - emp, emps   evaporation minus precipitation
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !!
+      INTEGER  ::   ji, jj, jf            ! dummy indices
+      INTEGER  ::   ierror                ! return error code
+      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
+         cn_dir = './'        ! directory in which the model is executed
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
+         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
+         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
+         !
+         REWIND ( numnam )                         ! read in namlist namflx
+         READ   ( numnam, 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' )
+         !
+      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
+!CDIR COLLAPSE
+         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
+         !                                                        ! module of wind stress and wind speed at T-point
+         zcoef = 1. / ( zrhoa * zcdrag )
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            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. )
+
+         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model)
+                  
+         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
+               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
+            END DO
+            CALL FLUSH(numout)
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_flx
+
+   !!======================================================================
+END MODULE sbcflx
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90	(revision 3437)
@@ -0,0 +1,202 @@
+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 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_fwb      : freshwater budget for global ocean configurations
+   !!                  in free surface and 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 sbcssr          ! SS 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 "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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
+      !!----------------------------------------------------------------------
+      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    !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread, z_wgt, 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 ' )
+         !
+         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface
+      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(:,:) ) ) / area   ! sum over the global domain
+            emp (:,:) = emp (:,:) - z_fwf 
+            emps(:,:) = emps(:,:) - z_fwf 
+         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 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!!
+         IF( MOD( kt, ikty ) == 0 ) THEN
+            a_fwb_b = a_fwb
+            a_fwb   = glob_sum( e1e2t(:,:) * sshn(:,:) )   ! sum over the global domain
+            a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s
+!!gm        !                                                      !!bug 365d year 
+            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
+            emp (:,:) = emp (:,:) + fwfold
+            emps(:,:) = emps(:,:) + fwfold
+         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 
+            z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area
+            !            
+            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation
+                zsurf_tospread      = zsurf_pos
+                ztmsk_tospread(:,:) = ztmsk_pos(:,:)
+            ELSE                             ! 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(:,:)
+            emps(:,:) = emps(:,:) + zerp_cor(:,:)
+            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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90	(revision 3437)
@@ -0,0 +1,989 @@
+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
+   USE in_out_manager  ! I/O manager
+   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_core     ! Surface boundary condition: CORE 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,vsnon,vicen
+   USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow,  &
+                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_forcing, only: frcvdr,frcvdf,frcidr,frcidf
+   USE ice_atmo, only: calc_strair
+   USE ice_therm_vertical, only: calc_Tsfc
+
+   USE CICE_InitMod
+   USE CICE_RunMod
+   USE CICE_FinalMod
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   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 , 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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+
+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, nsbc )
+      !!---------------------------------------------------------------------
+      !!                  ***  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 , emps
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   nsbc    ! 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 ( nsbc == 2 )  THEN
+            CALL cice_sbc_force(kt)
+         ELSE IF ( nsbc == 5 ) THEN
+            CALL sbc_cpl_ice_flx( 1.0-fr_i  )
+         ENDIF
+
+         CALL cice_sbc_in ( kt, nsbc )
+         CALL CICE_Run
+         CALL cice_sbc_out ( kt, nsbc )
+
+         IF ( nsbc == 5 )  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 (nsbc)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_init  ***
+      !! ** Purpose: Initialise ice related fields for NEMO and coupling
+      !!
+      INTEGER, INTENT( in  ) ::   nsbc ! surface forcing type
+      !!---------------------------------------------------------------------
+
+      INTEGER  ::   ji, jj, jpl                        ! dummy loop indices
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_init')
+      !
+      IF(lwp) WRITE(numout,*)'cice_sbc_init'
+
+! Initialize CICE
+      CALL CICE_Initialize
+
+! Do some CICE consistency checks
+      IF ( (nsbc == 2) .OR. (nsbc == 5) ) 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 (nsbc == 4) 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 ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+         DO jpl=1,ncat
+            CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), '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. )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init')
+      !
+   END SUBROUTINE cice_sbc_init
+
+   
+   SUBROUTINE cice_sbc_in (kt, nsbc)
+      !!---------------------------------------------------------------------
+      !!                    ***  ROUTINE cice_sbc_in  ***
+      !! ** Purpose: Set coupling fields and pass to CICE
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in   ) ::   kt   ! ocean time step
+      INTEGER, INTENT(in   ) ::   nsbc ! surface forcing type
+
+      INTEGER  ::   ji, jj, jpl                   ! dummy loop indices      
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp
+      REAL(wp), DIMENSION(:,:,:), POINTER :: ztmpn
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_in')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmp )
+      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 ( (nsbc == 2).OR.(nsbc == 5) ) 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 (nsbc == 2) THEN
+            DO jpl=1,ncat
+               ztmpn(:,:,jpl)=qla_ice(:,:,1)*a_i(:,:,jpl)
+            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 jpl=1,ncat
+                        ztmpn(ji,jj,jpl)=0.0
+                     ENDDO
+                     ! This will then be conserved in CICE
+                     ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
+                  ELSE
+                     DO jpl=1,ncat
+                        ztmpn(ji,jj,jpl)=qla_ice(ji,jj,1)*a_i(ji,jj,jpl)/fr_i(ji,jj)
+                     ENDDO
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+         DO jpl=1,ncat
+            CALL nemo2cice(ztmpn(:,:,jpl),flatn_f(:,:,jpl,:),'T', 1. )
+
+! GBM conductive flux through ice (CI_6)
+!  Convert to GBM
+            IF (nsbc == 2) THEN
+               ztmp(:,:) = botmelt(:,:,jpl)*a_i(:,:,jpl)
+            ELSE
+               ztmp(:,:) = botmelt(:,:,jpl)
+            ENDIF
+            CALL nemo2cice(ztmp,fcondtopn_f(:,:,jpl,:),'T', 1. )
+
+! GBM surface heat flux (CI_7)
+!  Convert to GBM
+            IF (nsbc == 2) THEN
+               ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))*a_i(:,:,jpl) 
+            ELSE
+               ztmp(:,:) = (topmelt(:,:,jpl)+botmelt(:,:,jpl))
+            ENDIF
+            CALL nemo2cice(ztmp,fsurfn_f(:,:,jpl,:),'T', 1. )
+         ENDDO
+
+      ELSE IF (nsbc == 4) THEN
+
+! Pass CORE 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)  
+      ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)  
+      CALL nemo2cice(ztmp,fsnow,'T', 1. ) 
+
+! Rainfall
+      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*fse3t_m(:,:,1)*(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. )
+
+! 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 * (  (ssh_m(ji+1,jj  )-ssh_m(ji,jj  ))/e1u(ji,jj  )   &
+                               + (ssh_m(ji+1,jj+1)-ssh_m(ji,jj+1))/e1u(ji,jj+1) ) & 
+                            *  fmask(ji,jj,1)
+         ENDDO
+      ENDDO
+      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 * (  (ssh_m(ji  ,jj+1)-ssh_m(ji  ,jj))/e2v(ji  ,jj)   &
+                               + (ssh_m(ji+1,jj+1)-ssh_m(ji+1,jj))/e2v(ji+1,jj) ) &
+                            *  fmask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
+
+      CALL wrk_dealloc( jpi,jpj, ztmp )
+      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,nsbc)
+      !!---------------------------------------------------------------------
+      !!                    ***  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  ) ::   nsbc ! surface forcing type
+      
+      INTEGER  ::   ji, jj, jpl                 ! dummy loop indices
+      REAL(wp), DIMENSION(:,:), POINTER :: ztmp
+      !!---------------------------------------------------------------------
+
+      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_out')
+      !
+      CALL wrk_alloc( jpi,jpj, ztmp )
+      
+      IF( kt == nit000 )  THEN
+         IF(lwp) WRITE(numout,*)'cice_sbc_out'
+      ENDIF
+      
+! x comp of ocean-ice stress 
+      CALL cice2nemo(strocnx,ztmp,'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 * ( ztmp(ji,jj-1) + ztmp(ji,jj) ) * umask(ji,jj,1)
+         ENDDO
+      ENDDO
+      CALL lbc_lnk( ss_iou , 'U', -1. )
+
+! y comp of ocean-ice stress 
+      CALL cice2nemo(strocny,ztmp,'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 * ( ztmp(ji-1,jj) + ztmp(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]
+
+      utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
+      vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)     
+
+! Freshwater fluxes 
+
+      IF (nsbc == 2) 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 (nsbc == 4) THEN
+         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)        
+      ELSE IF (nsbc ==5) THEN
+! emp_tot is set in sbc_cpl_ice_flx (call from cice_sbc_in above) 
+         emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:) 
+      ENDIF
+
+! Subtract fluxes from CICE to get freshwater equivalent flux used in 
+! salinity calculation
+      CALL cice2nemo(fresh_gbm,ztmp,'T', 1. )
+      emps(:,:)=emp(:,:)-ztmp(:,:)
+! Note the 1000.0 is to convert from kg salt to g salt (needed for PSU)
+      CALL cice2nemo(fsalt_gbm,ztmp,'T', 1. )
+      DO jj=1,jpj
+         DO ji=1,jpi
+            IF (sss_m(ji,jj).gt.0.0) THEN
+               emps(ji,jj)=emps(ji,jj)+ztmp(ji,jj)*1000.0/sss_m(ji,jj)
+            ENDIF
+         ENDDO
+      ENDDO
+
+! No longer remove precip over ice from free surface calculation on basis that the
+! weight of the precip will affect the free surface even if it falls on the ice
+! (same to the argument that freezing / melting of ice doesn't change the free surface) 
+! Sublimation from the ice is treated in a similar way (included in emp but not emps)  
+!
+! This should not be done in the variable volume case
+
+      IF (.NOT. lk_vvl) THEN
+
+         emp(:,:)  = emp(:,:) - tprecip(:,:)*fr_i(:,:)
+
+! Take sublimation into account
+         IF (nsbc == 5 ) THEN 
+            emp(:,:) = emp(:,:) + ( emp_ice(:,:) + sprecip(:,:) )
+         ELSE IF (nsbc == 2 ) THEN
+            emp(:,:) = emp(:,:) - qla_ice(:,:,1) / Lsub
+         ENDIF
+
+      ENDIF
+
+      CALL lbc_lnk( emp , 'T', 1. )
+      CALL lbc_lnk( emps , 'T', 1. )
+
+! Solar penetrative radiation and non solar surface heat flux
+
+! Scale qsr and qns according to ice fraction (bulk formulae only)
+
+      IF (nsbc == 4) 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 (nsbc == 5) 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]
+      CALL cice2nemo(fswthru_gbm,ztmp,'T', 1. )
+      qsr(:,:)=qsr(:,:)+ztmp(:,:)
+      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
+
+      CALL cice2nemo(fhocn_gbm,ztmp,'T', 1. )
+      qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp(:,:)
+
+      CALL lbc_lnk( qns , 'T', 1. )
+
+! Prepare for the following CICE time-step
+
+      CALL cice2nemo(aice,fr_i,'T', 1. )
+      IF ( (nsbc == 2).OR.(nsbc == 5) ) THEN
+         DO jpl=1,ncat
+            CALL cice2nemo(aicen(:,:,jpl,:),a_i(:,:,jpl), '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. )
+
+! Release work space
+
+      CALL wrk_dealloc( jpi,jpj, ztmp )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_out')
+      !
+   END SUBROUTINE cice_sbc_out
+
+
+#if defined key_oasis3 || defined key_oasis4
+   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  ::   jpl                        ! 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 jpl = 1,ncat
+         CALL cice2nemo(vsnon(:,:,jpl,:),ht_s(:,:,jpl),'T', 1. )
+         CALL cice2nemo(vicen(:,:,jpl,:),ht_i(:,:,jpl),'T', 1. )
+      ENDDO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_hadgam')
+      !
+   END SUBROUTINE cice_sbc_hadgam
+
+#else
+   SUBROUTINE cice_sbc_hadgam( kt )    ! Dummy routine
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      WRITE(*,*) 'cice_sbc_hadgam: You should not have seen this print! error?'
+   END SUBROUTINE cice_sbc_hadgam
+#endif
+
+   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
+      !!---------------------------------------------------------------------
+
+      !                                         ! ====================== !
+      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   !
+         !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
+         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 )               ! ... at some point might read in from NEMO namelist?
+!         READ   ( numnam, 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 (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
+         DO ji=2,nx_block
+            pc(ji,jj,1)=pn(ji,jj-1)
+         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=1,nlcjt(jn)-1
+               DO ji=2,nlcit(jn)-1
+                  pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)=png(ji,jj,jn)       
+               ENDDO
+            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,jj+1,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)
+
+      IF (nproc==0) THEN
+         png(:,:,:)=0.0
+         DO jn=1,jpnij
+            DO jj=1,nlcjt(jn)-1
+               DO ji=2,nlcit(jn)-1
+                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-2,jj+njmppt(jn)-1)      
+               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, nsbc )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt
+   END SUBROUTINE sbc_ice_cice
+
+   SUBROUTINE cice_sbc_init (nsbc)    ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90	(revision 3437)
@@ -0,0 +1,145 @@
+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
+   USE sbccpl
+   USE fldread         ! read input field
+   USE iom             ! I/O manager library
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! MPP library
+
+   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)
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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, emps  : 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
+      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
+         cn_dir = './'        ! directory in which the model is executed
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !             !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   !
+         !             !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      ! 
+         sn_ice = FLD_N('ice_cover',    -1    ,  'ice_cov' ,  .true.    , .true. ,   'yearly'  , ''       , ''         )
+
+         REWIND ( numnam )               ! ... read in namlist namiif
+         READ   ( numnam, 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 )
+         
+         fr_i(:,:) = tfreez( sss_m ) * tmask(:,:,1)      ! sea surface freezing temperature [Celcius]
+#if defined key_coupled 
+         a_i(:,:,1) = fr_i(:,:)         
+#endif
+
+         ! Flux and ice fraction computation
+!CDIR COLLAPSE
+         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.e0, ff(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90	(revision 3437)
@@ -0,0 +1,674 @@
+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
+   !!            4.0  ! 2011-01  (A Porter)  dynamical allocation
+   !!----------------------------------------------------------------------
+#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
+   !!   lim_ctl       : alerts in case of ice model crash
+   !!   lim_prt_state : ice control print at a given grid point
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE par_ice         ! sea-ice parameters
+   USE ice             ! LIM-3: ice variables
+   USE iceini          ! LIM-3: ice initialisation
+   USE dom_ice         ! LIM-3: ice domain
+
+   USE sbc_oce         ! Surface boundary condition: ocean fields
+   USE sbc_ice         ! Surface boundary condition: ice   fields
+   USE sbcblk_core     ! Surface boundary condition: CORE bulk
+   USE sbcblk_clio     ! Surface boundary condition: CLIO bulk
+   USE 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 limthd          ! Ice thermodynamics
+   USE limitd_th       ! Thermodynamics on ice thickness distribution 
+   USE limitd_me       ! Mechanics on ice thickness distribution
+   USE limsbc          ! sea surface boundary condition
+   USE limdia          ! Ice diagnostics
+   USE limwri          ! Ice outputs
+   USE limrst          ! Ice restarts
+   USE limupdate       ! update of global variables
+   USE limvar          ! Ice variables switch
+
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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, kblk )
+      !!---------------------------------------------------------------------
+      !!                  ***  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 , emps
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE)
+      !!
+      INTEGER  ::   jl      ! dummy loop index
+      REAL(wp) ::   zcoef   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs )
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc_ice_lim : update ocean surface boudary condition' 
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   via Louvain la Neuve Ice Model (LIM-3) time stepping'
+         !
+         CALL ice_init
+         !
+         IF( ln_nicep ) THEN      ! control print at a given point
+            jiindx = 44   ;   jjindx = 140
+            WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx
+         ENDIF
+      ENDIF
+
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+         !                                           !  Bulk Formulea !
+         !                                           !----------------!
+         !
+         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
+         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean)
+         !
+         t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin]
+         !                                           ! (set to rt0 over land)
+         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo
+
+         DO jl = 1, jpl
+            t_su(:,:,jl) = t_su(:,:,jl) +  rt0 * ( 1. - tmask(:,:,1) )
+         END DO
+                                                     ! Bulk formulea - provides the following fields:
+         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2]
+         ! 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             [%]
+         !
+         SELECT CASE( kblk )
+         CASE( 3 )                                       ! CLIO bulk formulation
+            CALL blk_ice_clio( t_su , zalb_ice_cs, zalb_ice_os,                           &
+               &                      utau_ice   , vtau_ice   , qns_ice   , qsr_ice   ,   &
+               &                      qla_ice    , dqns_ice   , dqla_ice  ,               &
+               &                      tprecip    , sprecip    ,                           &
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh, jpl  )
+            !         
+         CASE( 4 )                                       ! CORE bulk formulation
+            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               &
+               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   &
+               &                      qla_ice   , dqns_ice  , dqla_ice   ,               &
+               &                      tprecip   , sprecip   ,                            &
+               &                      fr1_i0    , fr2_i0    , cp_ice_msh, jpl  )
+         END SELECT
+
+         !                                           !----------------------!
+         !                                           ! LIM-3  time-stepping !
+         !                                           !----------------------!
+         ! 
+         numit = numit + nn_fsbc                     ! Ice model time step
+         !
+         !                                           ! Store previous ice values
+!!gm : remark   old_...   should becomes ...b  as tn versus tb  
+         old_a_i  (:,:,:)   = a_i  (:,:,:)     ! ice area
+         old_e_i  (:,:,:,:) = e_i  (:,:,:,:)   ! ice thermal energy
+         old_v_i  (:,:,:)   = v_i  (:,:,:)     ! ice volume
+         old_v_s  (:,:,:)   = v_s  (:,:,:)     ! snow volume 
+         old_e_s  (:,:,:,:) = e_s  (:,:,:,:)   ! snow thermal energy
+         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content
+         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content
+
+         !                                           ! intialisation to zero    !!gm is it truly necessary ???
+         d_a_i_thd  (:,:,:)   = 0.e0   ;   d_a_i_trp  (:,:,:)   = 0.e0
+         d_v_i_thd  (:,:,:)   = 0.e0   ;   d_v_i_trp  (:,:,:)   = 0.e0
+         d_e_i_thd  (:,:,:,:) = 0.e0   ;   d_e_i_trp  (:,:,:,:) = 0.e0
+         d_v_s_thd  (:,:,:)   = 0.e0   ;   d_v_s_trp  (:,:,:)   = 0.e0
+         d_e_s_thd  (:,:,:,:) = 0.e0   ;   d_e_s_trp  (:,:,:,:) = 0.e0
+         d_smv_i_thd(:,:,:)   = 0.e0   ;   d_smv_i_trp(:,:,:)   = 0.e0
+         d_oa_i_thd (:,:,:)   = 0.e0   ;   d_oa_i_trp (:,:,:)   = 0.e0
+         !
+         fseqv    (:,:) = 0.e0
+         fsbri    (:,:) = 0.e0     ;   fsalt_res(:,:) = 0.e0
+         fsalt_rpo(:,:) = 0.e0
+         fhmec    (:,:) = 0.e0     ;   fhbri    (:,:) = 0.e0
+         fmmec    (:,:) = 0.e0     ;   fheat_res(:,:) = 0.e0
+         fheat_rpo(:,:) = 0.e0     ;   focea2D  (:,:) = 0.e0
+         fsup2D   (:,:) = 0.e0
+         ! 
+         diag_sni_gr(:,:) = 0.e0   ;   diag_lat_gr(:,:) = 0.e0
+         diag_bot_gr(:,:) = 0.e0   ;   diag_dyn_gr(:,:) = 0.e0
+         diag_bot_me(:,:) = 0.e0   ;   diag_sur_me(:,:) = 0.e0
+         ! dynamical invariants
+         delta_i(:,:) = 0.e0       ;   divu_i(:,:) = 0.e0       ;   shear_i(:,:) = 0.e0
+
+                          CALL lim_rst_opn( kt )     ! Open Ice restart file
+         !
+         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - Beginning the time step - ' )   ! control print
+         !
+         IF( .NOT. lk_c1d ) THEN
+                                                     ! Ice dynamics & transport (not in 1D case)
+                          CALL lim_dyn( kt )              ! Ice dynamics    ( rheology/dynamics )
+                          CALL lim_trp( kt )              ! Ice transport   ( Advection/diffusion )
+                          CALL lim_var_agg(1)             ! aggregate categories, requested
+                          CALL lim_var_glo2eqv            ! equivalent variables, requested for rafting
+         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx,-1, ' - ice dyn & trp - ' )   ! control print
+                          CALL lim_itd_me                 ! Mechanical redistribution ! (ridging/rafting)
+         ENDIF
+         !                                           ! Ice thermodynamics 
+                          CALL lim_var_glo2eqv            ! equivalent variables
+                          CALL lim_var_agg(1)             ! aggregate ice categories
+                          CALL lim_var_bv                 ! bulk brine volume (diag)
+                          CALL lim_thd( kt )              ! Ice thermodynamics 
+                          zcoef = rdt_ice / 86400.e0      !  Ice natural aging
+                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef
+                          CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin)
+         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print
+                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  !
+         !
+         !                                           ! Global variables update
+                          CALL lim_var_agg( 1 )           ! requested by limupdate
+                          CALL lim_update                 ! Global variables update
+                          CALL lim_var_glo2eqv            ! equivalent variables (outputs)
+                          CALL lim_var_agg(2)             ! aggregate ice thickness categories
+         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 2, ' - Final state - ' )   ! control print
+         !
+                          CALL lim_sbc_flx( kt )     ! Update surface ocean mass, heat and salt fluxes
+         !
+         IF( ln_nicep )   CALL lim_prt_state( jiindx, jjindx, 3, ' - Final state lim_sbc - ' )   ! control print
+         !
+         !                                           ! Diagnostics and outputs 
+         IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
+            &             CALL lim_dia 
+                          CALL lim_wri( 1  )              ! Ice outputs 
+         IF( lrst_ice )   CALL lim_rst_write( kt )        ! Ice restart file 
+                          CALL lim_var_glo2eqv            ! ???
+         !
+         IF( ln_nicep )   CALL lim_ctl               ! alerts in case of model crash
+         !
+      ENDIF                                    ! End sea-ice time step only
+
+      !                                        !--------------------------!
+      !                                        !  at all ocean time step  !
+      !                                        !--------------------------!
+      !                                               
+      !                                              ! Update surface ocean stresses (only in ice-dynamic case)
+      !                                                   ! otherwise the atm.-ocean stresses are used everywhere
+      IF( ln_limdyn )     CALL lim_sbc_tau( kt, ub(:,:,1), vb(:,:,1) )  ! using before instantaneous surf. currents
+      
+!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!!
+      !
+      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs )
+      !
+   END SUBROUTINE sbc_ice_lim
+
+
+   SUBROUTINE lim_ctl
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_ctl *** 
+      !!                 
+      !! ** Purpose :   Alerts in case of model crash
+      !!-------------------------------------------------------------------
+      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.e0   .AND.   a_i(ji,jj,jl) == 0.e0   ) 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_old ', a_i      (ji,jj,jl), old_a_i  (ji,jj,jl)
+                  WRITE(numout,*) ' v_i *** v_i_old ', v_i      (ji,jj,jl), old_v_i  (ji,jj,jl)
+                  WRITE(numout,*) ' d_a_i_thd/trp   ', d_a_i_thd(ji,jj,jl), d_a_i_trp(ji,jj,jl)
+                  WRITE(numout,*) ' d_v_i_thd/trp   ', d_v_i_thd(ji,jj,jl), d_v_i_trp(ji,jj,jl)
+                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Alerte if very thick ice
+      ialert_id = 3 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very thick ice               ' ! name of the alert
+      jl = jpl 
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   ht_i(ji,jj,jl) .GT. 50.0   ) THEN
+               CALL lim_prt_state( 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) ) ) .GT. 0.5  .AND.  &
+               &  at_i(ji,jj) .GT. 0.e0   ) THEN
+               CALL lim_prt_state( ji, jj, 1, ' ALERTE 4 :   Very fast ice ' )
+               WRITE(numout,*) ' ice strength             : ', strength(ji,jj)
+               WRITE(numout,*) ' oceanic stress utau      : ', utau(ji,jj) 
+               WRITE(numout,*) ' oceanic stress vtau      : ', vtau(ji,jj)
+               WRITE(numout,*) ' sea-ice stress utau_ice  : ', utau_ice(ji,jj) 
+               WRITE(numout,*) ' sea-ice stress vtau_ice  : ', vtau_ice(ji,jj)
+               WRITE(numout,*) ' oceanic speed u          : ', u_oce(ji,jj)
+               WRITE(numout,*) ' oceanic speed v          : ', v_oce(ji,jj)
+               WRITE(numout,*) ' sst                      : ', sst_m(ji,jj)
+               WRITE(numout,*) ' sss                      : ', sss_m(ji,jj)
+               WRITE(numout,*) 
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if there is ice on continents
+      ialert_id = 6 ! reference number of this alert
+      cl_alname(ialert_id) = ' Ice on continents           ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   tms(ji,jj) .LE. 0.0   .AND.   at_i(ji,jj) .GT. 0.e0   ) THEN 
+               CALL lim_prt_state( ji, jj, 1, ' ALERTE 6 :   Ice on continents ' )
+               WRITE(numout,*) ' masks s, u, v        : ', tms(ji,jj), tmu(ji,jj), tmv(ji,jj) 
+               WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+               WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+               WRITE(numout,*) ' at_i(ji,jj)          : ', at_i(ji,jj)
+               WRITE(numout,*) ' v_ice(ji,jj)         : ', v_ice(ji,jj)
+               WRITE(numout,*) ' v_ice(ji,jj-1)       : ', v_ice(ji,jj-1)
+               WRITE(numout,*) ' u_ice(ji-1,jj)       : ', u_ice(ji-1,jj)
+               WRITE(numout,*) ' u_ice(ji,jj)         : ', v_ice(ji,jj)
+               !
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+!
+!     ! Alert if very fresh ice
+      ialert_id = 7 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very fresh ice               ' ! name of the alert
+      DO jl = 1, jpl
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+!!gm  test twice sm_i ...  ????  bug?
+               IF( ( ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) .OR. &
+                     ( ABS( sm_i(ji,jj,jl) ) .LT. 0.50) ) .AND. &
+                             ( a_i(ji,jj,jl) .GT. 0.e0 ) ) THEN
+!                 CALL lim_prt_state(ji,jj,1, ' ALERTE 7 :   Very fresh ice ' )
+!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj)
+!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj)
+!                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl)
+!                 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) ) .GT. rdt_ice ) .OR. &
+                      ( ABS( o_i(ji,jj,jl) ) .LT. 0.00) ) .AND. &
+                             ( a_i(ji,jj,jl) .GT. 0.0 ) ) THEN
+                  CALL lim_prt_state( 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( emps(ji,jj) ) .GT. 1.0e-2 ) THEN
+               CALL lim_prt_state( 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) , ' old_a_i    : ', old_a_i  (ji,jj,jl)   
+                  WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ji,jj,jl) , ' d_a_i_thd  : ', d_a_i_thd(ji,jj,jl) 
+                  WRITE(numout,*) ' v_i        : ', v_i      (ji,jj,jl) , ' old_v_i    : ', old_v_i  (ji,jj,jl)   
+                  WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ji,jj,jl) , ' d_v_i_thd  : ', d_v_i_thd(ji,jj,jl) 
+                  WRITE(numout,*) ' '
+               END DO
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+            ENDIF
+         END DO
+      END DO
+
+      ! Alert if qns very big
+      ialert_id = 8 ! reference number of this alert
+      cl_alname(ialert_id) = ' fnsolar very big             ' ! name of the alert
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF(   ABS( qns(ji,jj) ) .GT. 1500.0   .AND.  ( at_i(ji,jj) .GT. 0.0 ) )  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)
+               WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj)
+               WRITE(numout,*) ' qldif     : ', qldif(ji,jj)
+               WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice
+               WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice
+               WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj)
+               WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj)
+               WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice
+               WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice
+               WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
+               WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj) 
+               WRITE(numout,*) ' fheat_rpo : ', fheat_rpo(ji,jj) 
+               WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
+               WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj) 
+               !
+               CALL lim_prt_state( ji, jj, 2, '   ')
+               inb_alp(ialert_id) = inb_alp(ialert_id) + 1
+               !
+            ENDIF
+         END DO
+      END DO
+      !+++++
+ 
+      ! Alert if very warm ice
+      ialert_id = 10 ! reference number of this alert
+      cl_alname(ialert_id) = ' Very warm ice                ' ! name of the alert
+      inb_alp(ialert_id) = 0
+      DO jl = 1, jpl
+         DO jk = 1, nlay_i
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmelts    =  -tmut * s_i(ji,jj,jk,jl) + rtt
+                  IF( t_i(ji,jj,jk,jl) .GE. ztmelts  .AND.  v_i(ji,jj,jl) .GT. 1.e-6   &
+                     &                               .AND.  a_i(ji,jj,jl) .GT. 0.e0    ) 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
+
+      ialert_id = 1                                 ! reference number of this alert
+      cl_alname(ialert_id) = ' NO alerte 1      '   ! name of the alert
+      WRITE(numout,*)
+      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
+      !
+   END SUBROUTINE lim_ctl
+ 
+   
+   SUBROUTINE lim_prt_state( ki, kj, kn, cd1 )
+      !!-----------------------------------------------------------------------
+      !!                   ***  ROUTINE lim_prt_state *** 
+      !!                 
+      !! ** Purpose :   Writes global ice state on the (i,j) point 
+      !!                in ocean.ouput 
+      !!                3 possibilities exist 
+      !!                n = 1/-1 -> simple ice state (plus Mechanical Check if -1)
+      !!                n = 2    -> exhaustive state
+      !!                n = 3    -> ice/ocean salt fluxes
+      !!
+      !! ** input   :   point coordinates (i,j) 
+      !!                n : number of the option
+      !!-------------------------------------------------------------------
+      INTEGER         , INTENT(in) ::   ki, kj, kn    ! ocean gridpoint indices
+      CHARACTER(len=*), INTENT(in) ::   cd1           !
+      !!
+      INTEGER :: jl
+      !!-------------------------------------------------------------------
+
+      WRITE(numout,*) cd1             ! print title
+
+      !----------------
+      !  Simple state
+      !----------------
+
+      IF ( kn == 1 .OR. kn == -1 ) THEN
+         WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+         WRITE(numout,*) ' Simple state '
+         WRITE(numout,*) ' masks s,u,v   : ', tms(ki,kj), tmu(ki,kj), tmv(ki,kj)
+         WRITE(numout,*) ' lat - long    : ', gphit(ki,kj), glamt(ki,kj)
+         WRITE(numout,*) ' Time step     : ', numit
+         WRITE(numout,*) ' - Ice drift   '
+         WRITE(numout,*) '   ~~~~~~~~~~~ '
+         WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ki-1,kj)
+         WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ki,kj)
+         WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ki,kj-1)
+         WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ki,kj)
+         WRITE(numout,*) ' strength      : ', strength(ki,kj)
+         WRITE(numout,*)
+         WRITE(numout,*) ' - Cell values '
+         WRITE(numout,*) '   ~~~~~~~~~~~ '
+         WRITE(numout,*) ' cell area     : ', area(ki,kj)
+         WRITE(numout,*) ' at_i          : ', at_i(ki,kj)       
+         WRITE(numout,*) ' vt_i          : ', vt_i(ki,kj)       
+         WRITE(numout,*) ' vt_s          : ', vt_s(ki,kj)       
+         DO jl = 1, jpl
+            WRITE(numout,*) ' - Category (', jl,')'
+            WRITE(numout,*) ' a_i           : ', a_i(ki,kj,jl)
+            WRITE(numout,*) ' ht_i          : ', ht_i(ki,kj,jl)
+            WRITE(numout,*) ' ht_s          : ', ht_s(ki,kj,jl)
+            WRITE(numout,*) ' v_i           : ', v_i(ki,kj,jl)
+            WRITE(numout,*) ' v_s           : ', v_s(ki,kj,jl)
+            WRITE(numout,*) ' e_s           : ', e_s(ki,kj,1,jl)/1.0e9
+            WRITE(numout,*) ' e_i           : ', e_i(ki,kj,1:nlay_i,jl)/1.0e9
+            WRITE(numout,*) ' t_su          : ', t_su(ki,kj,jl)
+            WRITE(numout,*) ' t_snow        : ', t_s(ki,kj,1,jl)
+            WRITE(numout,*) ' t_i           : ', t_i(ki,kj,1:nlay_i,jl)
+            WRITE(numout,*) ' sm_i          : ', sm_i(ki,kj,jl)
+            WRITE(numout,*) ' smv_i         : ', smv_i(ki,kj,jl)
+            WRITE(numout,*)
+            WRITE(numout,*) ' Pathological case : ', patho_case(ki,kj,jl)
+         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 (ki,kj)
+         WRITE(numout,*) ' Total lead fraction     ', ato_i(ki,kj)
+         WRITE(numout,*) ' Sum of both             ', ato_i(ki,kj) + at_i(ki,kj)
+         WRITE(numout,*) ' Sum of both minus 1     ', ato_i(ki,kj) + at_i(ki,kj) - 1.00
+      ENDIF
+
+
+      !--------------------
+      !  Exhaustive state
+      !--------------------
+
+      IF ( kn .EQ. 2 ) THEN
+         WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+         WRITE(numout,*) ' Exhaustive state '
+         WRITE(numout,*) ' lat - long ', gphit(ki,kj), glamt(ki,kj)
+         WRITE(numout,*) ' Time step ', numit
+         WRITE(numout,*) 
+         WRITE(numout,*) ' - Cell values '
+         WRITE(numout,*) '   ~~~~~~~~~~~ '
+         WRITE(numout,*) ' cell area     : ', area(ki,kj)
+         WRITE(numout,*) ' at_i          : ', at_i(ki,kj)       
+         WRITE(numout,*) ' vt_i          : ', vt_i(ki,kj)       
+         WRITE(numout,*) ' vt_s          : ', vt_s(ki,kj)       
+         WRITE(numout,*) ' u_ice(i-1,j)  : ', u_ice(ki-1,kj)
+         WRITE(numout,*) ' u_ice(i  ,j)  : ', u_ice(ki,kj)
+         WRITE(numout,*) ' v_ice(i  ,j-1): ', v_ice(ki,kj-1)
+         WRITE(numout,*) ' v_ice(i  ,j)  : ', v_ice(ki,kj)
+         WRITE(numout,*) ' strength      : ', strength(ki,kj)
+         WRITE(numout,*) ' d_u_ice_dyn   : ', d_u_ice_dyn(ki,kj), ' d_v_ice_dyn   : ', d_v_ice_dyn(ki,kj)
+         WRITE(numout,*) ' old_u_ice     : ', old_u_ice(ki,kj)  , ' old_v_ice     : ', old_v_ice(ki,kj)  
+         WRITE(numout,*)
+
+         DO jl = 1, jpl
+              WRITE(numout,*) ' - Category (',jl,')'
+              WRITE(numout,*) '   ~~~~~~~~         ' 
+              WRITE(numout,*) ' ht_i       : ', ht_i(ki,kj,jl)             , ' ht_s       : ', ht_s(ki,kj,jl)
+              WRITE(numout,*) ' t_i        : ', t_i(ki,kj,1:nlay_i,jl)
+              WRITE(numout,*) ' t_su       : ', t_su(ki,kj,jl)             , ' t_s        : ', t_s(ki,kj,1,jl)
+              WRITE(numout,*) ' sm_i       : ', sm_i(ki,kj,jl)             , ' o_i        : ', o_i(ki,kj,jl)
+              WRITE(numout,*) ' a_i        : ', a_i(ki,kj,jl)              , ' old_a_i    : ', old_a_i(ki,kj,jl)   
+              WRITE(numout,*) ' d_a_i_trp  : ', d_a_i_trp(ki,kj,jl)        , ' d_a_i_thd  : ', d_a_i_thd(ki,kj,jl) 
+              WRITE(numout,*) ' v_i        : ', v_i(ki,kj,jl)              , ' old_v_i    : ', old_v_i(ki,kj,jl)   
+              WRITE(numout,*) ' d_v_i_trp  : ', d_v_i_trp(ki,kj,jl)        , ' d_v_i_thd  : ', d_v_i_thd(ki,kj,jl) 
+              WRITE(numout,*) ' v_s        : ', v_s(ki,kj,jl)              , ' old_v_s    : ', old_v_s(ki,kj,jl)  
+              WRITE(numout,*) ' d_v_s_trp  : ', d_v_s_trp(ki,kj,jl)        , ' d_v_s_thd  : ', d_v_s_thd(ki,kj,jl)
+              WRITE(numout,*) ' e_i1       : ', e_i(ki,kj,1,jl)/1.0e9      , ' old_ei1    : ', old_e_i(ki,kj,1,jl)/1.0e9 
+              WRITE(numout,*) ' de_i1_trp  : ', d_e_i_trp(ki,kj,1,jl)/1.0e9, ' de_i1_thd  : ', d_e_i_thd(ki,kj,1,jl)/1.0e9
+              WRITE(numout,*) ' e_i2       : ', e_i(ki,kj,2,jl)/1.0e9      , ' old_ei2    : ', old_e_i(ki,kj,2,jl)/1.0e9  
+              WRITE(numout,*) ' de_i2_trp  : ', d_e_i_trp(ki,kj,2,jl)/1.0e9, ' de_i2_thd  : ', d_e_i_thd(ki,kj,2,jl)/1.0e9
+              WRITE(numout,*) ' e_snow     : ', e_s(ki,kj,1,jl)            , ' old_e_snow : ', old_e_s(ki,kj,1,jl) 
+              WRITE(numout,*) ' d_e_s_trp  : ', d_e_s_trp(ki,kj,1,jl)      , ' d_e_s_thd  : ', d_e_s_thd(ki,kj,1,jl)
+              WRITE(numout,*) ' smv_i      : ', smv_i(ki,kj,jl)            , ' old_smv_i  : ', old_smv_i(ki,kj,jl)   
+              WRITE(numout,*) ' d_smv_i_trp: ', d_smv_i_trp(ki,kj,jl)      , ' d_smv_i_thd: ', d_smv_i_thd(ki,kj,jl) 
+              WRITE(numout,*) ' oa_i       : ', oa_i(ki,kj,jl)             , ' old_oa_i   : ', old_oa_i(ki,kj,jl)
+              WRITE(numout,*) ' d_oa_i_trp : ', d_oa_i_trp(ki,kj,jl)       , ' d_oa_i_thd : ', d_oa_i_thd(ki,kj,jl)
+              WRITE(numout,*) ' Path. case : ', patho_case(ki,kj,jl)
+        END DO !jl
+
+        WRITE(numout,*)
+        WRITE(numout,*) ' - Heat / FW fluxes '
+        WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+!       WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj)
+!       WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj)
+!       WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj)
+        WRITE(numout,*) ' fmmec      : ', fmmec(ki,kj)
+        WRITE(numout,*) ' fhmec      : ', fhmec(ki,kj)
+        WRITE(numout,*) ' fhbri      : ', fhbri(ki,kj)
+        WRITE(numout,*) ' fheat_rpo  : ', fheat_rpo(ki,kj)
+        WRITE(numout,*) 
+        WRITE(numout,*) ' sst        : ', sst_m(ki,kj)  
+        WRITE(numout,*) ' sss        : ', sss_m(ki,kj)  
+        WRITE(numout,*) 
+        WRITE(numout,*) ' - Stresses '
+        WRITE(numout,*) '   ~~~~~~~~ '
+        WRITE(numout,*) ' utau_ice   : ', utau_ice(ki,kj) 
+        WRITE(numout,*) ' vtau_ice   : ', vtau_ice(ki,kj)
+        WRITE(numout,*) ' utau       : ', utau(ki,kj) 
+        WRITE(numout,*) ' vtau       : ', vtau(ki,kj)
+        WRITE(numout,*) ' oc. vel. u : ', u_oce(ki,kj)
+        WRITE(numout,*) ' oc. vel. v : ', v_oce(ki,kj)
+     ENDIF
+
+     !---------------------
+     ! Salt / heat fluxes
+     !---------------------
+
+     IF ( kn .EQ. 3 ) THEN
+        WRITE(numout,*) ' lim_prt_state - Point : ',ki,kj
+        WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
+        WRITE(numout,*) ' - Salt / Heat Fluxes '
+        WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ '
+        WRITE(numout,*) ' lat - long ', gphit(ki,kj), glamt(ki,kj)
+        WRITE(numout,*) ' Time step ', numit
+        WRITE(numout,*)
+        WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+        WRITE(numout,*) ' qsr        : ', qsr(ki,kj)
+        WRITE(numout,*) ' qns        : ', qns(ki,kj)
+        WRITE(numout,*)
+        WRITE(numout,*) ' - Salt fluxes at bottom interface ***'
+        WRITE(numout,*) ' emps       : ', emps(ki,kj)
+        WRITE(numout,*) ' emp        : ', emp(ki,kj)
+        WRITE(numout,*) ' fsbri      : ', fsbri(ki,kj)
+        WRITE(numout,*) ' fseqv      : ', fseqv(ki,kj)
+        WRITE(numout,*) ' fsalt_res  : ', fsalt_res(ki,kj)
+        WRITE(numout,*) ' fsalt_rpo  : ', fsalt_rpo(ki,kj)
+        WRITE(numout,*) ' - Heat fluxes at bottom interface ***'
+        WRITE(numout,*) ' fheat_res  : ', fheat_res(ki,kj)
+        WRITE(numout,*)
+        WRITE(numout,*) ' - Momentum fluxes '
+        WRITE(numout,*) ' utau      : ', utau(ki,kj) 
+        WRITE(numout,*) ' vtau      : ', vtau(ki,kj)
+      ENDIF
+      WRITE(numout,*) ' '
+      !
+   END SUBROUTINE lim_prt_state
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option           Dummy module      NO LIM 3.0 sea-ice model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE sbc_ice_lim ( kt, kblk )     ! Dummy routine
+      WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk
+   END SUBROUTINE sbc_ice_lim
+#endif
+
+   !!======================================================================
+END MODULE sbcice_lim
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90	(revision 3437)
@@ -0,0 +1,239 @@
+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_core      ! Surface boundary condition: CORE bulk
+   USE sbcblk_clio      ! Surface boundary condition: CLIO bulk
+   USE sbccpl           ! Surface boundary condition: coupled interface
+   USE albedo
+
+   USE phycst           ! Define parameters for the routines
+   USE eosbn2           ! equation of state
+   USE 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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 , emps
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt      ! ocean time step
+      INTEGER, INTENT(in) ::   ksbc    ! type of sbc ( =3 CLIO bulk ; =4 CORE bulk ; =5 coupled )
+      !!
+      INTEGER  ::   ji, jj   ! dummy loop indices
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_os   ! albedo of the ice under overcast sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice_cs   ! albedo of ice under clear sky
+      REAL(wp), DIMENSION(:,:,:), POINTER :: zsist         ! surface ice temperature (K)
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
+
+      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
+      ENDIF
+
+      !                                        !----------------------!
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  !
+         !                                     !----------------------!
+         !  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  ) + ssu_m(ji-1,jj-1) ) * tmu(ji,jj)
+                  v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji  ,jj-1) + ssv_m(ji-1,jj-1) ) * tmu(ji,jj)
+               END DO
+            END DO
+            CALL lbc_lnk( u_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            CALL lbc_lnk( v_oce, 'I', -1. )   ! I-point (i.e. F-point with ice indices)
+            !
+         CASE( 'C' )                  !== C-grid ice dynamics :   U & V-points (same as ocean)
+            u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point
+            v_oce(:,:) = ssv_m(:,:)
+            !
+         END SELECT
+
+         ! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
+         tfu(:,:) = tfreez( sss_m ) +  rt0 
+
+         zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
+
+         ! ... ice albedo (clear sky and overcast sky)
+         CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
+                                 reshape( hsnif, (/jpi,jpj,1/) ), &
+                          zalb_ice_cs, zalb_ice_os )
+
+         ! ... 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( 3 )           ! CLIO bulk formulation
+            CALL blk_ice_clio( zsist, zalb_ice_cs, zalb_ice_os,                         &
+               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
+               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
+               &                      tprecip    , sprecip    ,                         &
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+
+         CASE( 4 )           ! CORE bulk formulation
+            CALL blk_ice_core( zsist, u_ice      , v_ice      , zalb_ice_cs,            &
+               &                      utau_ice   , vtau_ice   , qns_ice    , qsr_ice,   &
+               &                      qla_ice    , dqns_ice   , dqla_ice   ,            &
+               &                      tprecip    , sprecip    ,                         &
+               &                      fr1_i0     , fr2_i0     , cp_ice_msh , jpl  )
+         CASE( 5 )           ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
+            CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
+         END SELECT
+
+         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 
+         END IF
+#if defined key_coupled
+         !                                             ! Ice surface fluxes in coupled mode 
+         IF( ksbc == 5 )   THEN
+            a_i(:,:,1)=fr_i
+            CALL sbc_cpl_ice_flx( frld,                                              &
+            !                                optional arguments, used only in 'mixed oce-ice' case
+            &                                             palbi = zalb_ice_cs, psst = sst_m, pist = zsist )
+            sprecip(:,:) = - emp_ice(:,:)   ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
+         ENDIF
+#endif
+                           CALL lim_thd_2      ( kt )      ! Ice thermodynamics 
+                           CALL lim_sbc_flx_2  ( kt )      ! update surface ocean mass, heat & salt fluxes 
+
+         IF( ( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) .AND. .NOT. lk_mpp )   &
+            &              CALL lim_dia_2      ( kt )      ! Ice Diagnostics
+# if ! defined key_iomput
+                           CALL lim_wri_2      ( kt )      ! Ice outputs
+# endif
+         IF( lrst_ice  )   CALL lim_rst_write_2( kt )      ! Ice restart file
+         !
+      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
+      !
+      CALL wrk_dealloc( jpi,jpj,1, zalb_ice_os, zalb_ice_cs, zsist )
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90	(revision 3437)
@@ -0,0 +1,383 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sbc_init       : read namsbc namelist
+   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers
+   USE dom_oce          ! ocean space and time domain
+   USE phycst           ! physical constants
+   USE sbc_oce          ! Surface boundary condition: ocean fields
+   USE sbc_ice          ! Surface boundary condition: ice fields
+   USE sbcdcy           ! surface boundary condition: diurnal cycle
+   USE sbcssm           ! surface boundary condition: sea-surface mean variables
+   USE sbcapr           ! surface boundary condition: atmospheric pressure
+   USE sbcana           ! surface boundary condition: analytical formulation
+   USE sbcflx           ! surface boundary condition: flux formulation
+   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO
+   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE
+   USE sbcblk_mfs       ! surface boundary condition: bulk formulation : MFS
+   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 sbccpl           ! surface boundary condition: coupled florulation
+   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode?
+   USE sbcssr           ! surface boundary condition: sea surface restoring
+   USE sbcrnf           ! surface boundary condition: runoffs
+   USE sbcfwb           ! surface boundary condition: freshwater budget
+   USE closea           ! closed sea
+   USE bdy_par          ! for lk_bdy
+   USE bdyice_lim2      ! unstructured open boundary data  (bdy_ice_lim_2 routine)
+
+   USE prtctl           ! Print control                    (prt_ctl routine)
+   USE restart          ! ocean restart
+   USE iom              ! IOM library
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE timing           ! Timing
+   USE sbcwave          ! Wave module
+
+   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)
+      
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO-consortium (2011) 
+   !! $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
+      !!
+      !! ** Action  : - read namsbc parameters
+      !!              - nsbc: type of sbc
+      !!----------------------------------------------------------------------
+      INTEGER ::   icpt   ! local integer
+      !!
+      NAMELIST/namsbc/ nn_fsbc   , ln_ana , ln_flx  , ln_blk_clio, ln_blk_core, ln_cpl,   &
+         &             ln_blk_mfs, ln_apr_dyn, nn_ice , ln_dm2dc, ln_rnf, ln_ssr     , nn_fwb, ln_cdgw
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_init : surface boundary condition setting'
+         WRITE(numout,*) '~~~~~~~~ '
+      ENDIF
+
+      REWIND( numnam )           ! Read Namelist namsbc
+      READ  ( numnam, namsbc )
+
+      !                          ! overwrite namelist parameter using CPP key information
+      IF( Agrif_Root() ) THEN                ! AGRIF zoom
+        IF( lk_lim2 )   nn_ice      = 2
+        IF( lk_lim3 )   nn_ice      = 3
+        IF( lk_cice )   nn_ice      = 4
+      ENDIF
+      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration
+          ln_ana      = .TRUE.   
+          nn_ice      =   0
+      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 sbc : '
+         WRITE(numout,*) '              analytical formulation                     ln_ana      = ', ln_ana
+         WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx
+         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio
+         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
+         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs
+         WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
+         WRITE(numout,*) '           Misc. options of sbc : '
+         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
+         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
+         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
+         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
+         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,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea
+      ENDIF
+
+      !                              ! allocate sbc arrays
+      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
+
+      !                          ! Checks:
+      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths 
+         ln_rnf_mouth  = .false.                      
+         IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_rnf arrays' )
+         nkrnf         = 0
+         rnf     (:,:) = 0.e0
+         rnfmsk  (:,:) = 0.e0
+         rnfmsk_z(:)   = 0.e0
+      ENDIF
+      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
+
+      !                                            ! restartability   
+      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
+          MOD( nstock             , nn_fsbc) /= 0 ) THEN 
+         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
+            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
+         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
+      ENDIF
+      !
+      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
+         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
+      !
+      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   &
+         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
+      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. lk_cpl ) )   &
+         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or lk_cpl' )
+      IF( nn_ice == 4 .AND. ( .NOT. ( cp_cfg == 'orca' ) .OR. lk_agrif ) )   &
+         &   CALL ctl_stop( 'CICE sea-ice model currently only available in a global ORCA configuration without AGRIF' )
+      
+      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
+
+      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) )   &
+         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
+      
+      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
+         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
+
+       !drag coefficient read from wave model definable only with mfs bulk formulae and core 
+       IF(ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )              &
+          &   CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
+      
+      !                          ! Choice of the Surface Boudary Condition (set nsbc)
+      icpt = 0
+      IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
+      IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation
+      IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation
+      IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation
+      IF( ln_blk_mfs      ) THEN   ;   nsbc =  6   ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk       formulation
+      IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation
+      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation
+      IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations
+      !
+      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option '
+         WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)'
+         WRITE(numout,*) '                     We stop'
+         nstop = nstop + 1
+      ENDIF
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
+         IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation'
+         IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation'
+         IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation'
+         IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation'
+         IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation'
+         IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation'
+         IF( nsbc ==  6 )   WRITE(numout,*) '              MFS Bulk formulation'
+      ENDIF
+
+      IF( nn_ice == 4 )   CALL cice_sbc_init (nsbc)
+      !
+   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, emps_b, qrp_b, erp_b
+      !!                utau  , vtau  , qns  , qsr  , emp  , emps  , qrp  , erp
+      !!              - updte the ice fraction : fr_i
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time step
+      !!---------------------------------------------------------------------
+      !
+      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)
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! qsr_b (:,:) = qsr (:,:)
+         emp_b (:,:) = emp (:,:)
+         emps_b(:,:) = emps(:,:)
+      ENDIF
+      !                                            ! ---------------------------------------- !
+      !                                            !        forcing field computation         !
+      !                                            ! ---------------------------------------- !
+
+      CALL iom_setkt( kt + nn_fsbc - 1 )                 ! in sbc, iom_put is called every nn_fsbc time step
+      !
+      IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
+                                                         ! (caution called before sbc_ssm)
+      !
+      CALL sbc_ssm( kt )                                 ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
+      !                                                  ! averaged over nf_sbc time-step
+
+      IF (ln_cdgw) CALL sbc_wave( kt )
+                                                   !==  sbc formulation  ==!
+                                                            
+      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
+      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, emps)
+      CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
+      CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
+      CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
+      CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
+      CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
+      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation
+      CASE(  6 )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
+      CASE( -1 )                                
+                       CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
+                       CALL sbc_gyre    ( kt )                    !
+                       CALL sbc_flx     ( kt )                    !
+                       CALL sbc_blk_clio( kt )                    !
+                       CALL sbc_blk_core( kt )                    !
+                       CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
+      END SELECT
+
+      !                                            !==  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
+              IF( lk_bdy )   CALL bdy_ice_lim_2( kt )                ! BDY boundary condition
+      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_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
+
+      IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain 
+      !                                                           ! (update freshwater fluxes)
+!RBbug do not understand why see ticket 667
+      CALL lbc_lnk( emp, 'T', 1. )
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point)
+            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b )   ! before j-stress  (V-point)
+            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point)
+            ! The 3D heat content due to qsr forcing is treated in traqsr
+            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  )   ! before     solar heat flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emp_b' , emp_b  )   ! before     freshwater flux (T-point)
+            CALL iom_get( numror, jpdom_autoglo, 'emps_b', emps_b )   ! before C/D freshwater flux (T-point)
+         ELSE                                                   !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
+            utau_b(:,:) = utau(:,:) 
+            vtau_b(:,:) = vtau(:,:)
+            qns_b (:,:) = qns (:,:)
+            ! qsr_b (:,:) = qsr (:,:)
+            emp_b (:,:) = emp (:,:)
+            emps_b(:,:) = emps(:,:)
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
+         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
+         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  )
+         ! The 3D heat content due to qsr forcing is treated in traqsr
+         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
+         CALL iom_rstput( kt, nitrst, numrow, 'emps_b' , emps )
+      ENDIF
+
+      !                                                ! ---------------------------------------- !
+      !                                                !        Outputs and control print         !
+      !                                                ! ---------------------------------------- !
+      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
+         CALL iom_put( "empmr" , emp  - rnf )                   ! upward water flux
+         CALL iom_put( "empsmr", emps - rnf )                   ! c/d 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 )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction 
+      ENDIF
+      !
+      CALL iom_setkt( kt )           ! iom_put outside of sbc is called at every time step
+      !
+      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at 
+      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice)
+      CALL iom_put( "taum", taum )   ! wind stress module 
+      CALL iom_put( "wspd", wndm )   ! wind speed  module 
+      !
+      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)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )
+         CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk )
+         CALL prt_ctl(tab3d_1=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  ***
+      !!---------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      ! Finalize CICE (if used)
+      !-----------------------------------------------------------------
+
+      IF( nn_ice == 4 )   CALL cice_sbc_final
+      !
+   END SUBROUTINE sbc_final
+
+   !!======================================================================
+END MODULE sbcmod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90	(revision 3437)
@@ -0,0 +1,471 @@
+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 closea          ! closed seas
+   USE fldread         ! read input field at current time step
+   USE restart         ! restart
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE lib_mpp         ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_rnf       ! routine call in sbcmod module
+   PUBLIC   sbc_rnf_div   ! routine called in sshwzv module
+   PUBLIC   sbc_rnf_alloc ! routine call in sbcmod module
+
+   !                                                     !!* namsbc_rnf namelist *
+   CHARACTER(len=100), PUBLIC ::   cn_dir       = './'    !: Root directory for location of ssr files
+   LOGICAL           , PUBLIC ::   ln_rnf_depth = .false. !: depth       river runoffs attribute specified in a file
+   LOGICAL           , PUBLIC ::   ln_rnf_tem   = .false. !: temperature river runoffs attribute specified in a file 
+   LOGICAL           , PUBLIC ::   ln_rnf_sal   = .false. !: salinity    river runoffs attribute specified in a file 
+   LOGICAL           , PUBLIC ::   ln_rnf_emp   = .false. !: runoffs into a file to be read or already into precipitation
+   TYPE(FLD_N)       , PUBLIC ::   sn_rnf                 !: information about the runoff file to be read
+   TYPE(FLD_N)       , PUBLIC ::   sn_cnf                 !: information about the runoff mouth file to be read
+   TYPE(FLD_N)                ::   sn_s_rnf               !: information about the salinities of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_t_rnf               !: information about the temperatures of runoff file to be read  
+   TYPE(FLD_N)                ::   sn_dep_rnf             !: information about the depth which river inflow affects
+   LOGICAL           , PUBLIC ::   ln_rnf_mouth = .false. !: specific treatment in mouths vicinity
+   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0._wp   !: runoffs, depth over which enhanced vertical mixing is used
+   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0._wp   !: runoffs, value of the additional vertical mixing coef. [m2/s]
+   REAL(wp)          , PUBLIC ::   rn_rfact     = 1._wp   !: multiplicative factor for runoff
+
+   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths
+   REAL(wp), PUBLIC, 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]
+   
+   REAL(wp) ::   r1_rau0   ! = 1 / rau0 
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_rnf       ! structure: river runoff (file information, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_s_rnf     ! structure: river runoff salinity (file information, fields read)  
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_t_rnf     ! structure: river runoff temperature (file information, fields read)  
+ 
+   !! * Substitutions  
+#  include "domzgr_substitute.h90"  
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.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
+      !!----------------------------------------------------------------------
+      !                                   
+      IF( kt == nit000 )   CALL sbc_rnf_init                           ! Read namelist and allocate structures
+
+      !                                            ! ---------------------------------------- !
+      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
+         !                                         ! ---------------------------------------- !
+         rnf_b    (:,:  ) = rnf    (:,:  )               ! Swap the ocean forcing fields except at nit000
+         rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)               ! where before fields are set at the end of the routine
+         !
+      ENDIF
+
+      !                                                   !-------------------!
+      IF( .NOT. ln_rnf_emp ) THEN                         !   Update runoff   !
+         !                                                !-------------------!
+         !
+                             CALL fld_read ( kt, nn_fsbc, sf_rnf   )    ! Read Runoffs data and provide it at kt 
+         IF( ln_rnf_tem  )   CALL fld_read ( kt, nn_fsbc, sf_t_rnf )    ! idem for runoffs temperature if required
+         IF( ln_rnf_sal  )   CALL fld_read ( kt, nn_fsbc, sf_s_rnf )    ! idem for runoffs salinity    if required
+         !
+         ! Runoff reduction only associated to the ORCA2_LIM configuration
+         ! when reading the NetCDF file runoff_1m_nomask.nc
+         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN
+            WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )
+               sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)
+            END WHERE
+         ENDIF
+         !
+         IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN
+            rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) )  
+            !
+            r1_rau0 = 1._wp / rau0
+            !                                                     ! set temperature & salinity content of runoffs
+            IF( ln_rnf_tem ) THEN                                       ! use runoffs temperature data
+               rnf_tsc(:,:,jp_tem) = ( sf_t_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+               WHERE( sf_t_rnf(1)%fnow(:,:,1) == -999 )                 ! if missing data value use SST as runoffs temperature  
+                   rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ELSE                                                        ! use SST as runoffs temperature
+               rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+            ENDIF  
+            !                                                           ! use runoffs salinity data 
+            IF( ln_rnf_sal )   rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0
+            !                                                           ! else use S=0 for runoffs (done one for all in the init)
+            !
+            IF( ln_rnf_tem .OR. ln_rnf_sal ) THEN                 ! runoffs as outflow: use ocean SST and SSS
+               WHERE( rnf(:,:) < 0._wp )                                 ! example baltic model when flow is out of domain 
+                  rnf_tsc(:,:,jp_tem) = sst_m(:,:) * rnf(:,:) * r1_rau0
+                  rnf_tsc(:,:,jp_sal) = sss_m(:,:) * rnf(:,:) * r1_rau0
+               END WHERE
+            ENDIF
+            !
+            CALL iom_put( "runoffs", rnf )         ! output runoffs arrays
+         ENDIF
+         !
+      ENDIF
+      !
+      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
+         !                                             ! ---------------------------------------- !
+         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
+            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
+            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file'
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff
+            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff
+         ELSE                                                   !* no restart: set from nit000 values
+            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000'
+             rnf_b    (:,:  ) = rnf    (:,:  )  
+             rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)   
+         ENDIF
+      ENDIF
+      !                                                ! ---------------------------------------- !
+      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
+         !                                             ! ---------------------------------------- !
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbcrnf : runoff forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf
+
+
+   SUBROUTINE sbc_rnf_div( phdivn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf  ***
+      !!       
+      !! ** Purpose :   update the horizontal divergence with the runoff inflow
+      !!
+      !! ** Method  :   
+      !!                CAUTION : rnf is positive (inflow) decreasing the 
+      !!                          divergence and expressed in m/s
+      !!
+      !! ** Action  :   phdivn   decreased by the runoff inflow
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   phdivn   ! horizontal divergence
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   r1_rau0   ! local scalar
+      REAL(wp) ::   zfact     ! local scalar
+      !!----------------------------------------------------------------------
+      !
+      zfact = 0.5_wp
+      !
+      r1_rau0 = 1._wp / rau0
+      IF( ln_rnf_depth ) THEN      !==   runoff distributed over several levels   ==!
+         IF( lk_vvl ) THEN             ! variable volume case 
+            DO jj = 1, jpj                   ! update the depth over which runoffs are distributed
+               DO ji = 1, jpi
+                  h_rnf(ji,jj) = 0._wp 
+                  DO jk = 1, nk_rnf(ji,jj)                           ! recalculates h_rnf to be the depth in metres
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)   ! to the bottom of the relevant grid box 
+                  END DO 
+                  !                          ! apply the runoff input flow
+                  DO jk = 1, nk_rnf(ji,jj)
+                     phdivn(ji,jj,jk) = phdivn(ji,jj,jk) - ( rnf(ji,jj) + rnf_b(ji,jj) ) * zfact * r1_rau0 / h_rnf(ji,jj)
+                  END DO
+               END DO
+            END DO
+         ELSE                          ! constant volume case : just apply the runoff input flow
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  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   ==!
+         IF( lk_vvl ) THEN              ! variable volume case
+            h_rnf(:,:) = fse3t(:,:,1)   ! recalculate h_rnf to be depth of top box
+         ENDIF
+         phdivn(:,:,1) = phdivn(:,:,1) - ( rnf(:,:) + rnf_b(:,:) ) * zfact * r1_rau0 / fse3t(:,:,1)
+      ENDIF
+      !
+   END SUBROUTINE sbc_rnf_div
+
+
+   SUBROUTINE sbc_rnf_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sbc_rnf_init  ***
+      !!
+      !! ** 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    ! dummy loop indices
+      INTEGER           ::   ierror, inum  ! temporary integer
+      !! 
+      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, ln_rnf_depth, ln_rnf_tem, ln_rnf_sal,   &
+         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   &  
+         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact  
+      !!----------------------------------------------------------------------
+
+      !                                   ! ============
+      !                                   !   Namelist
+      !                                   ! ============
+      ! (NB: frequency positive => hours, negative => months)
+      !            !   file    ! frequency !  variable  ! time intep !  clim  ! 'yearly' or ! weights  ! rotation   !
+      !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F) !  'monthly'  ! filename ! pairs      !
+      sn_rnf = FLD_N( 'runoffs',    -1     , 'sorunoff' ,  .TRUE.    , .true. ,   'yearly'  , ''       , ''         )
+      sn_cnf = FLD_N( 'runoffs',     0     , 'sorunoff' ,  .FALSE.   , .true. ,   'yearly'  , ''       , ''         )
+
+      sn_s_rnf = FLD_N( 'runoffs',  24.  , 'rosaline' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_t_rnf = FLD_N( 'runoffs',  24.  , 'rotemper' ,  .TRUE.    , .true. ,   'yearly'  , ''    , ''  )  
+      sn_dep_rnf = FLD_N( 'runoffs',   0.  , 'rodepth'  ,  .FALSE.   , .true. ,   'yearly'  , ''    , ''  )  
+      !
+      REWIND ( numnam )                         ! Read Namelist namsbc_rnf
+      READ   ( numnam, namsbc_rnf )
+
+      !                                         ! Control print
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'sbc_rnf : runoff '
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namsbc_rnf'
+         WRITE(numout,*) '      runoff in a file to be read                ln_rnf_emp   = ', ln_rnf_emp
+         WRITE(numout,*) '      specific river mouths treatment            ln_rnf_mouth = ', ln_rnf_mouth
+         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf
+         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
+      !                                   ! ==================
+      !                                         !==  allocate runoff arrays
+      IF( sbc_rnf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_rnf_alloc : unable to allocate arrays' )
+      !
+      IF( ln_rnf_emp ) THEN                     !==  runoffs directly provided in the precipitations  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs directly provided in the precipitations'
+         IF( ln_rnf_depth .OR. ln_rnf_tem .OR. ln_rnf_sal ) THEN
+           CALL ctl_warn( 'runoffs already included in precipitations, so runoff (T,S, depth) attributes will not be used' ) 
+           ln_rnf_depth = .FALSE.   ;   ln_rnf_tem = .FALSE.   ;   ln_rnf_sal = .FALSE.
+         ENDIF
+         !
+      ELSE                                      !==  runoffs read in a file : set sf_rnf structure  ==!
+         !
+         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow)
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          runoffs inflow read in a file'
+         IF( ierror > 0 ) THEN
+            CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN
+         ENDIF
+         ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1)   )
+         IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) )
+         !                                          ! fill sf_rnf with the namelist (sn_rnf) and control print
+         CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf' )
+         !
+         IF( ln_rnf_tem ) THEN                      ! Create (if required) sf_t_rnf structure
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs temperatures read in a file'
+            ALLOCATE( sf_t_rnf(1), STAT=ierror  )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_t_rnf structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_t_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_t_rnf%ln_tint ) ALLOCATE( sf_t_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_t_rnf, (/ sn_t_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff temperature data', 'namsbc_rnf' )  
+         ENDIF
+         !
+         IF( ln_rnf_sal  ) THEN                     ! Create (if required) sf_s_rnf and sf_t_rnf structures
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs salinities read in a file'
+            ALLOCATE( sf_s_rnf(1), STAT=ierror  )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_s_rnf structure' )   ;   RETURN
+            ENDIF
+            ALLOCATE( sf_s_rnf(1)%fnow(jpi,jpj,1)   )
+            IF( sn_s_rnf%ln_tint ) ALLOCATE( sf_s_rnf(1)%fdta(jpi,jpj,1,2) )
+            CALL fld_fill (sf_s_rnf, (/ sn_s_rnf /), cn_dir, 'sbc_rnf_init', 'read runoff salinity data', 'namsbc_rnf' )  
+         ENDIF
+         !
+         IF( ln_rnf_depth ) THEN                    ! depth of runoffs set from a file 
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '          runoffs depth read in a file'
+            rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname )  
+            CALL iom_open ( rn_dep_file, inum )                           ! open file  
+            CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array  
+            CALL iom_close( inum )                                        ! close file  
+            !
+            nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied
+            DO jj = 1, jpj  
+               DO ji = 1, jpi  
+                  IF( h_rnf(ji,jj) > 0._wp ) THEN  
+                     jk = 2  
+                     DO WHILE ( jk /= mbkt(ji,jj) .AND. fsdept(ji,jj,jk) < h_rnf(ji,jj) ) ;  jk = jk + 1 ;  END DO  
+                     nk_rnf(ji,jj) = jk  
+                  ELSEIF( h_rnf(ji,jj) == -1   ) THEN   ;  nk_rnf(ji,jj) = 1  
+                  ELSEIF( h_rnf(ji,jj) == -999 ) THEN   ;  nk_rnf(ji,jj) = mbkt(ji,jj)
+                  ELSEIF( h_rnf(ji,jj) /=  0   ) THEN  
+                     CALL ctl_stop( 'runoff depth not positive, and not -999 or -1, rnf value in file fort.999'  )  
+                     WRITE(999,*) 'ji, jj, rnf(ji,jj) :', ji, jj, rnf(ji,jj)  
+                  ENDIF  
+               END DO  
+            END DO  
+            DO jj = 1, jpj                                ! set the associated depth 
+               DO ji = 1, jpi 
+                  h_rnf(ji,jj) = 0._wp
+                  DO jk = 1, nk_rnf(ji,jj)                        
+                     h_rnf(ji,jj) = h_rnf(ji,jj) + fse3t(ji,jj,jk)  
+                  END DO
+               END DO
+            END DO
+         ELSE                                       ! runoffs applied at the surface 
+            nk_rnf(:,:) = 1  
+            h_rnf (:,:) = fse3t(:,:,1)
+         ENDIF  
+         ! 
+      ENDIF
+      !
+      rnf(:,:) =  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_0(nkrnf+1) < rn_hrnf )   ;   nkrnf = nkrnf + 1   ;   END DO
+            IF( ln_sco )   &
+               CALL ctl_warn( 'sbc_rnf: number of levels over which Kz is increased is computed for zco...' )
+         ENDIF
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90	(revision 3437)
@@ -0,0 +1,168 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 sbc_oce         ! surface boundary condition: ocean fields
+   USE sbcapr          ! surface boundary condition: atmospheric pressure
+   USE prtctl          ! Print control                    (prt_ctl routine)
+   USE restart         ! ocean restart
+   USE iom
+   USE in_out_manager  ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ssm    ! routine called by step.F90
+   
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   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 [Celcius] and salinity [psu] over
+      !!      the periode (kt - nn_fsbc) to kt
+      !!         Note that the inverse barometer ssh (i.e. ssh associated with Patm)
+      !!      is add to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time step
+      !
+      REAL(wp) ::   zcoef, zf_sbc       ! local scalar
+      !!---------------------------------------------------------------------
+      !                                                   ! ---------------------------------------- !
+      IF( nn_fsbc == 1 ) THEN                             !      Instantaneous surface fields        !
+         !                                                ! ---------------------------------------- !
+         IF( kt == nit000 ) THEN
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields, nn_fsbc=1 : instantaneous values'
+            IF(lwp) WRITE(numout,*) '~~~~~~~ '
+         ENDIF
+         !
+         ssu_m(:,:) = ub(:,:,1)
+         ssv_m(:,:) = vb(:,:,1)
+         sst_m(:,:) = tsn(:,:,1,jp_tem)
+         sss_m(:,:) = tsn(:,:,1,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
+
+         !
+      ELSE
+         !                                                ! ---------------------------------------- !
+         IF( kt == nit000) THEN                           !       Initialisation: 1st time-step      !
+            !                                             ! ---------------------------------------- !
+            IF(lwp) WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) 'sbc_ssm : sea surface mean fields'
+            !
+            IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 
+               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    (T-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)
+               !
+               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(:,:)
+               ELSE
+                  IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields read in the ocean restart file'
+               ENDIF
+            ELSE
+               IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values'
+               zcoef = REAL( nn_fsbc - 1, wp )
+               ssu_m(:,:) = zcoef * ub(:,:,1)
+               ssv_m(:,:) = zcoef * vb(:,:,1)
+               sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem)
+               sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal)
+               !                          ! removed inverse barometer ssh when Patm forcing is used 
+               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )
+               ELSE                    ;   ssh_m(:,:) = zcoef *   sshn(:,:)
+               ENDIF
+
+            ENDIF
+            !                                             ! ---------------------------------------- !
+         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !
+            !                                             ! ---------------------------------------- !
+            ssu_m(:,:) = 0.e0      ! reset to zero ocean mean sbc fields
+            ssv_m(:,:) = 0.e0
+            sst_m(:,:) = 0.e0
+            sss_m(:,:) = 0.e0
+            ssh_m(:,:) = 0.e0
+         ENDIF
+         !                                                ! ---------------------------------------- !
+         !                                                !        Cumulate at each time step        !
+         !                                                ! ---------------------------------------- !
+         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1)
+         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1)
+         sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem)
+         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,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
+
+         !                                                ! ---------------------------------------- !
+         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             [Celcius]
+            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]
+            !
+         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  )
+            !
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE sbc_ssm
+
+   !!======================================================================
+END MODULE sbcssm
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90	(revision 3437)
@@ -0,0 +1,211 @@
+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
+   !!----------------------------------------------------------------------
+   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 iom             ! I/O manager
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distribued memory computing library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_ssr    ! 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     =   0       ! SST/SSS restoring indicator
+   INTEGER, PUBLIC ::   nn_sssr     =   0       ! SST/SSS restoring indicator
+   REAL(wp)        ::   rn_dqdt     = -40.e0    ! restoring factor on SST and SSS
+   REAL(wp)        ::   rn_deds     = -27.70    ! restoring factor on SST and SSS
+   LOGICAL         ::   ln_sssr_bnd = .false.   ! flag to bound erp term 
+   REAL(wp)        ::   rn_sssr_bnd =   0.e0    ! 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)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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 emps       (nn_sssr = 1)
+      !!                   add a damping term on emp & emps (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
+      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sbc_ssr')
+      !
+      !                                               ! -------------------- !
+      IF( kt == nit000 ) THEN                         ! First call kt=nit000 !
+         !                                            ! -------------------- !
+         !                            !* set file information
+         cn_dir  = './'            ! directory in which the model is executed
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
+         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
+         sn_sst = FLD_N( 'sst'    ,    24     ,  'sst'     ,  .false.   , .false. ,   'yearly'  , ''       , ''         )
+         sn_sss = FLD_N( 'sss'    ,    -1     ,  'sss'     ,  .true.    , .false. ,   'yearly'  , ''       , ''         )
+
+         REWIND ( numnam )            !* read in namlist namflx
+         READ( numnam, 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' )
+            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' )
+            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.e0 
+         IF( nn_sssr /= 1 .OR. nn_sssr /= 2 )   erp(:,:) = 0.e0 
+      ENDIF
+
+      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
+!CDIR COLLAPSE
+               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, emps only)
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+!CDIR COLLAPSE
+               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) )   &
+                        &        / ( sss_m(ji,jj) + 1.e-20   )
+                     emps(ji,jj) = emps(ji,jj) + zerp
+                     erp( ji,jj) = zerp
+                  END DO
+               END DO
+               CALL iom_put( "erp", erp )                             ! freshwater flux damping
+               !
+            ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps)
+               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s]
+               zerp_bnd = rn_sssr_bnd / rday                          !       -              -    
+!CDIR COLLAPSE
+               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) )   &
+                        &        / ( 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
+                     emps(ji,jj) = emps(ji,jj) + zerp
+                     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
+      
+   !!======================================================================
+END MODULE sbcssr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90	(revision 3437)
@@ -0,0 +1,164 @@
+MODULE sbctide
+  !!=================================================================================
+  !!                       ***  MODULE  sbctide  ***
+  !! Initialization of tidal forcing
+  !! History :  9.0  !  07  (O. Le Galloudec)  Original code
+  !!=================================================================================
+  !! * Modules used
+  USE oce             ! ocean dynamics and tracers variables
+  USE dom_oce         ! ocean space and time domain
+  USE in_out_manager  ! I/O units
+  USE ioipsl          ! NetCDF IPSL library
+  USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+  USE phycst
+  USE daymod
+  USE dynspg_oce
+  USE tide_mod
+  USE iom
+
+  IMPLICIT NONE
+  PUBLIC
+
+  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro
+  LOGICAL, PUBLIC :: ln_tide_pot = .false.
+#if defined key_tide
+
+  LOGICAL, PUBLIC, PARAMETER ::   lk_tide  = .TRUE.
+
+  REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide 
+
+  REAL(wp), ALLOCATABLE, DIMENSION(:) ::  &
+       v0tide,      &
+       utide,       &
+       ftide
+
+  REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: amp_pot,phi_pot
+
+  INTEGER, PUBLIC :: nb_harmo
+  INTEGER, PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide
+  INTEGER, PUBLIC :: nn_tide, kt_tide
+
+  !!---------------------------------------------------------------------------------
+  !!   OPA 9.0 , LODYC-IPSL  (2003)
+  !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+  SUBROUTINE sbc_tide ( kt )
+    !!----------------------------------------------------------------------
+    !!                 ***  ROUTINE sbc_tide  ***
+    !!----------------------------------------------------------------------      
+    !! * Arguments
+    INTEGER, INTENT( in ) ::   kt     ! ocean time-step
+    !! * Local declarations
+    INTEGER  :: jk,ji
+    CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: clname
+    !!----------------------------------------------------------------------
+
+    NAMELIST/nam_tide/ln_tide_pot,nb_harmo,clname,nn_tide
+
+    IF ( kt == nit000 ) THEN
+
+       IF( .NOT. lk_dynspg_ts  )  CALL ctl_stop( 'STOP', 'sbc_tide : tidal potential use only with time splitting' )
+
+    ! Read Namelist nam_tide
+
+    nn_tide=INT(rday/rdt)
+
+    CALL tide_init_Wave
+
+    REWIND ( numnam )
+    READ   ( numnam, nam_tide )
+
+    IF(lwp) THEN
+       WRITE(numout,*)
+       WRITE(numout,*) 'sbc_tide : Initialization of the tidal components'
+       WRITE(numout,*) '~~~~~~~ '
+    ENDIF
+
+    IF(lwp) THEN
+       WRITE(numout,*) '        Namelist nam_tide'
+       WRITE(numout,*) '        Apply astronomical potential : ln_tide_pot =', ln_tide_pot
+       WRITE(numout,*) '        nb_harmo    = ', nb_harmo
+       CALL flush(numout)
+    ENDIF
+
+    ALLOCATE(ntide     (nb_harmo))
+    DO jk=1,nb_harmo
+       DO ji=1,jpmax_harmo
+          IF (TRIM(clname(jk)) .eq. Wave(ji)%cname_tide) THEN
+             ntide(jk) = ji
+             EXIT
+          END IF
+       END DO
+    END DO
+    ALLOCATE(omega_tide(nb_harmo))
+    ALLOCATE(v0tide    (nb_harmo))
+    ALLOCATE(utide     (nb_harmo))
+    ALLOCATE(ftide     (nb_harmo))
+    ALLOCATE(amp_pot(jpi,jpj,nb_harmo))
+    ALLOCATE(phi_pot(jpi,jpj,nb_harmo))
+    ALLOCATE(pot_astro(jpi,jpj))
+    ENDIF
+
+    IF ( MOD( kt - 1, nn_tide ) == 0 ) THEN
+      kt_tide = kt
+      CALL tide_harmo(omega_tide, v0tide, utide, ftide, ntide, nb_harmo)
+    ENDIF
+
+    amp_pot(:,:,:) = 0.e0
+    phi_pot(:,:,:) = 0.e0
+    pot_astro(:,:) = 0.e0
+
+    IF (ln_tide_pot          ) CALL tide_init_potential
+
+  END SUBROUTINE sbc_tide
+
+  SUBROUTINE tide_init_potential
+    !!----------------------------------------------------------------------
+    !!                 ***  ROUTINE tide_init_potential  ***
+    !!----------------------------------------------------------------------
+    !! * Local declarations
+    INTEGER  :: ji,jj,jk
+    REAL(wp) :: zcons,ztmp1,ztmp2,zlat,zlon
+
+
+    DO jk=1,nb_harmo
+       zcons=0.7*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
+             ! le potentiel est composé des effets des astres:
+             IF (Wave(ntide(jk))%nutide .EQ.1) THEN
+                ztmp1= ztmp1 + zcons*(SIN(2.*zlat))*COS(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
+                ztmp2= ztmp2 - zcons*(SIN(2.*zlat))*SIN(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
+             ENDIF
+             IF (Wave(ntide(jk))%nutide.EQ.2) THEN
+                ztmp1= ztmp1 + zcons*(COS(zlat)**2)*COS(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
+                ztmp2= ztmp2 - zcons*(COS(zlat)**2)*SIN(v0tide(jk)+utide(jk)+Wave(ntide(jk))%nutide*zlon)
+             ENDIF
+             amp_pot(ji,jj,jk)=SQRT(ztmp1**2+ztmp2**2)
+             phi_pot(ji,jj,jk)=ATAN2(-ztmp2/MAX(1.E-10,SQRT(ztmp1**2+ztmp2**2)),ztmp1/MAX(1.E-10,SQRT(ztmp1**2+ztmp2**2)))
+          enddo
+       enddo
+    END DO
+
+  END SUBROUTINE tide_init_potential
+
+#else
+  !!----------------------------------------------------------------------
+  !!   Default case :   Empty module
+  !!----------------------------------------------------------------------
+  LOGICAL, PUBLIC, PARAMETER ::   lk_tide = .FALSE.
+CONTAINS
+  SUBROUTINE sbc_tide( kt )      ! Empty routine
+    INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+    WRITE(*,*) 'sbc_tide: You should not have seen this print! error?', kt
+  END SUBROUTINE sbc_tide
+#endif
+  !!======================================================================
+
+END MODULE sbctide
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90	(revision 3437)
@@ -0,0 +1,88 @@
+MODULE sbcwave
+   !!======================================================================
+   !!                       ***  MODULE  sbcwave  ***
+   !! Wave module 
+   !!======================================================================
+   !! History :  3.3.1  !   2011-09  (Adani M)  Original code
+   !!----------------------------------------------------------------------
+   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 sbc_oce	       ! Surface boundary condition: ocean fields
+
+   
+   !!----------------------------------------------------------------------
+   !!   sbc_wave       : read drag coefficient from wave model in netcdf files 
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sbc_wave    ! routine called in sbc_blk_core or sbc_blk_mfs
+   
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:)  :: sf_wave	  ! structure of input fields (file informations, fields read)
+   REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:)       :: cdn_wave 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
+   !! $Id: $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sbc_wave( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE sbc_apr  ***
+      !!
+      !! ** Purpose :   read drag coefficient from wave model  in netcdf files.
+      !!
+      !! ** Method  : - Read namelist namsbc_wave
+      !!              - Read Cd_n10 fields in netcdf files 
+      !! ** action  :   
+      !!               
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in  ) ::  kt   ! ocean time step
+      INTEGER                ::  ierror   ! return error code
+      CHARACTER(len=100)     ::  cn_dir_cdg                       ! Root directory for location of drag coefficient files
+      TYPE(FLD_N)            ::  sn_cdg                          ! informations about the fields to be read
+      !!---------------------------------------------------------------------
+      NAMELIST/namsbc_wave/  sn_cdg, cn_dir_cdg
+      !!---------------------------------------------------------------------
+
+      !!----------------------------------------------------------------------
+      !
+      !
+      !                                         ! -------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nit000 !
+         !                                      ! -------------------- !
+         !                                            !* set file information (default values)
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !              !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !              !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_cdg = FLD_N('cdg_wave'  ,    1     ,'drag_coeff',  .true.    , .false. ,   'daily'   , ''       , ''       )
+         cn_dir_cdg = './'          ! directory in which the Patm data are 
+         
+
+         REWIND( numnam )                             !* read in namlist namsbc_wave
+         READ  ( numnam, namsbc_wave ) 
+         !
+
+         ALLOCATE( sf_wave(1), STAT=ierror )           !* allocate and fill sf_wave with sn_cdg
+         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' )
+         !
+         CALL fld_fill( sf_wave, (/ sn_cdg /), cn_dir_cdg, 'sbc_wave', 'Wave module ', 'namsbc_wave' )
+                                ALLOCATE( sf_wave(1)%fnow(jpi,jpj,1)   )
+         IF( sn_cdg%ln_tint )   ALLOCATE( sf_wave(1)%fdta(jpi,jpj,1,2) )
+         ALLOCATE( cdn_wave(jpi,jpj) )
+         cdn_wave(:,:) = 0.0
+      ENDIF
+         !
+         !
+      CALL fld_read( kt, nn_fsbc, sf_wave )      !* read drag coefficient from external forcing
+      cdn_wave(:,:) = sf_wave(1)%fnow(:,:,1)
+
+   END SUBROUTINE sbc_wave
+      
+   !!======================================================================
+END MODULE sbcwave
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide.h90	(revision 3437)
@@ -0,0 +1,28 @@
+!! History :  9.0  !  07  (O. Le Galloudec)  Original code
+
+! Wave(1)= tide(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90	(revision 3437)
@@ -0,0 +1,493 @@
+MODULE tide_mod
+  !!=================================================================================
+  !!                       ***  MODULE  tide_mod  ***
+  !! Compute nodal modulations corrections and pulsations
+  !!=================================================================================
+  !!---------------------------------------------------------------------------------
+  !!   OPA 9.0 , LODYC-IPSL  (2003)
+  !!---------------------------------------------------------------------------------
+  USE dom_oce         ! ocean space and time domain
+  USE phycst
+  USE daymod
+
+  IMPLICIT NONE
+  PRIVATE
+
+  REAL(wp) :: sh_T, sh_s, sh_h, sh_p, sh_p1, &
+       sh_xi, sh_nu, sh_nuprim, sh_nusec, sh_R, &
+       sh_I, sh_x1ra, sh_N
+
+  INTEGER,PUBLIC, PARAMETER ::   &
+       jpmax_harmo = 19             ! maximum number of harmonic
+
+  TYPE 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
+
+  !! * Accessibility
+  PUBLIC tide_harmo
+  PUBLIC nodal_factort
+  PUBLIC tide_init_Wave
+
+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
+    !!
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    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
+
+    !! * Local declarations
+    INTEGER :: jh
+    REAL(wp) :: zscale  =  36525*24.0
+    REAL(wp) :: zomega_T=  13149000.0
+    REAL(wp) :: zomega_s=    481267.892
+    REAL(wp) :: zomega_h=     36000.76892
+    REAL(wp) :: zomega_p=      4069.0322056
+    REAL(wp) :: zomega_n=      1934.1423972
+    REAL(wp) :: zomega_p1=        1.719175
+    !!----------------------------------------------------------------------
+
+    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
+       pomega(jh) = (pomega(jh)/zscale)*rad/3600.
+    END DO
+
+  END SUBROUTINE tide_pulse
+
+  SUBROUTINE tide_vuf( pvt, put, pcor, ktide ,kc)
+    !!----------------------------------------------------------------------
+    !!                     ***  ROUTINE tide_vuf  ***
+    !!                      
+    !! ** Purpose : Compute nodal modulation corrections
+    !!
+    !! ** Outputs :
+    !!          vt: Pase of tidal potential relative to Greenwich (radians)
+    !!          ut: Phase correction u due to nodal motion (radians)
+    !!          ft: Nodal correction factor
+    !!
+    !! ** Inputs :
+    !!          tname: array of constituents names (dimension<=nc) 
+    !!             nc: number of constituents
+    !!   
+    !!----------------------------------------------------------------------
+    !! * Arguments
+    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 ) ::   &
+         pvt, &      !
+         put, &      !
+         pcor         !
+    !! * Local declarations
+    INTEGER :: jh
+    !!----------------------------------------------------------------------
+
+    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)
+
+       !!  formule 0, solar waves
+
+    case ( 0 )
+       zf=1.0
+
+       !! formule 1, compound waves (78 x 78)
+
+    case ( 1 )
+       zf=nodal_factort(78)
+       zf=zf*zf
+
+       !! formule 2, compound waves (78 x 0)  ===  (78) 
+
+    case ( 2 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf1*zf
+
+       !! formule 4,  compound waves (78 x 235) 
+
+    case ( 4 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(235)
+       zf=zf1*zf
+
+       !! formule 5,  compound waves (78 *78 x 235)
+
+    case ( 5 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(235)
+       zf=zf*zf1*zf1
+
+       !! formule 6,  compound waves (78 *78 x 0)
+
+    case ( 6 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf*zf1*zf1 
+
+       !! formule 7, compound waves (75 x 75)
+
+    case ( 7 )
+       zf=nodal_factort(75)
+       zf=zf*zf
+
+       !! formule 8,  compound waves (78 x 0 x 235)
+
+    case ( 8 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf2=nodal_factort(235)
+       zf=zf*zf1*zf2
+
+       !! formule 9,  compound waves (78 x 0 x 227)
+
+    case ( 9 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf2=nodal_factort(227)
+       zf=zf*zf1*zf2
+
+       !! formule 10,  compound waves (78 x 227)
+
+    case ( 10 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(227)
+       zf=zf*zf1
+
+       !! formule 11,  compound waves (75 x 0)
+
+    case ( 11 )
+       zf=nodal_factort(75)
+       zf=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 12,  compound waves (78 x 78 x 78 x 0) 
+
+    case ( 12 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(0)
+       zf=zf*zf1*zf1*zf1
+
+       !! formule 13, compound waves (78 x 75)
+
+    case ( 13 )
+       zf1=nodal_factort(78)
+       zf=nodal_factort(75)
+       zf=zf*zf1
+
+       !! formule 14, compound waves (235 x 0)  ===  (235)
+
+    case ( 14 )
+       zf=nodal_factort(235)
+       zf1=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 15, compound waves (235 x 75) 
+
+    case ( 15 )
+       zf=nodal_factort(235)
+       zf1=nodal_factort(75)
+       zf=zf*zf1
+
+       !! formule 16, compound waves (78 x 0 x 0)  ===  (78)
+
+    case ( 16 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf=zf*zf1*zf1
+
+       !! formule 17,  compound waves (227 x 0) 
+
+    case ( 17 )
+       zf1=nodal_factort(227)
+       zf=nodal_factort(0)
+       zf=zf*zf1
+
+       !! formule 18,  compound waves (78 x 78 x 78 )
+
+    case ( 18 ) 
+       zf1=nodal_factort(78)
+       zf=zf1*zf1*zf1
+
+       !! formule 19, compound waves (78 x 0 x 0 x 0)  ===  (78)
+
+    case ( 19 )
+       zf=nodal_factort(78)
+       zf1=nodal_factort(0)
+       zf=zf*zf1*zf1
+
+       !! formule 73
+
+    case ( 73 )
+       zs=sin(sh_I)
+       zf=(2./3.-zs*zs)/0.5021
+
+       !! formule 74
+
+    case ( 74 )
+       zs=sin(sh_I)
+       zf=zs*zs/0.1578
+
+       !! formule 75
+
+    case ( 75 )
+       zs=cos (sh_I/2)
+       zf=sin (sh_I)*zs*zs/0.3800
+
+       !! formule 76
+
+    case ( 76 )
+       zf=sin (2*sh_I)/0.7214
+
+       !! formule 77
+
+    case ( 77 )
+       zs=sin (sh_I/2)
+       zf=sin (sh_I)*zs*zs/0.0164
+
+       !! formule 78
+
+    case ( 78 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs/0.9154
+
+       !! formule 79
+
+    case ( 79 )
+       zs=sin(sh_I)
+       zf=zs*zs/0.1565
+
+       !! formule 144
+
+    case ( 144 )
+       zs=sin (sh_I/2)
+       zf=(1-10*zs*zs+15*zs*zs*zs*zs)*cos(sh_I/2)/0.5873
+
+       !! formule 149
+
+    case ( 149 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs*zs*zs/0.8758
+
+       !! formule 215
+
+    case ( 215 )
+       zs=cos (sh_I/2)
+       zf=zs*zs*zs*zs/0.9154*sh_x1ra
+
+       !! formule 227 
+
+    case ( 227 )
+       zs=sin (2*sh_I)
+       zf=sqrt (0.8965*zs*zs+0.6001*zs*cos (sh_nu)+0.1006)
+
+       !! formule 235 
+
+    case ( 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 .eq. 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90	(revision 3437)
@@ -0,0 +1,72 @@
+MODULE updtide
+  !!=================================================================================
+  !!                       ***  MODULE  updtide  ***
+  !! Initialization of tidal forcing
+  !! History :  9.0  !  07  (O. Le Galloudec)  Original code
+  !!=================================================================================
+#if defined key_tide
+  !! * Modules used
+  USE oce             ! ocean dynamics and tracers variables
+  USE dom_oce         ! ocean space and time domain
+  USE in_out_manager  ! I/O units
+  USE phycst
+  USE sbctide
+  USE dynspg_oce
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! * Routine accessibility
+  PUBLIC upd_tide
+  !!---------------------------------------------------------------------------------
+  !!   OPA 9.0 , LODYC-IPSL  (2003)
+  !!---------------------------------------------------------------------------------
+
+CONTAINS
+
+  SUBROUTINE upd_tide (kt,kit)
+    !!----------------------------------------------------------------------
+    !!                 ***  ROUTINE upd_tide  ***
+    !!----------------------------------------------------------------------      
+    !! * Local declarations
+
+    INTEGER, INTENT( in ) ::   kt,kit      ! ocean time-step index
+    INTEGER  :: ji,jj,jk
+    REAL (wp), DIMENSION(nb_harmo) :: zwt 
+    !...............................................................................
+    ! Potentiel astronomique
+    !...............................................................................
+
+    pot_astro(:,:)=0.e0
+
+    IF (lk_dynspg_ts) THEN
+       zwt(:) = omega_tide(:)* ((kt-kt_tide)*rdt + kit*(rdt/REAL(nn_baro,wp)))
+    ELSE
+       zwt(:) = omega_tide(:)*(kt-kt_tide)*rdt
+    ENDIF
+
+    do jk=1,nb_harmo
+       do ji=1,jpi
+          do jj=1,jpj
+             pot_astro(ji,jj)=pot_astro(ji,jj) + (amp_pot(ji,jj,jk)*COS(zwt(jk)+phi_pot(ji,jj,jk)))      
+          enddo
+       enddo
+    enddo
+
+  END SUBROUTINE upd_tide
+
+#else
+  !!----------------------------------------------------------------------
+  !!   Dummy module :                                        NO TIDE
+  !!----------------------------------------------------------------------
+CONTAINS
+  SUBROUTINE upd_tide( kt,kit )          ! Empty routine
+    INTEGER,INTENT (IN) :: kt, kit
+    WRITE(*,*) 'upd_tide: You should not have seen this print! error?', kt
+  END SUBROUTINE upd_tide
+
+#endif
+
+  !!======================================================================
+
+END MODULE updtide
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/sol_oce.F90	(revision 3437)
@@ -0,0 +1,99 @@
+MODULE sol_oce
+   !!======================================================================
+   !!                    ***  MODULE  sol_oce  ***
+   !! Ocean solver :  elliptic solver variables defined in memory 
+   !!======================================================================
+   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module
+   !!            4.0  ! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sol_oce_alloc : allocate the solver arrays
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE in_out_manager ! I/O manager
+   USE lib_mpp        ! distributed memory computing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sol_oce_alloc   ! routine called in solver.F90
+
+   !                                             !!* Namelist namsol : elliptic solver *
+   INTEGER , PUBLIC ::   nn_solv    =    1        !: = 1/2 type of elliptic solver
+   INTEGER , PUBLIC ::   nn_sol_arp =    0        !: = 0/1 absolute/relative precision convergence test
+   INTEGER , PUBLIC ::   nn_nmin    =  300        !: minimum of iterations for the SOR solver
+   INTEGER , PUBLIC ::   nn_nmax    =  800        !: maximum of iterations for the SOR solver
+   INTEGER , PUBLIC ::   nn_nmod    =   10        !: frequency of test for the SOR solver
+   REAL(wp), PUBLIC ::   rn_eps     =  1.e-6_wp   !: absolute precision of the solver
+   REAL(wp), PUBLIC ::   rn_resmax  = 1.e-14_wp   !: absolute precision for the SOR solver
+   REAL(wp), PUBLIC ::   rn_sor     =   1.92_wp   !: optimal coefficient for the SOR solver
+   REAL(wp), PUBLIC ::   rn_nu      =    1.0_wp   !: strength of the additional force used in free surface
+
+   CHARACTER(len=1), PUBLIC ::   c_solver_pt = 'T'   !: nature of grid-points T (S) for free surface case
+
+   INTEGER , PUBLIC ::   ncut        !: indicator of solver convergence
+   INTEGER , PUBLIC ::   niter       !: number of iteration done by the solver
+
+   REAL(wp), PUBLIC ::   eps, epsr   !: relative precision for SOR & PCG solvers
+   REAL(wp), PUBLIC ::   rnorme      !: intermediate modulus
+   REAL(wp), PUBLIC ::   res         !: solver residu
+   REAL(wp), PUBLIC ::   alph        !: coefficient  =(gcr,gcr)/(gcx,gccd)
+   REAL(wp), PUBLIC ::   beta        !: coefficient  =(rn+1,rn+1)/(rn,rn)
+   REAL(wp), PUBLIC ::   radd        !: coefficient  =(gccd,gcdes)
+   REAL(wp), PUBLIC ::   rr          !: coefficient  =(rn,rn)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gcp     !: matrix extra-diagonal elements
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcx     !: now    solution of the elliptic eq.
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcxb    !: before solution of the elliptic eq.
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdprc  !: inverse diagonal preconditioning matrix
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdmat  !: diagonal preconditioning matrix
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcb     !: second member of the elliptic eq.
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcr     !: residu =b-a.x
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gcdes   !: vector descente
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   gccd    !: gccd= gcdprc^-1.a.d 
+
+#if defined key_agrif
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: laplacu, laplacv
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence    (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sol_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION sol_oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER  :: ierr(3)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+      ALLOCATE( gcp (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ,     &
+         &      gcx (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ,     &
+         &      gcxb(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   , STAT=ierr(1) )
+
+      ALLOCATE( gcdprc(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ,     & 
+         &      gcdmat(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ,     & 
+         &      gcb   (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) , STAT=ierr(2) )
+
+      ALLOCATE( gcr  (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ,   & 
+         &      gcdes(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ,   & 
+         &      gccd (1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ,   &
+#if defined key_agrif
+         &      laplacu(jpi,jpj), laplacv(jpi,jpj),             &
+#endif
+         &      STAT=ierr(3) )
+         !
+      sol_oce_alloc = MAXVAL(ierr)
+      !
+      IF( lk_mpp            )   CALL mpp_sum ( sol_oce_alloc )
+      IF( sol_oce_alloc > 0 )   CALL ctl_warn('sol_oce_alloc: allocation of arrays failed')
+      !
+   END FUNCTION sol_oce_alloc
+
+   !!======================================================================
+END MODULE sol_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90	(revision 3437)
@@ -0,0 +1,400 @@
+MODULE solmat
+   !!======================================================================
+   !!                       ***  MODULE  solmat  ***
+   !! solver       : construction of the matrix 
+   !!======================================================================
+   !! History :   1.0  ! 1988-04  (G. Madec)  Original code
+   !!                  ! 1993-03  (M. Guyon)  symetrical conditions
+   !!                  ! 1993-06  (M. Guyon)  suppress pointers
+   !!                  ! 1996-05  (G. Madec)  merge sor and pcg formulations
+   !!                  ! 1996-11  (A. Weaver)  correction to preconditioning
+   !!   NEMO      1.0  ! 1902-08  (G. Madec)  F90: Free form
+   !!              -   ! 1902-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries
+   !!             2.0  ! 2005-09  (R. Benshila)  add sol_exd for extra outer halo
+   !!              -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!             3.2  ! 2009-06  (S. Masson)  distributed restart using iom
+   !!              -   ! 2009-07  (R. Benshila)  suppression of rigid-lid option
+   !!             3.3  ! 2010-09  (D. Storkey) update for BDY module.
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sol_mat : Construction of the matrix of used by the elliptic solvers
+   !!   sol_exd :
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sol_oce         ! ocean solver
+   USE phycst          ! physical constants
+   USE obc_oce         ! ocean open boundary conditions
+   USE bdy_oce         ! unstructured open boundary conditions
+   USE lbclnk          ! lateral boudary conditions
+   USE lib_mpp         ! distributed memory computing
+   USE in_out_manager  ! I/O manager
+   USE timing          ! timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sol_mat    ! routine called by inisol.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE sol_mat( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_mat  ***
+      !!
+      !! ** Purpose :   Construction of the matrix of used by the elliptic 
+      !!              solvers (either sor or pcg methods).
+      !!
+      !! ** Method  :   The matrix is built for the divergence of the transport 
+      !!              system. a diagonal preconditioning matrix is also defined.
+      !! 
+      !! ** Action  : - gcp    : extra-diagonal elements of the matrix
+      !!              - gcdmat : preconditioning matrix (diagonal elements)
+      !!              - gcdprc : inverse of the preconditioning matrix
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      !!
+      INTEGER ::   ji, jj                    ! dummy loop indices
+      REAL(wp) ::   zcoefs, zcoefw, zcoefe, zcoefn  ! temporary scalars
+      REAL(wp) ::   z2dt, zcoef
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sol_mat')
+      !
+      
+      ! 1. Construction of the matrix
+      ! -----------------------------
+      zcoef = 0.e0                          ! initialize to zero
+      gcp(:,:,1) = 0.e0
+      gcp(:,:,2) = 0.e0
+      gcp(:,:,3) = 0.e0
+      gcp(:,:,4) = 0.e0
+      !
+      gcdprc(:,:) = 0.e0
+      gcdmat(:,:) = 0.e0
+      !
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt = rdt
+      ELSE                                        ;   z2dt = 2. * rdt
+      ENDIF
+
+#if defined key_dynspg_flt && ! defined key_bdy
+#   if ! defined key_obc
+
+      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient
+            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient
+            zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient
+            zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient
+            gcp(ji,jj,1) = zcoefs
+            gcp(ji,jj,2) = zcoefw
+            gcp(ji,jj,3) = zcoefe
+            gcp(ji,jj,4) = zcoefn
+            gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient
+               &          - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+#   else
+    IF ( Agrif_Root() ) THEN
+      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+            !                                    ! south coefficient
+            IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN
+               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1))
+            ELSE
+               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            END IF
+            gcp(ji,jj,1) = zcoefs
+            !
+            !                                    ! west coefficient
+            IF( lp_obc_west  .AND. ( ji == niw0p1 ) ) THEN
+               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1))
+            ELSE
+               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            END IF
+            gcp(ji,jj,2) = zcoefw
+            !
+            !                                    ! east coefficient
+            IF( lp_obc_east  .AND. ( ji == nie0 ) ) THEN
+               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1))
+            ELSE
+               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            END IF
+            gcp(ji,jj,3) = zcoefe
+            !
+            !                                    ! north coefficient
+            IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN
+               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1))
+            ELSE
+               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            END IF
+            gcp(ji,jj,4) = zcoefn
+            !
+            !                                    ! diagonal coefficient
+            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   &
+               &            - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+    ELSE
+      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient
+            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient
+            zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient
+            zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient
+            gcp(ji,jj,1) = zcoefs
+            gcp(ji,jj,2) = zcoefw
+            gcp(ji,jj,3) = zcoefe
+            gcp(ji,jj,4) = zcoefn
+            gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient
+               &          - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+    ENDIF
+#   endif
+
+#  elif defined key_dynspg_flt && defined key_bdy 
+
+      !   defined gcdmat in the case of unstructured open boundaries
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+            zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+
+            !  south coefficient
+            zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+            zcoefs = zcoefs * bdyvmask(ji,jj-1)
+            gcp(ji,jj,1) = zcoefs
+
+            !  west coefficient
+            zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+            zcoefw = zcoefw * bdyumask(ji-1,jj)
+            gcp(ji,jj,2) = zcoefw
+
+            !  east coefficient
+            zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+            zcoefe = zcoefe * bdyumask(ji,jj)
+            gcp(ji,jj,3) = zcoefe
+
+            !  north coefficient
+            zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+            zcoefn = zcoefn * bdyvmask(ji,jj)
+            gcp(ji,jj,4) = zcoefn
+
+            ! diagonal coefficient
+            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) &
+                            - zcoefs -zcoefw -zcoefe -zcoefn
+         END DO
+      END DO
+
+#endif
+
+      IF( .NOT. Agrif_Root() ) THEN
+         !
+         IF( nbondi == -1 .OR. nbondi == 2 )   bmask(2     ,:     ) = 0.e0
+         IF( nbondi ==  1 .OR. nbondi == 2 )   bmask(nlci-1,:     ) = 0.e0
+         IF( nbondj == -1 .OR. nbondj == 2 )   bmask(:     ,2     ) = 0.e0
+         IF( nbondj ==  1 .OR. nbondj == 2 )   bmask(:     ,nlcj-1) = 0.e0
+         !
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zcoef = z2dt * z2dt * grav * bmask(ji,jj)
+               !  south coefficient
+               IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN
+                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))
+               ELSE
+                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)
+               END IF
+               gcp(ji,jj,1) = zcoefs
+               ! 
+               !  west coefficient
+               IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN
+                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))
+               ELSE
+                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)
+               END IF
+               gcp(ji,jj,2) = zcoefw
+               !
+               !   east coefficient
+               IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN
+                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1))
+               ELSE
+                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)
+               END IF
+               gcp(ji,jj,3) = zcoefe
+               !
+               !   north coefficient
+               IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN
+                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1))
+               ELSE
+                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)
+               END IF
+               gcp(ji,jj,4) = zcoefn
+               !
+               ! diagonal coefficient
+               gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   &
+                  &            - zcoefs -zcoefw -zcoefe -zcoefn
+            END DO
+         END DO
+         ! 
+      ENDIF
+
+      ! 2. Boundary conditions 
+      ! ----------------------
+      
+      ! Cyclic east-west boundary conditions
+      !     ji=2 is the column east of ji=jpim1 and reciprocally,
+      !     ji=jpim1 is the column west of ji=2
+      !     all the coef are already set to zero as bmask is initialized to
+      !     zero for ji=1 and ji=jpj in dommsk.
+      
+      ! Symetrical conditions
+      ! free surface: no specific action
+      ! bsf system: n-s gradient of bsf = 0 along j=2 (perhaps a bug !!!!!!)
+      ! the diagonal coefficient of the southern grid points must be modify to
+      ! account for the existence of the south symmetric bassin.
+      
+      ! North fold boundary condition
+      !     all the coef are already set to zero as bmask is initialized to
+      !     zero on duplicated lignes and portion of lignes
+      
+      ! 3. Preconditioned matrix
+      ! ------------------------
+      
+      ! SOR and PCG solvers
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            IF( bmask(ji,jj) /= 0.e0 )   gcdprc(ji,jj) = 1.e0 / gcdmat(ji,jj)
+         END DO
+      END DO
+         
+      gcp(:,:,1) = gcp(:,:,1) * gcdprc(:,:)
+      gcp(:,:,2) = gcp(:,:,2) * gcdprc(:,:)
+      gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:)
+      gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:)
+      IF( nn_solv == 2 )  gccd(:,:) = rn_sor * gcp(:,:,2)
+
+      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN
+         CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,3), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcp   (:,:,4), c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcdprc(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions
+         CALL lbc_lnk_e( gcdmat(:,:)  , c_solver_pt, 1. )   ! lateral boundary conditions         
+         IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements
+      END IF
+   
+      ! 4. Initialization the arrays used in pcg
+      ! ----------------------------------------
+      gcb  (:,:) = 0.e0
+      gcr  (:,:) = 0.e0
+      gcdes(:,:) = 0.e0
+      gccd (:,:) = 0.e0
+      ! 
+      IF( nn_timing == 1 )  CALL timing_stop('sol_mat')
+      !
+   END SUBROUTINE sol_mat
+
+
+   SUBROUTINE sol_exd( pt3d, cd_type )
+      !!----------------------------------------------------------------------
+      !!                  ***  routine sol_exd  ***
+      !!                  
+      !! ** Purpose :   Reorder gcb coefficient on the extra outer  halo 
+      !!                at north fold in case of T or F pivot
+      !!
+      !! ** Method  :   Perform a circular permutation of the coefficients on 
+      !!                the total area strictly above the pivot point,
+      !!                and on the semi-row of the pivot point   
+      !!----------------------------------------------------------------------
+      CHARACTER(len=1) , INTENT( in ) ::   cd_type   ! define the nature of pt2d array grid-points
+         !                                           !  = T , U , V , F , W 
+         !                                           !  = S : T-point, north fold treatment
+         !                                           !  = G : F-point, north fold treatment
+         !                                           !  = I : sea-ice velocity at F-point with index shift
+      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), INTENT(inout) ::   pt3d   ! 2D field to be treated
+      !!
+      INTEGER  ::   ji, jk   ! dummy loop indices
+      INTEGER  ::   iloc     ! local integers
+      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ztab   ! workspace allocated one for all
+      !!----------------------------------------------------------------------
+
+      IF( .NOT. ALLOCATED( ztab ) ) THEN
+         ALLOCATE( ztab(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), STAT=iloc )
+         IF( lk_mpp    )   CALL mpp_sum ( iloc )
+         IF( iloc /= 0 )   CALL ctl_stop('STOP', 'sol_exd: failed to allocate array')
+      ENDIF
+      
+      ztab = pt3d
+
+      SELECT CASE ( npolj )            ! north fold type
+      ! 
+      CASE ( 3 , 4 )                        !==  T pivot  ==!
+         iloc = jpiglo/2 +1 
+         !   
+         SELECT CASE ( cd_type )
+         ! 
+         CASE ( 'T' , 'U', 'W' )
+            DO jk = 1, 4
+               DO ji = 1-jpr2di, nlci+jpr2di
+                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+               END DO
+            END DO
+            DO jk =1, 4
+               DO ji = nlci+jpr2di, 1-jpr2di,  -1
+                  IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) &
+                     & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT
+                     pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4))
+               END DO
+            END DO
+            !
+         CASE ( 'F' , 'I', 'V' )
+            DO jk =1, 4
+               DO ji = 1-jpr2di, nlci+jpr2di
+                  pt3d(ji,nlcj-1:nlcj+jpr2dj,jk) = ztab(ji,nlcj-1:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+               END DO
+            END DO
+            !
+         END SELECT   ! cd_type
+          ! 
+      CASE ( 5 , 6 )                        !==  F pivot  ==!
+         iloc=jpiglo/2
+         !
+         SELECT CASE (cd_type )
+         !
+         CASE ( 'T' , 'U', 'W')
+            DO jk =1, 4
+               DO ji = 1-jpr2di, nlci+jpr2di
+                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+               END DO
+            END DO
+            !
+         CASE ( 'F' , 'I', 'V' )
+            DO jk =1, 4
+               DO ji = 1-jpr2di, nlci+jpr2di
+                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))           
+               END DO
+            END DO
+            DO jk =1, 4
+               DO ji = nlci+jpr2di, 1-jpr2di,  -1
+                  IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) .OR. ( mi0(iloc) == jpi+1 ) )   EXIT
+                    pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4))
+               END DO
+            END DO
+            !
+         END SELECT   ! cd_type
+         !
+      END SELECT   ! npolj
+      !   
+   END SUBROUTINE sol_exd
+
+   !!======================================================================
+END MODULE solmat
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solpcg.F90	(revision 3437)
@@ -0,0 +1,219 @@
+MODULE solpcg
+   !!======================================================================
+   !!                     ***  MODULE  solfet
+   !! Ocean solver :  preconditionned conjugate gradient solver
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   sol_pcg    : preconditionned conjugate gradient solver
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE sol_oce         ! ocean solver variables
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE lib_fortran     ! Fortran routines library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sol_pcg    ! 
+
+   !! * 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 sol_pcg( kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_pcg  ***
+      !!                    
+      !! ** Purpose :   Solve the ellipic equation for the transport
+      !!      divergence system  using a diagonal preconditionned
+      !!      conjugate gradient method.
+      !!
+      !! ** Method  :   Diagonal preconditionned conjugate gradient method.
+      !!      the algorithm is multitasked. (case of 5 points matrix)
+      !!      define              pa  = q^-1 * a
+      !!                        pgcb  = q^-1 * gcb
+      !!                 < . ; . >_q  = ( . )^t q ( . )
+      !!      where q is the preconditioning matrix = diagonal matrix of the
+      !!                                              diagonal elements of a
+      !!      Initialization  :
+      !!         x(o) = gcx
+      !!         r(o) = d(o) = pgcb - pa.x(o)
+      !!         rr(o)= < r(o) , r(o) >_q
+      !!      Iteration 1     :
+      !!         standard PCG algorithm
+      !!      Iteration n > 1 :
+      !!         s(n)   = pa.r(n)
+      !!         gam(n) = < r(n) , r(n) >_q
+      !!         del(n) = < r(n) , s(n) >_q
+      !!         bet(n) = gam(n) / gam(n-1)
+      !!         d(n)   = r(n) + bet(n) d(n-1)
+      !!         z(n)   = s(n) + bet(n) z(n-1) 
+      !!         sig(n) = del(n) - bet(n)*bet(n)*sig(n-1) 
+      !!         alp(n) = gam(n) / sig(n) 
+      !!         x(n+1) = x(n) + alp(n) d(n)
+      !!         r(n+1) = r(n) - alp(n) z(n)
+      !!      Convergence test :
+      !!         rr(n+1) / < gcb , gcb >_q   =< epsr
+      !!
+      !! ** Action : - niter  : solver number of iteration done
+      !!             - res    : solver residu reached
+      !!             - gcx()  : solution of the elliptic system
+      !!
+      !! References :
+      !!      Madec et al. 1988, Ocean Modelling, issue 78, 1-6.
+      !!      D Azevedo et al. 1993, Computer Science Technical Report, Tennessee U.
+      !!
+      !! History :
+      !!        !  90-10  (G. Madec)  Original code
+      !!        !  91-11  (G. Madec)
+      !!        !  93-04  (M. Guyon)  loops and suppress pointers
+      !!        !  95-09  (M. Imbard, J. Escobar)  mpp exchange 
+      !!        !  96-05  (G. Madec)  merge sor and pcg formulations
+      !!        !  96-11  (A. Weaver)  correction to preconditioning
+      !!   8.5  !  02-08  (G. Madec)  F90: Free form
+      !!        !  08-01  (R. Benshila) mpp optimization
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(inout) ::   kindic   ! solver indicator, < 0 if the conver-
+      !                                    ! gence is not reached: the model is stopped in step
+      !                                    ! set to zero before the call of solpcg
+      !!
+      INTEGER  ::   ji, jj, jn   ! dummy loop indices
+      REAL(wp) ::   zgcad        ! temporary scalars
+      REAL(wp), DIMENSION(2) ::   zsum
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zgcr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sol_pcg')
+      !
+      CALL wrk_alloc( jpi, jpj, zgcr )
+      !
+      ! Initialization of the algorithm with standard PCG
+      ! -------------------------------------------------
+      zgcr = 0._wp
+      gcr  = 0._wp
+
+      CALL lbc_lnk( gcx, c_solver_pt, 1. )   ! lateral boundary condition
+
+      ! gcr   = gcb-a.gcx
+      ! gcdes = gcr
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            zgcad = bmask(ji,jj) * ( gcb(ji,jj  ) -                gcx(ji  ,jj  )   &
+               &                                  - gcp(ji,jj,1) * gcx(ji  ,jj-1)   &
+               &                                  - gcp(ji,jj,2) * gcx(ji-1,jj  )   &
+               &                                  - gcp(ji,jj,3) * gcx(ji+1,jj  )   &
+               &                                  - gcp(ji,jj,4) * gcx(ji  ,jj+1)   )
+            gcr  (ji,jj) = zgcad
+            gcdes(ji,jj) = zgcad
+         END DO
+      END DO
+
+      ! rnorme = (gcr,gcr)
+      rnorme = glob_sum(  gcr(:,:) * gcdmat(:,:) * gcr(:,:)  )
+
+      CALL lbc_lnk( gcdes, c_solver_pt, 1. )   ! lateral boundary condition
+
+      ! gccd = matrix . gcdes
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            gccd(ji,jj) = bmask(ji,jj)*( gcdes(ji,jj)   &
+               &        +gcp(ji,jj,1)*gcdes(ji,jj-1)+gcp(ji,jj,2)*gcdes(ji-1,jj)   &
+               &        +gcp(ji,jj,4)*gcdes(ji,jj+1)+gcp(ji,jj,3)*gcdes(ji+1,jj)   )
+         END DO
+      END DO 
+
+      ! alph = (gcr,gcr)/(gcdes,gccd)
+      radd = glob_sum(  gcdes(:,:) * gcdmat(:,:) * gccd(:,:)  )
+      alph = rnorme /radd
+
+      ! gcx = gcx + alph * gcdes
+      ! gcr = gcr - alph * gccd
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            gcx(ji,jj) = bmask(ji,jj) * ( gcx(ji,jj) + alph * gcdes(ji,jj) )
+            gcr(ji,jj) = bmask(ji,jj) * ( gcr(ji,jj) - alph * gccd (ji,jj) )
+         END DO
+      END DO
+
+      ! Algorithm wtih Eijkhout rearrangement
+      ! -------------------------------------
+        
+      !                                                !================
+      DO jn = 1, nn_nmax                               ! Iterative loop
+         !                                             !================
+
+         CALL lbc_lnk( gcr, c_solver_pt, 1. )   ! lateral boundary condition
+
+         ! zgcr = matrix . gcr
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zgcr(ji,jj) = bmask(ji,jj)*( gcr(ji,jj)   &
+                  &        +gcp(ji,jj,1)*gcr(ji,jj-1)+gcp(ji,jj,2)*gcr(ji-1,jj)   &
+                  &        +gcp(ji,jj,4)*gcr(ji,jj+1)+gcp(ji,jj,3)*gcr(ji+1,jj)   )
+            END DO
+         END DO
+ 
+         ! rnorme = (gcr,gcr)
+         rr = rnorme
+
+         ! zgcad = (zgcr,gcr) 
+         zsum(1) = glob_sum(gcr(:,:) * gcdmat(:,:) * gcr(:,:))
+         zsum(2) = glob_sum(gcr(:,:) * gcdmat(:,:) * zgcr(:,:) * bmask(:,:))
+
+         !!RB we should gather the 2 glob_sum
+         rnorme = zsum(1)  
+         zgcad  = zsum(2)
+         ! test of convergence
+         IF( rnorme < epsr .OR. jn == nn_nmax ) THEN
+            res = SQRT( rnorme )
+            niter = jn
+            ncut = 999
+         ENDIF
+
+         ! beta = (rk+1,rk+1)/(rk,rk)
+         beta = rnorme / rr
+         radd = zgcad - beta*beta*radd
+         alph = rnorme / radd
+
+         ! gcx = gcx + alph * gcdes
+         ! gcr = gcr - alph * gccd
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               gcdes(ji,jj) = gcr (ji,jj) + beta * gcdes(ji,jj) 
+               gccd (ji,jj) = zgcr(ji,jj) + beta * gccd (ji,jj) 
+               gcx  (ji,jj) = gcx (ji,jj) + alph * gcdes(ji,jj) 
+               gcr  (ji,jj) = gcr (ji,jj) - alph * gccd (ji,jj) 
+            END DO
+         END DO
+        
+         ! indicator of non-convergence or explosion
+         IF( jn == nn_nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2
+         IF( ncut == 999 ) GOTO 999
+
+         !                                             !================
+      END DO                                           !    End Loop
+      !                                                !================
+999   CONTINUE
+          
+      CALL lbc_lnk( gcx, c_solver_pt, 1. )      ! Output in gcx with lateral b.c. applied
+      ! 
+      CALL wrk_dealloc( jpi, jpj, zgcr )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sol_pcg')
+      !
+   END SUBROUTINE sol_pcg
+
+   !!=====================================================================
+END MODULE solpcg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90	(revision 3437)
@@ -0,0 +1,178 @@
+MODULE solsor
+   !!======================================================================
+   !!                     ***  MODULE  solsor  ***
+   !! Ocean solver :  Successive Over-Relaxation solver
+   !!=====================================================================
+   !! History :  OPA  ! 1990-10  (G. Madec)  Original code
+   !!            7.1  ! 1993-04  (G. Madec)  time filter
+   !!                 ! 1996-05  (G. Madec)  merge sor and pcg formulations
+   !!                 ! 1996-11  (A. Weaver)  correction to preconditioning
+   !!   NEMO     1.0  ! 2003-04  (C. Deltel, G. Madec)  Red-Black SOR in free form
+   !!            2.0  ! 2005-09  (R. Benshila, G. Madec)  MPI optimization
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   sol_sor     : Red-Black Successive Over-Relaxation solver
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE sol_oce         ! solver variables
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distributed memory computing
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_fortran     ! Fortran routines library
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   sol_sor    ! 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+      
+   SUBROUTINE sol_sor( kindic )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE sol_sor  ***
+      !!                 
+      !! ** Purpose :   Solve the ellipic equation for the transport 
+      !!      divergence system  using a red-black successive-over-
+      !!      relaxation method.
+      !!       This routine provides a MPI optimization to the existing solsor
+      !!     by reducing the number of call to lbc.
+      !! 
+      !! ** Method  :   Successive-over-relaxation method using the red-black 
+      !!      technique. The former technique used was not compatible with 
+      !!      the north-fold boundary condition used in orca configurations.
+      !!      Compared to the classical sol_sor, this routine provides a 
+      !!      mpp optimization by reducing the number of calls to lnc_lnk
+      !!      The solution is computed on a larger area and the boudary
+      !!      conditions only when the inside domain is reached.
+      !! 
+      !! References :   Madec et al. 1988, Ocean Modelling, issue 78, 1-6.
+      !!                Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT(inout) ::   kindic   ! solver indicator, < 0 if the convergence is not reached:
+      !                                    ! the model is stopped in step (set to zero before the call of solsor)
+      !!
+      INTEGER  ::   ji, jj, jn       ! dummy loop indices
+      INTEGER  ::   ishift, icount, ijmppodd, ijmppeven, ijpr2d   ! local integers
+      REAL(wp) ::   ztmp, zres, zres2                             ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::   ztab                 ! 2D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('sol_sor')
+      !
+      CALL wrk_alloc( jpi, jpj, ztab )
+      !
+      ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj   , 2 )
+      ijmppodd  = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 )
+      ijpr2d    = MAX( jpr2di , jpr2dj )
+      icount = 0
+      !                                                       ! ==============
+      DO jn = 1, nn_nmax                                      ! Iterative loop 
+         !                                                    ! ==============
+
+         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions
+        
+         ! Residus
+         ! -------
+
+         ! Guess black update
+         DO jj = 2-jpr2dj, nlcj-1+jpr2dj
+            ishift = MOD( jj-ijmppodd-jpr2dj, 2 )
+            DO ji = 2-jpr2di+ishift, nlci-1+jpr2di, 2
+               ztmp =                  gcb(ji  ,jj  )   &
+                  &   - gcp(ji,jj,1) * gcx(ji  ,jj-1)   &
+                  &   - gcp(ji,jj,2) * gcx(ji-1,jj  )   &
+                  &   - gcp(ji,jj,3) * gcx(ji+1,jj  )   &
+                  &   - gcp(ji,jj,4) * gcx(ji  ,jj+1)
+               ! Estimate of the residual
+               zres = ztmp - gcx(ji,jj)
+               gcr(ji,jj) = zres * gcdmat(ji,jj) * zres
+               ! Guess update
+               gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj)
+            END DO
+         END DO
+         icount = icount + 1 
+ 
+         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions
+
+         ! Guess red update
+         DO jj = 2-jpr2dj, nlcj-1+jpr2dj
+            ishift = MOD( jj-ijmppeven-jpr2dj, 2 )
+            DO ji = 2-jpr2di+ishift, nlci-1+jpr2di, 2
+               ztmp =                  gcb(ji  ,jj  )   &
+                  &   - gcp(ji,jj,1) * gcx(ji  ,jj-1)   &
+                  &   - gcp(ji,jj,2) * gcx(ji-1,jj  )   &
+                  &   - gcp(ji,jj,3) * gcx(ji+1,jj  )   &
+                  &   - gcp(ji,jj,4) * gcx(ji  ,jj+1) 
+               ! Estimate of the residual
+               zres = ztmp - gcx(ji,jj)
+               gcr(ji,jj) = zres * gcdmat(ji,jj) * zres
+               ! Guess update
+               gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj)
+            END DO
+         END DO
+         icount = icount + 1
+
+         ! test of convergence
+         IF ( jn > nn_nmin .AND. MOD( jn-nn_nmin, nn_nmod ) == 0 ) THEN
+
+            SELECT CASE ( nn_sol_arp )
+            CASE ( 0 )                 ! absolute precision (maximum value of the residual)
+               zres2 = MAXVAL( gcr(2:nlci-1,2:nlcj-1) )
+               IF( lk_mpp )   CALL mpp_max( zres2 )   ! max over the global domain
+               ! test of convergence
+               IF( zres2 < rn_resmax .OR. jn == nn_nmax ) THEN
+                  res = SQRT( zres2 )
+                  niter = jn
+                  ncut = 999
+               ENDIF
+            CASE ( 1 )                 ! relative precision
+               ztab = 0.
+               ztab(:,:) = gcr(2:nlci-1,2:nlcj-1)
+               rnorme = glob_sum( ztab)    ! sum over the global domain
+               ! test of convergence
+               IF( rnorme < epsr .OR. jn == nn_nmax ) THEN
+                  res = SQRT( rnorme )
+                  niter = jn
+                  ncut = 999
+               ENDIF
+            END SELECT
+         
+         !****
+         !     IF(lwp)WRITE(numsol,9300) jn, res, sqrt( epsr ) / eps
+9300     FORMAT('          niter :',i4,' res :',e20.10,' b :',e20.10)
+         !****
+         
+         ENDIF
+         ! indicator of non-convergence or explosion
+         IF( jn == nn_nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2
+         IF( ncut == 999 ) GOTO 999
+         
+         !                                                 ! =====================
+      END DO                                               ! END of iterative loop
+      !                                                    ! =====================
+      
+999   CONTINUE
+      
+      !  Output in gcx
+      !  -------------
+      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions
+      !
+      CALL wrk_dealloc( jpi, jpj, ztab )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('sol_sor')
+      !
+   END SUBROUTINE sol_sor
+
+   !!=====================================================================
+END MODULE solsor
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/SOL/solver.F90	(revision 3437)
@@ -0,0 +1,122 @@
+MODULE solver
+   !!======================================================================
+   !!                     ***  MODULE  solver  ***
+   !! Ocean solver :  initialization of ocean solver
+   !!=====================================================================
+   !! History :  OPA  ! 1990-10  (G. Madec)  Original code           
+   !!                 ! 1993-02  (O. Marti)                         
+   !!                 ! 1997-02  (G. Madec)  local depth inverse computation
+   !!                 ! 1998-10  (G. Roullet, G. Madec)  free surface 
+   !!   NEMO     1.0  ! 2003-07  (G. Madec)  free form, F90
+   !!            3.2  ! 2009-07  (R. Benshila) suppression of rigid-lid & FETI solver
+   !!----------------------------------------------------------------------
+#if defined key_dynspg_flt   ||   defined key_esopa  
+   !!----------------------------------------------------------------------
+   !!   'key_dynspg_flt'                              filtered free surface
+   !!----------------------------------------------------------------------
+   !!   solver_init: solver initialization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables 
+   USE zdf_oce         ! ocean vertical physics variables
+   USE sol_oce         ! solver variables
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE solmat          ! matrix of the solver
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE timing          ! timing
+
+   IMPLICIT NONE
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE solver_init( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE solver_init  ***
+      !!                   
+      !! ** Purpose :   Initialization of the elliptic solver
+      !!      
+      !! ** Method  :   a solver is required when using the filtered free
+      !!              surface. 
+      !!
+      !! ** Action  : - c_solver_pt : nature of the gridpoint at which the solver is applied
+      !!
+      !! References : Jensen, 1986: Adv. Phys. Oceanogr. Num. Mod.,Ed. O Brien,87-110.
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      !!
+      NAMELIST/namsol/ nn_solv, nn_sol_arp, nn_nmin, nn_nmax, nn_nmod, rn_eps, rn_resmax, rn_sor
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('solver_init')
+      !
+
+      IF(lwp) THEN                  !* open elliptic solver statistics file (only on the printing processors)
+         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
+      ENDIF
+
+      REWIND( numnam )              !* Namelist namsol : elliptic solver / free surface
+      READ  ( numnam, namsol )
+
+      IF(lwp) THEN                  !* Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'solver_init : solver to compute the surface pressure gradient'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namsol : set solver parameters'
+         WRITE(numout,*) '      type of elliptic solver            nn_solv    = ', nn_solv
+         WRITE(numout,*) '      absolute/relative (0/1) precision  nn_sol_arp = ', nn_sol_arp
+         WRITE(numout,*) '      minimum iterations for solver      nn_nmin    = ', nn_nmin
+         WRITE(numout,*) '      maximum iterations for solver      nn_nmax    = ', nn_nmax
+         WRITE(numout,*) '      frequency for test                 nn_nmod    = ', nn_nmod
+         WRITE(numout,*) '      absolute precision of solver       rn_eps     = ', rn_eps
+         WRITE(numout,*) '      absolute precision for SOR solver  rn_resmax  = ', rn_resmax
+         WRITE(numout,*) '      optimal coefficient of sor         rn_sor     = ', rn_sor
+         WRITE(numout,*)
+      ENDIF
+      eps = rn_eps
+
+      !                              ! allocate solver arrays
+      IF( sol_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'solver_init : unable to allocate sol_oce arrays' )
+
+      SELECT CASE( nn_solv )          !* parameter check
+      !
+      CASE ( 1 )                          ! preconditioned conjugate gradient solver
+         IF(lwp) WRITE(numout,*) '   a preconditioned conjugate gradient solver is used'
+         IF( jpr2di /= 0 .AND. jpr2dj /= 0 )   CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' )
+         !
+      CASE ( 2 )                          ! successive-over-relaxation solver
+         IF(lwp) WRITE(numout,*) '   a successive-over-relaxation solver with extra outer halo is used'
+         IF(lwp) WRITE(numout,*) '   with jpr2di =', jpr2di, ' and  jpr2dj =', jpr2dj
+         IF( .NOT. lk_mpp .AND. jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN
+             CALL ctl_stop( 'jpr2di and jpr2dj are not equal to zero',   &
+             &              'In this case the algorithm should be used only with the key_mpp_... option' )
+         ELSE
+            IF( ( ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) .OR. ( jpni /= 1 ) ) &
+              &  .AND. ( jpr2di /= jpr2dj ) )   CALL ctl_stop( 'jpr2di should be equal to jpr2dj' )
+         ENDIF
+         !
+      CASE DEFAULT                        ! error in parameter
+         WRITE(ctmp1,*) '          bad flag value for nn_solv = ', nn_solv
+         CALL ctl_stop( ctmp1 )
+      END SELECT
+      !
+
+      !                             !* Grid-point at which the solver is applied
+!!gm  c_solver_pt should be removed: nomore bsf, only T-point is used
+      c_solver_pt = 'T'                   ! always T-point (ssh solver only, not anymore bsf)
+
+      CALL sol_mat( kt )            !* Construction of the elliptic system matrix
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('solver_init')
+      !
+   END SUBROUTINE solver_init
+#endif
+
+   !!======================================================================
+END MODULE solver
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90	(revision 3437)
@@ -0,0 +1,754 @@
+MODULE eosbn2
+   !!==============================================================================
+   !!                       ***  MODULE  eosbn2  ***
+   !! Ocean diagnostic variable : equation of state - in situ and potential 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
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!             -   ! 2010-10  (G. Nurser, G. Madec)  add eos_alpbet used in ldfslp
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   eos            : generic interface of the equation of state
+   !!   eos_insitu     : Compute the in situ density
+   !!   eos_insitu_pot : Compute the insitu and surface referenced potential
+   !!                    volumic mass
+   !!   eos_insitu_2d  : Compute the in situ density for 2d fields
+   !!   eos_bn2        : Compute the Brunt-Vaisala frequency
+   !!   eos_alpbet     : calculates the in situ thermal/haline expansion ratio
+   !!   tfreez         : Compute the surface freezing temperature
+   !!   eos_init       : set eos parameters (namelist)
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE zdfddm          ! vertical physics: double diffusion
+   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
+
+   !                   !! * Interface
+   INTERFACE eos
+      MODULE PROCEDURE eos_insitu, eos_insitu_pot, eos_insitu_2d
+   END INTERFACE
+   INTERFACE bn2
+      MODULE PROCEDURE eos_bn2
+   END INTERFACE
+
+   PUBLIC   eos        ! called by step, istate, tranpc and zpsgrd modules
+   PUBLIC   eos_init   ! called by istate module
+   PUBLIC   bn2        ! called by step module
+   PUBLIC   eos_alpbet ! called by ldfslp module
+   PUBLIC   tfreez     ! called by sbcice_... modules
+
+   !                                          !!* Namelist (nameos) *
+   INTEGER , PUBLIC ::   nn_eos   = 0         !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ.
+   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4_wp !: thermal expension coeff. (linear equation of state)
+   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4_wp !: saline  expension coeff. (linear equation of state)
+
+   REAL(wp), PUBLIC ::   ralpbet              !: alpha / beta ratio
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE eos_insitu( pts, prd )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE eos_insitu  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from
+      !!       potential temperature and salinity using an equation of state
+      !!       defined through the namelist parameter nn_eos.
+      !!
+      !! ** Method  :   3 cases:
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  :   compute prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                      ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(:,:,:)  , INTENT(  out) ::   prd   ! in situ density            [-]
+      !!
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      REAL(wp) ::   zt , zs , zh , zsr   ! local scalars
+      REAL(wp) ::   zr1, zr2, zr3, zr4   !   -      -
+      REAL(wp) ::   zrhop, ze, zbw, zb   !   -      -
+      REAL(wp) ::   zd , zc , zaw, za    !   -      -
+      REAL(wp) ::   zb1, za1, zkw, zk0   !   -      -
+      REAL(wp) ::   zrau0r               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = fsdept(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp  *zt - 1.120083e-6_wp )*zt + 1.001685e-4_wp )*zt   &
+                     &        -9.095290e-3_wp )*zt + 6.793952e-2_wp )*zt +  999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt        &
+                     &                      -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (-0.1909078_wp*zt+7.390729_wp )        *zt-55.87545_wp
+                  za1= ( ( 2.326469e-3_wp*zt+1.553190_wp)       *zt-65.00517_wp ) *zt+1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation function of temperature only  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==!
+         DO jk = 1, jpkm1
+            prd(:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos  : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos')
+      !
+   END SUBROUTINE eos_insitu
+
+
+   SUBROUTINE eos_insitu_pot( pts, prd, prhop )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_insitu_pot  ***
+      !!
+      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) and the
+      !!      potential volumic mass (Kg/m3) from potential temperature and
+      !!      salinity fields using an equation of state defined through the
+      !!     namelist parameter nn_eos.
+      !!
+      !! ** Method  :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!              rhop(t,s)  = rho(t,s,0)
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t
+      !!              rhop(t,s)  = rho(t,s)
+      !!
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0
+      !!                       = rn_beta * s - rn_alpha * tn - 1.
+      !!              rhop(t,s)  = rho(t,s)
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as (tn,sn) or (ta,sa) are defined over the whole domain.
+      !!
+      !! ** Action  : - prd  , the in situ density (no units)
+      !!              - prhop, the potential volumic mass (Kg/m3)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!                Brown and Campana, Mon. Weather Rev., 1978
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts    ! 1 : potential temperature  [Celcius]
+      !                                                                ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prd    ! in situ density            [-]
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(  out) ::   prhop  ! potential density (surface referenced)
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! local scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r       !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos-p')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zws )
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         zrau0r = 1.e0 / rau0
+!CDIR NOVERRCHK
+         zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) )
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts   (ji,jj,jk,jp_tem)
+                  zs = pts   (ji,jj,jk,jp_sal)
+                  zh = fsdept(ji,jj,jk)        ! depth
+                  zsr= zws   (ji,jj,jk)        ! square root salinity
+                  !
+                  ! compute volumic mass pure water at atm pressure
+                  zr1= ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                     &                          -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+                  ! seawater volumic mass atm pressure
+                  zr2= ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp ) *zt+7.6438e-5_wp ) *zt   &
+                     &                                         -4.0899e-3_wp ) *zt+0.824493_wp
+                  zr3= ( -1.6546e-6_wp*zt+1.0227e-4_wp )    *zt-5.72466e-3_wp
+                  zr4= 4.8314e-4_wp
+                  !
+                  ! potential volumic mass (reference to the surface)
+                  zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+                  !
+                  ! save potential volumic mass
+                  prhop(ji,jj,jk) = zrhop * tmask(ji,jj,jk)
+                  !
+                  ! add the compression terms
+                  ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+                  zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+                  zb = zbw + ze * zs
+                  !
+                  zd = -2.042967e-2_wp
+                  zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+                  zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt - 4.721788_wp
+                  za = ( zd*zsr + zc ) *zs + zaw
+                  !
+                  zb1=   (  -0.1909078_wp  *zt+7.390729_wp    ) *zt-55.87545_wp
+                  za1= ( (   2.326469e-3_wp*zt+1.553190_wp    ) *zt-65.00517_wp ) *zt + 1044.077_wp
+                  zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp ) *zt-30.41638_wp ) *zt + 2098.925_wp ) *zt+190925.6_wp
+                  zk0= ( zb1*zsr + za1 )*zs + zkw
+                  !
+                  ! masked in situ density anomaly
+                  prd(ji,jj,jk) = (  zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  )    &
+                     &             - rau0  ) * zrau0r * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( 0.0285_wp - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp   +            prd (:,:,jk)       ) * rau0 * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 1, jpkm1
+            prd  (:,:,jk) = ( rn_beta  * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) )        * tmask(:,:,jk)
+            prhop(:,:,jk) = ( 1.e0_wp  + prd (:,:,jk) )                                       * rau0 * tmask(:,:,jk)
+         END DO
+         !
+      END SELECT
+      !
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk )
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos-p')
+      !
+   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
+      !!      defined through the namelist parameter nn_eos. * 2D field case
+      !!
+      !! ** Method :
+      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state.
+      !!         the in situ density is computed directly as a function of
+      !!         potential temperature relative to the surface (the opa t
+      !!         variable), salt and pressure (assuming no pressure variation
+      !!         along geopotential surfaces, i.e. the pressure p in decibars
+      !!         is approximated by the depth in meters.
+      !!              prd(t,s,p) = ( rho(t,s,p) - rau0 ) / rau0
+      !!         with pressure                      p        decibars
+      !!              potential temperature         t        deg celsius
+      !!              salinity                      s        psu
+      !!              reference volumic mass        rau0     kg/m**3
+      !!              in situ volumic mass          rho      kg/m**3
+      !!              in situ density anomalie      prd      no units
+      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar,
+      !!          t = 40 deg celcius, s=40 psu
+      !!      nn_eos = 1 : linear equation of state function of temperature only
+      !!              prd(t) = 0.0285 - rn_alpha * t
+      !!      nn_eos = 2 : linear equation of state function of temperature and
+      !!               salinity
+      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1.
+      !!      Note that no boundary condition problem occurs in this routine
+      !!      as pts are defined over the whole domain.
+      !!
+      !! ** Action  : - prd , the in situ density (no units)
+      !!
+      !! References :   Jackett and McDougall, J. Atmos. Ocean. Tech., 1994
+      !!----------------------------------------------------------------------
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                           ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(in   ) ::   pdep  ! depth                  [m]
+      REAL(wp), DIMENSION(jpi,jpj)     , INTENT(  out) ::   prd   ! in situ density
+      !!
+      INTEGER  ::   ji, jj                    ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw   ! temporary scalars
+      REAL(wp) ::   zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask        !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) :: zws
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos2d')
+      !
+      CALL wrk_alloc( jpi, jpj, zws )
+      !
+
+      prd(:,:) = 0._wp
+
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+      !
+!CDIR NOVERRCHK
+         DO jj = 1, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) )
+            END DO
+         END DO
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zmask = tmask(ji,jj,1)          ! land/sea bottom mask = surf. mask
+               zt    = pts  (ji,jj,jp_tem)            ! interpolated T
+               zs    = pts  (ji,jj,jp_sal)            ! interpolated S
+               zsr   = zws  (ji,jj)            ! square root of interpolated S
+               zh    = pdep (ji,jj)            ! depth at the partial step level
+               !
+               ! compute volumic mass pure water at atm pressure
+               zr1 = ( ( ( ( 6.536332e-9_wp*zt-1.120083e-6_wp )*zt+1.001685e-4_wp )*zt   &
+                  &                        -9.095290e-3_wp )*zt+6.793952e-2_wp )*zt+999.842594_wp
+               ! seawater volumic mass atm pressure
+               zr2 = ( ( ( 5.3875e-9_wp*zt-8.2467e-7_wp )*zt+7.6438e-5_wp ) *zt   &
+                  &                                   -4.0899e-3_wp ) *zt+0.824493_wp
+               zr3 = ( -1.6546e-6_wp*zt+1.0227e-4_wp ) *zt-5.72466e-3_wp
+               zr4 = 4.8314e-4_wp
+               !
+               ! potential volumic mass (reference to the surface)
+               zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+               !
+               ! add the compression terms
+               ze = ( -3.508914e-8_wp*zt-1.248266e-8_wp ) *zt-2.595994e-6_wp
+               zbw= (  1.296821e-6_wp*zt-5.782165e-9_wp ) *zt+1.045941e-4_wp
+               zb = zbw + ze * zs
+               !
+               zd =    -2.042967e-2_wp
+               zc =   (-7.267926e-5_wp*zt+2.598241e-3_wp ) *zt+0.1571896_wp
+               zaw= ( ( 5.939910e-6_wp*zt+2.512549e-3_wp ) *zt-0.1028859_wp ) *zt -4.721788_wp
+               za = ( zd*zsr + zc ) *zs + zaw
+               !
+               zb1=     (-0.1909078_wp  *zt+7.390729_wp      ) *zt-55.87545_wp
+               za1=   ( ( 2.326469e-3_wp*zt+1.553190_wp      ) *zt-65.00517_wp ) *zt+1044.077_wp
+               zkw= ( ( (-1.361629e-4_wp*zt-1.852732e-2_wp   ) *zt-30.41638_wp ) *zt   &
+                  &                             +2098.925_wp ) *zt+190925.6_wp
+               zk0= ( zb1*zsr + za1 )*zs + zkw
+               !
+               ! masked in situ density anomaly
+               prd(ji,jj) = ( zrhop / (  1.0_wp - zh / ( zk0 - zh * ( za - zh * zb ) )  ) - rau0 ) / rau0 * zmask
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( 0.0285_wp - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+         !
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' )
+      !
+      CALL wrk_dealloc( jpi, jpj, zws )
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos2d')
+      !
+   END SUBROUTINE eos_insitu_2d
+
+
+   SUBROUTINE eos_bn2( pts, pn2 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE eos_bn2  ***
+      !!
+      !! ** Purpose :   Compute the local Brunt-Vaisala frequency at the time-
+      !!      step of the input arguments
+      !!
+      !! ** Method :
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!         The brunt-vaisala frequency is computed using the polynomial
+      !!      polynomial expression of McDougall (1987):
+      !!            N^2 = grav * beta * ( alpha/beta*dk[ t ] - dk[ s ] )/e3w
+      !!      If lk_zdfddm=T, the heat/salt buoyancy flux ratio Rrau is
+      !!      computed and used in zdfddm module :
+      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] )
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w
+      !!      The use of potential density to compute N^2 introduces e r r o r
+      !!      in the sign of N^2 at great depths. We recommand the use of
+      !!      nn_eos = 0, except for academical studies.
+      !!        Macro-tasked on horizontal slab (jk-loop)
+      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr
+      !!      and is never used at this level.
+      !!
+      !! ** Action  : - pn2 : the brunt-vaisala frequency
+      !!
+      !! References :   McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts   ! 1 : potential temperature  [Celcius]
+      !                                                               ! 2 : salinity               [psu]
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pn2   ! Brunt-Vaisala frequency    [s-1]
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zgde3w, zt, zs, zh, zalbet, zbeta   ! local scalars
+#if defined key_zdfddm
+      REAL(wp) ::   zds   ! local scalars
+#endif
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 ) CALL timing_start('bn2')
+      !
+      ! pn2 : interior points only (2=< jk =< jpkm1 )
+      ! --------------------------
+      !
+      SELECT CASE( nn_eos )
+      !
+      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==!
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zgde3w = grav / fse3w(ji,jj,jk)
+                  zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) )         ! potential temperature at w-pt
+                  zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0  ! salinity anomaly (s-35) at w-pt
+                  zh = fsdepw(ji,jj,jk)                                                ! depth in meters  at w-point
+                  !
+                  zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &   ! ratio alpha/beta
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   +         0.665157e-01_wp                                 &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+                     !
+                  zbeta  = ( ( -0.415613e-09_wp * zt + 0.555579e-07_wp ) * zt      &   ! beta
+                     &                               - 0.301985e-05_wp ) * zt      &
+                     &   +       0.785567e-03_wp                                   &
+                     &   + (     0.515032e-08_wp * zs                              &
+                     &         + 0.788212e-08_wp * zt - 0.356603e-06_wp ) * zs     &
+                     &   + ( (   0.121551e-17_wp * zh                              &
+                     &         - 0.602281e-15_wp * zs                              &
+                     &         - 0.175379e-14_wp * zt + 0.176621e-12_wp ) * zh     &
+                     &                                + 0.408195e-10_wp   * zs     &
+                     &     + ( - 0.213127e-11_wp * zt + 0.192867e-09_wp ) * zt     &
+                     &                                - 0.121555e-07_wp ) * zh
+                     !
+                  pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk)           &   ! N^2
+                     &          * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) )   &
+                     &                     - ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) )
+#if defined key_zdfddm
+                  !                                                         !!bug **** caution a traiter zds=dk[S]= 0 !!!!
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )                    ! Rrau = (alpha / beta) (dk[t] / dk[s])
+                  IF ( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+#endif
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )                !==  Linear formulation = F( temperature )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk)
+         END DO
+         !
+      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==!
+         DO jk = 2, jpkm1
+            pn2(:,:,jk) = grav * (  rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) )      &
+               &                  - rn_beta  * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) )  )   &
+               &               / fse3w(:,:,jk) * tmask(:,:,jk)
+         END DO
+#if defined key_zdfddm
+         DO jk = 2, jpkm1                                 ! Rrau = (alpha / beta) (dk[t] / dk[s])
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) )
+                  IF ( ABS( zds ) <= 1.e-20_wp ) zds = 1.e-20_wp
+                  rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds
+               END DO
+            END DO
+         END DO
+#endif
+      END SELECT
+
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=pn2, clinfo1=' bn2  : ', ovlap=1, kdim=jpk )
+#if defined key_zdfddm
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk )
+#endif
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('bn2')
+      !
+   END SUBROUTINE eos_bn2
+
+
+   SUBROUTINE eos_alpbet( pts, palpbet, beta0 )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_alpbet  ***
+      !!
+      !! ** Purpose :   Calculates the in situ thermal/haline expansion ratio at T-points
+      !!
+      !! ** Method  :   calculates alpha / beta ratio at T-points
+      !!       * nn_eos = 0  : UNESCO sea water properties
+      !!                       The alpha/beta ratio is returned as 3-D array palpbet using the polynomial
+      !!                       polynomial expression of McDougall (1987).
+      !!                       Scalar beta0 is returned = 1.
+      !!       * nn_eos = 1  : linear equation of state (temperature only)
+      !!                       The ratio is undefined, so we return alpha as palpbet
+      !!                       Scalar beta0 is returned = 0.
+      !!       * nn_eos = 2  : linear equation of state (temperature & salinity)
+      !!                       The alpha/beta ratio is returned as ralpbet
+      !!                       Scalar beta0 is returned = 1.
+      !!
+      !! ** Action  : - palpbet : thermal/haline expansion ratio at T-points
+      !!            :   beta0   : 1. or 0.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in   ) ::   pts       ! pot. temperature & salinity
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   palpbet   ! thermal/haline expansion ratio
+      REAL(wp),                              INTENT(  out) ::   beta0     ! set = 1 except with case 1 eos, rho=rho(T)
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zt, zs, zh   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 ) CALL timing_start('eos_alpbet')
+      !
+      SELECT CASE ( nn_eos )
+      !
+      CASE ( 0 )               ! Jackett and McDougall (1994) formulation
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zt = pts(ji,jj,jk,jp_tem)           ! potential temperature
+                  zs = pts(ji,jj,jk,jp_sal) - 35._wp  ! salinity anomaly (s-35)
+                  zh = fsdept(ji,jj,jk)               ! depth in meters
+                  !
+                  palpbet(ji,jj,jk) =                                              &
+                     &     ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt   &
+                     &                                  - 0.203814e-03_wp ) * zt   &
+                     &                                  + 0.170907e-01_wp ) * zt   &
+                     &   + 0.665157e-01_wp                                         &
+                     &   +     ( - 0.678662e-05_wp * zs                            &
+                     &           - 0.846960e-04_wp * zt + 0.378110e-02_wp ) * zs   &
+                     &   +   ( ( - 0.302285e-13_wp * zh                            &
+                     &           - 0.251520e-11_wp * zs                            &
+                     &           + 0.512857e-12_wp * zt * zt              ) * zh   &
+                     &           - 0.164759e-06_wp * zs                            &
+                     &        +(   0.791325e-08_wp * zt - 0.933746e-06_wp ) * zt   &
+                     &                                  + 0.380374e-04_wp ) * zh
+               END DO
+            END DO
+         END DO
+         beta0 = 1._wp
+         !
+      CASE ( 1 )              !==  Linear formulation = F( temperature )  ==!
+         palpbet(:,:,:) = rn_alpha
+         beta0 = 0._wp
+         !
+      CASE ( 2 )              !==  Linear formulation = F( temperature , salinity )  ==!
+         palpbet(:,:,:) = ralpbet
+         beta0 = 1._wp
+         !
+      CASE DEFAULT
+         IF(lwp) WRITE(numout,cform_err)
+         IF(lwp) WRITE(numout,*) '          bad flag value for nn_eos = ', nn_eos
+         nstop = nstop + 1
+         !
+      END SELECT
+      !
+      IF( nn_timing == 1 ) CALL timing_stop('eos_alpbet')
+      !
+   END SUBROUTINE eos_alpbet
+
+
+   FUNCTION tfreez( psal ) RESULT( ptf )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   Compute the sea surface freezing temperature [Celcius]
+      !!
+      !! ** Method  :   UNESCO freezing point at the surface (pressure = 0???)
+      !!       freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p
+      !!       checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars
+      !!
+      !! Reference  :   UNESCO tech. papers in the marine science no. 28. 1978
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   psal   ! salinity             [psu]
+      ! Leave result array automatic rather than making explicitly allocated
+      REAL(wp), DIMENSION(jpi,jpj)                ::   ptf    ! freezing temperature [Celcius]
+      !!----------------------------------------------------------------------
+      !
+      ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) )   &
+         &                     - 2.154996e-4_wp *       psal(:,:)   ) * psal(:,:)
+      !
+   END FUNCTION tfreez
+
+
+   SUBROUTINE eos_init
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE eos_init  ***
+      !!
+      !! ** Purpose :   initializations for the equation of state
+      !!
+      !! ** Method  :   Read the namelist nameos and control the parameters
+      !!----------------------------------------------------------------------
+      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )            ! Read Namelist nameos : equation of state
+      READ  ( numnam, nameos )
+      !
+      IF(lwp) THEN                ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'eos_init : equation of state'
+         WRITE(numout,*) '~~~~~~~~'
+         WRITE(numout,*) '          Namelist nameos : set eos parameters'
+         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos
+         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha
+         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta
+      ENDIF
+      !
+      SELECT CASE( nn_eos )         ! check option
+      !
+      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and'
+         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency'
+         !
+      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )'
+         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   &
+              &                         ' that T and S are used as state variables' )
+         !
+      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==!
+         ralpbet = rn_alpha / rn_beta
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )'
+         !
+      CASE DEFAULT                     !==  ERROR in nn_eos  ==!
+         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos
+         CALL ctl_stop( ctmp1 )
+         !
+      END SELECT
+      !
+   END SUBROUTINE eos_init
+
+   !!======================================================================
+END MODULE eosbn2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90	(revision 3437)
@@ -0,0 +1,207 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE cla             ! cross land advection      (cla_traadv     routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE prtctl          ! Print control
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+
+   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_cen2   = .TRUE.    ! 2nd order centered scheme flag
+   LOGICAL ::   ln_traadv_tvd    = .FALSE.   ! TVD scheme flag
+   LOGICAL ::   ln_traadv_muscl  = .FALSE.   ! MUSCL scheme flag
+   LOGICAL ::   ln_traadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag
+   LOGICAL ::   ln_traadv_ubs    = .FALSE.   ! UBS scheme flag
+   LOGICAL ::   ln_traadv_qck    = .FALSE.   ! QUICKEST scheme flag
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn )
+      !                                          ! set time step
+      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000
+         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog)
+      ENDIF
+      !
+      IF( nn_cla == 1 )   CALL cla_traadv( kt )       !==  Cross Land Advection  ==! (hor. advection)
+      !
+      !                                               !==  effective transport  ==!
+      DO jk = 1, jpkm1
+         zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk)                  ! eulerian transport only
+         zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk)
+      END DO
+      zun(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      zvn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      zwn(:,:,jpk) = 0._wp                                                     ! no transport trough the bottom
+      !
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &
+         &              CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )    ! add the eiv transport (if necessary)
+      !
+      CALL iom_put( "uocetr_eff", zun )                                         ! output effective transport      
+      CALL iom_put( "vocetr_eff", zvn )
+      CALL iom_put( "wocetr_eff", zwn )
+
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, nit000, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_tvd   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_ubs   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_adv_qck   ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )          
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               &
+            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+      !
+      !                                              ! 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
+      !!
+      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,     &
+         &                 ln_traadv_muscl, ln_traadv_muscl2,  &
+         &                 ln_traadv_ubs  , ln_traadv_qck
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )                ! Read Namelist namtra_adv : tracer advection scheme
+      READ  ( numnam, 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,*) '      2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck
+      ENDIF
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_traadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_traadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_traadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_traadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_traadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' )
+
+      !                              ! Set nadv
+      IF( ln_traadv_cen2   )   nadv =  1
+      IF( ln_traadv_tvd    )   nadv =  2
+      IF( ln_traadv_muscl  )   nadv =  3
+      IF( ln_traadv_muscl2 )   nadv =  4
+      IF( ln_traadv_ubs    )   nadv =  5
+      IF( ln_traadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_adv_init
+
+  !!======================================================================
+END MODULE traadv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90	(revision 3437)
@@ -0,0 +1,358 @@
+MODULE traadv_cen2
+   !!======================================================================
+   !!                     ***  MODULE  traadv_cen2  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!======================================================================
+   !! History :  8.2  ! 2001-08  (G. Madec, E. Durand)  trahad+trazad=traadv 
+   !!            1.0  ! 2002-06  (G. Madec)  F90: Free form and module
+   !!            9.0  ! 2004-08  (C. Talandier) New trends organization
+   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
+   !!            2.0  ! 2006-04  (R. Benshila, G. Madec) Step reorganization
+   !!             -   ! 2006-07  (G. madec)  add ups_orca_set routine
+   !!            3.2  ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!            3.3  ! 2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme
+   !!   ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only)
+   !!----------------------------------------------------------------------
+   USE oce, ONLY: tsn  ! now ocean temperature and salinity
+   USE dom_oce         ! ocean space and time domain
+   USE eosbn2          ! equation of state
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE closea          ! closed sea
+   USE sbcrnf          ! river runoffs
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+   USE diaptr          ! poleward transport diagnostics
+   USE zdf_oce         ! ocean vertical physics
+   USE restart         ! ocean restart
+   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_cen2       ! routine called by step.F90
+   PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 
+   !                                                             !  and in closed seas (orca 2 and 4 configurations)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_cen2( kt, kit000, cdtype, pun, pvn, pwn,     &
+      &                                 ptb, ptn, pta, kjpt   ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_cen2  ***
+      !!                 
+      !! ** Purpose :   Compute the now trend due to the advection of tracers
+      !!      and add it to the general trend of passive tracer equations.
+      !!
+      !! ** Method  :   The advection is evaluated by a second order centered
+      !!      scheme using now fields (leap-frog scheme). In specific areas
+      !!      (vicinity of major river mouths, some straits, or where tn is
+      !!      approaching the freezing point) it is mixed with an upstream
+      !!      scheme for stability reasons.
+      !!         Part 0 : compute the upstream / centered flag
+      !!                  (3D array, zind, defined at T-point (0<zind<1))
+      !!         Part I : horizontal advection
+      !!       * centered flux:
+      !!               zcenu = e2u*e3u  un  mi(ptn)
+      !!               zcenv = e1v*e3v  vn  mj(ptn)
+      !!       * upstream flux:
+      !!               zupsu = e2u*e3u  un  (ptb(i) or ptb(i-1) ) [un>0 or <0]
+      !!               zupsv = e1v*e3v  vn  (ptb(j) or ptb(j-1) ) [vn>0 or <0]
+      !!       * mixed upstream / centered horizontal advection scheme
+      !!               zcofi = max(zind(i+1), zind(i))
+      !!               zcofj = max(zind(j+1), zind(j))
+      !!               zwx = zcofi * zupsu + (1-zcofi) * zcenu
+      !!               zwy = zcofj * zupsv + (1-zcofj) * zcenv
+      !!       * horizontal advective trend (divergence of the fluxes)
+      !!               ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] }
+      !!       * Add this trend now to the general trend of tracer (ta,sa):
+      !!               pta = pta + ztra
+      !!       * trend diagnostic ('key_trdtra' defined): the trend is
+      !!      saved for diagnostics. The trends saved is expressed as
+      !!      Uh.gradh(T), i.e.
+      !!                     save trend = ztra + ptn divn
+      !!
+      !!         Part II : vertical advection
+      !!      For temperature (idem for salinity) the advective trend is com-
+      !!      puted as follows :
+      !!            ztra = 1/e3t dk+1[ zwz ]
+      !!      where the vertical advective flux, zwz, is given by :
+      !!            zwz = zcofk * zupst + (1-zcofk) * zcent
+      !!      with
+      !!        zupsv = upstream flux = wn * (ptb(k) or ptb(k-1) ) [wn>0 or <0]
+      !!        zcenu = centered flux = wn * mk(tn)
+      !!         The surface boundary condition is :
+      !!      variable volume (lk_vvl = T) : zero advective flux
+      !!      lin. free-surf  (lk_vvl = F) : wn(:,:,1) * ptn(:,:,1)
+      !!         Add this trend now to the general trend of tracer (ta,sa):
+      !!             pta = pta + ztra
+      !!         Trend diagnostic ('key_trdtra' defined): the trend is
+      !!      saved for diagnostics. The trends saved is expressed as :
+      !!             save trend =  w.gradz(T) = ztra - ptn divn.
+      !!
+      !! ** Action :  - update pta  with the now advective tracer trends
+      !!              - save trends if needed
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx => ua        , zwy  => va          ! (ua,va) used as 3D workspace
+      !
+      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     ), 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
+      INTEGER  ::   ierr             ! local integer
+      REAL(wp) ::   zbtr, ztra                            ! local scalars
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w, zcofi          !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w, zcofj, zcofk   !   -      -
+      REAL(wp) ::   zupsut, zcenut, zupst                 !   -      -
+      REAL(wp) ::   zupsvt, zcenvt, zcent, zice           !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztfreez 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zind
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen2')
+      !
+      CALL wrk_alloc( jpi, jpj, ztfreez )
+      CALL wrk_alloc( jpi, jpj, jpk, zwz, zind )
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
+         IF(lwp) WRITE(numout,*)
+         !
+         IF (.not. ALLOCATED(upsmsk))THEN
+             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )
+             IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array')
+         ENDIF
+
+         !
+         upsmsk(:,:) = 0._wp                             ! not upstream by default
+         ! 
+         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits
+         !                                               ! and in closed seas (orca2 and orca4 only)
+         IF( jp_cfg == 2 .AND. .NOT. ln_rstart ) THEN    ! Increase the background in the surface layers
+            avmb(1) = 10.  * avmb(1)      ;      avtb(1) = 10.  * avtb(1)
+            avmb(2) = 10.  * avmb(2)      ;      avtb(2) = 10.  * avtb(2)
+            avmb(3) =  5.  * avmb(3)      ;      avtb(3) =  5.  * avtb(3)
+            avmb(4) =  2.5 * avmb(4)      ;      avtb(4) =  2.5 * avtb(4)
+         ENDIF
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      ENDIF
+      !
+      ! Upstream / centered scheme indicator
+      ! ------------------------------------
+!!gm  not strickly exact : the freezing point should be computed at each ocean levels...
+!!gm  not a big deal since cen2 is no more used in global ice-ocean simulations
+      ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) )
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !                                        ! below ice covered area (if tn < "freezing"+0.1 )
+               IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN   ;   zice = 1.e0
+               ELSE                                                      ;   zice = 0.e0
+               ENDIF
+               zind(ji,jj,jk) = MAX (   &
+                  rnfmsk(ji,jj) * rnfmsk_z(jk),      &  ! near runoff mouths (& closed sea outflows)
+                  upsmsk(ji,jj)               ,      &  ! some of some straits
+                  zice                               &  ! below ice covered area (if tn < "freezing"+0.1 )
+                  &                  ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      DO jn = 1, kjpt
+         !
+         ! I. Horizontal advection
+         !    ====================
+         !
+         DO jk = 1, jpkm1
+            !                        ! Second order centered tracer flux at u- and v-points
+            DO jj = 1, jpjm1
+               !
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofi = MAX( zind(ji+1,jj,jk), zind(ji,jj,jk) )
+                  zcofj = MAX( zind(ji,jj+1,jk), zind(ji,jj,jk) )
+                  !
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zupsut = zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn)
+                  zupsvt = zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn)
+                  ! centered scheme
+                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  ! mixed centered / upstream scheme
+                  zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut )
+                  zwy(ji,jj,jk) = 0.5 * ( zcofj * zupsvt + (1.-zcofj) * zcenvt )
+               END DO
+            END DO
+         END DO
+
+         ! II. Vertical advection
+         !     ==================
+         !
+         !                                                ! Vertical advective fluxes
+         zwz(:,:,jpk) = 0.e0                                   ! Bottom  value : flux set to zero
+         !                                                     ! Surface value : 
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         !
+         DO jk = 2, jpk              ! Second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! upstream indicator
+                  zcofk = MAX( zind(ji,jj,jk-1), zind(ji,jj,jk) ) 
+                  ! mixed centered / upstream scheme
+                  zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zupst = zfp_w * ptb(ji,jj,jk,jn) + zfm_w * ptb(ji,jj,jk-1,jn)
+                  ! centered scheme
+                  zcent = pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )
+                  ! mixed centered / upstream scheme
+                  zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent )
+               END DO
+            END DO
+         END DO
+
+         ! II. Divergence of advective fluxes
+         ! ----------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) *  fse3t(ji,jj,jk) )
+                  ! advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                  &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  )
+                  ! advective trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         !
+      ENDDO
+
+      ! ---------------------------  required in restart file to ensure restartability)
+      ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc...
+      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN
+         CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb )
+         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, ztfreez )
+      CALL wrk_dealloc( jpi, jpj, jpk, zwz, zind )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen2')
+      !
+   END SUBROUTINE tra_adv_cen2
+   
+   
+   SUBROUTINE ups_orca_set
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ups_orca_set  ***
+      !!       
+      !! ** Purpose :   add a portion of upstream scheme in area where the
+      !!                centered scheme generates too strong overshoot
+      !!
+      !! ** Method  :   orca (R4 and R2) confiiguration setting. Set upsmsk
+      !!                array to nozero value in some straith. 
+      !!
+      !! ** Action : - upsmsk set to 1 at some strait, 0 elsewhere for orca
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ups_orca_set')
+      !
+      ! mixed upstream/centered scheme near river mouths
+      ! ------------------------------------------------
+      SELECT CASE ( jp_cfg )
+      !                                        ! =======================
+      CASE ( 4 )                               !  ORCA_R4 configuration 
+         !                                     ! =======================
+         !                                          ! Gibraltar Strait
+         ii0 =  70   ;   ii1 =  71
+         ij0 =  52   ;   ij1 =  53   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         !
+         !                                     ! =======================
+      CASE ( 2 )                               !  ORCA_R2 configuration 
+         !                                     ! =======================
+         !                                          ! Gibraltar Strait
+         ij0 = 102   ;   ij1 = 102
+         ii0 = 138   ;   ii1 = 138   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.20
+         ii0 = 139   ;   ii1 = 139   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+         ii0 = 140   ;   ii1 = 140   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         ij0 = 101   ;   ij1 = 102
+         ii0 = 141   ;   ii1 = 141   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         !                                          ! Bab el Mandeb Strait
+         ij0 =  87   ;   ij1 =  88
+         ii0 = 164   ;   ii1 = 164   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.10
+         ij0 =  88   ;   ij1 =  88
+         ii0 = 163   ;   ii1 = 163   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ii0 = 162   ;   ii1 = 162   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40
+         ii0 = 160   ;   ii1 = 161   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         ij0 =  89   ;   ij1 =  89
+         ii0 = 158   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ij0 =  90   ;   ij1 =  90
+         ii0 = 160   ;   ii1 = 160   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         !                                          ! Sound Strait
+         ij0 = 116   ;   ij1 = 116
+         ii0 = 144   ;   ii1 = 144   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         ii0 = 145   ;   ii1 = 147   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.50
+         ii0 = 148   ;   ii1 = 148   ;   upsmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.25
+         !
+      END SELECT 
+      
+      ! mixed upstream/centered scheme over closed seas
+      ! -----------------------------------------------
+      CALL clo_ups( upsmsk(:,:) )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ups_orca_set')
+      !
+   END SUBROUTINE ups_orca_set
+
+   !!======================================================================
+END MODULE traadv_cen2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90	(revision 3437)
@@ -0,0 +1,216 @@
+MODULE traadv_eiv
+   !!======================================================================
+   !!                    ***  MODULE  traadv_eiv  ***
+   !! Ocean tracers:  advection trend - eddy induced velocity
+   !!======================================================================
+   !! History :  1.0  !  2005-11 (G. Madec)  Original code, from traldf and zdf _iso
+   !!            3.3  !  2010-05 (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_traldf_eiv   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_eiv'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso : update the tracer trend with the horizontal component
+   !!                 of iso neutral laplacian operator or horizontal 
+   !!                 laplacian operator in s-coordinate
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfslp          ! iso-neutral slopes
+   USE in_out_manager  ! I/O manager
+   USE iom
+   USE trc_oce         ! share passive tracers/Ocean variables
+# if defined key_diaeiv
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE diaar5, ONLY:   lk_diaar5
+# endif  
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_eiv   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_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_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_eiv  ***
+      !! 
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The eddy induced advection is computed from the slope
+      !!      of iso-neutral surfaces computed in routine ldf_slp as follows:
+      !!         zu_eiv =  1/(e2u e3u)   dk[ aeiu e2u mi(wslpi) ]
+      !!         zv_eiv =  1/(e1v e3v)   dk[ aeiv e1v mj(wslpj)
+      !!         zw_eiv = -1/(e1t e2t) { di[ aeiu e2u mi(wslpi) ]
+      !!                               + dj[ aeiv e1v mj(wslpj) ] }
+      !!      add the eiv component to the model velocity:
+      !!         p.n = p.n + z._eiv
+      !!
+      !! ** Action  : - add to p.n the eiv component
+      !!----------------------------------------------------------------------
+      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 velocity components 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pvn      ! out: 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pwn      ! increased by the eiv
+      !!
+      INTEGER  ::   ji, jj, jk                 ! dummy loop indices
+      REAL(wp) ::   zuwk, zuwk1, zuwi, zuwi1   ! local scalars
+      REAL(wp) ::   zvwk, zvwk1, zvwj, zvwj1   !   -      -
+# if defined key_diaeiv 
+      REAL(wp) ::   zztmp                      ! local scalar
+# endif  
+      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_adv_eiv')
+      !
+# if defined key_diaeiv 
+      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
+# else
+      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
+# endif
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   add to velocity fields the eiv component'
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,:) = 0.e0
+            v_eiv(:,:,:) = 0.e0
+            w_eiv(:,:,:) = 0.e0
+         END IF
+# endif
+      ENDIF
+
+      zu_eiv(:,:) = 0.e0   ;   zv_eiv(:,:) = 0.e0   ;    zw_eiv(:,:) = 0.e0  
+      
+                                                    ! =================
+      DO jk = 1, jpkm1                              !  Horizontal slab
+         !                                          ! =================
+         DO jj = 1, jpjm1
+            DO ji = 1, fs_jpim1   ! vector opt.
+               zuwk = ( wslpi(ji,jj,jk  ) + wslpi(ji+1,jj,jk  ) ) * fsaeiu(ji,jj,jk  ) * umask(ji,jj,jk  )
+               zuwk1= ( wslpi(ji,jj,jk+1) + wslpi(ji+1,jj,jk+1) ) * fsaeiu(ji,jj,jk+1) * umask(ji,jj,jk+1)
+               zvwk = ( wslpj(ji,jj,jk  ) + wslpj(ji,jj+1,jk  ) ) * fsaeiv(ji,jj,jk  ) * vmask(ji,jj,jk  )
+               zvwk1= ( wslpj(ji,jj,jk+1) + wslpj(ji,jj+1,jk+1) ) * fsaeiv(ji,jj,jk+1) * vmask(ji,jj,jk+1)
+
+               zu_eiv(ji,jj) = 0.5 * umask(ji,jj,jk) * ( zuwk - zuwk1 ) 
+               zv_eiv(ji,jj) = 0.5 * vmask(ji,jj,jk) * ( zvwk - zvwk1 ) 
+   
+               pun(ji,jj,jk) = pun(ji,jj,jk) + e2u(ji,jj) * zu_eiv(ji,jj)
+               pvn(ji,jj,jk) = pvn(ji,jj,jk) + e1v(ji,jj) * zv_eiv(ji,jj)
+            END DO
+         END DO
+# if defined key_diaeiv 
+         IF( cdtype == 'TRA') THEN
+            u_eiv(:,:,jk) = zu_eiv(:,:) / fse3u(:,:,jk)
+            v_eiv(:,:,jk) = zv_eiv(:,:) / fse3v(:,:,jk)
+         END IF
+# endif
+         IF( jk >=2 ) THEN                             ! jk=1 zw_eiv=0, not computed
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+# if defined key_traldf_c2d || defined key_traldf_c3d
+                  zuwi  = ( wslpi(ji,jj,jk)+wslpi(ji-1,jj,jk) ) * fsaeiu(ji-1,jj,jk) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwi1 = ( wslpi(ji,jj,jk)+wslpi(ji+1,jj,jk) ) * fsaeiu(ji  ,jj,jk) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwj  = ( wslpj(ji,jj,jk)+wslpj(ji,jj-1,jk) ) * fsaeiv(ji,jj-1,jk) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwj1 = ( wslpj(ji,jj,jk)+wslpj(ji,jj+1,jk) ) * fsaeiv(ji,jj  ,jk) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+  
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj ) 
+# else
+                  zuwi  = ( wslpi(ji,jj,jk) + wslpi(ji-1,jj,jk) ) * e2u(ji-1,jj) * umask(ji-1,jj,jk)
+                  zuwi1 = ( wslpi(ji,jj,jk) + wslpi(ji+1,jj,jk) ) * e2u(ji  ,jj) * umask(ji  ,jj,jk)
+                  zvwj  = ( wslpj(ji,jj,jk) + wslpj(ji,jj-1,jk) ) * e1v(ji,jj-1) * vmask(ji,jj-1,jk)
+                  zvwj1 = ( wslpj(ji,jj,jk) + wslpj(ji,jj+1,jk) ) * e1v(ji  ,jj) * vmask(ji  ,jj,jk)
+
+                  zw_eiv(ji,jj) = - 0.5 * tmask(ji,jj,jk) * fsaeiw(ji,jj,jk) * ( zuwi1 - zuwi + zvwj1 - zvwj )
+# endif
+                  pwn(ji,jj,jk) = pwn(ji,jj,jk) + zw_eiv(ji,jj)
+               END DO
+            END DO
+# if defined key_diaeiv 
+            IF( cdtype == 'TRA')  w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1t(:,:) * e2t(:,:) )
+# endif
+         ENDIF
+         !                                          ! =================
+      END DO                                        !    End of slab  
+      !                                             ! =================
+
+# if defined key_diaeiv 
+      IF( cdtype == 'TRA') THEN
+         CALL iom_put( "uoce_eiv", u_eiv )    ! i-eiv current
+         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current
+         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current
+         IF( lk_diaar5 ) THEN
+            zztmp = 0.5 * rau0 * rcp 
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) &
+                       &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e1u(ji,jj) * fse3u(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "ueiv_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0.e0 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) &
+                     &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e2v(ji,jj) * fse3v(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "veiv_heattr", z2d )                  !  heat transport in i-direction
+         ENDIF
+    END IF
+# endif  
+      ! 
+# if defined key_diaeiv 
+      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d )
+# else
+      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv )
+# endif
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_adv_eiv')
+      !
+    END SUBROUTINE tra_adv_eiv
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             No rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_adv_eiv( kt, kit000, pun, pvn, pwn, cdtype )              ! Empty routine
+      INTEGER  ::   kt    
+      INTEGER  ::   kit000    
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pun, pvn, pwn
+      WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1)
+   END SUBROUTINE tra_adv_eiv
+#endif
+
+   !!==============================================================================
+END MODULE traadv_eiv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90	(revision 3437)
@@ -0,0 +1,263 @@
+MODULE traadv_muscl
+   !!======================================================================
+   !!                       ***  MODULE  traadv_muscl  ***
+   !! 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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_muscl : update the tracer trend with the horizontal
+   !!                   and vertical advection trends using MUSCL scheme
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra      ! tracers trends 
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE trabbl          ! tracers: bottom boundary layer
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_muscl  ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, &
+      &                                        ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE tra_adv_muscl  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of T and 
+      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!      Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
+      !!
+      !! ** Action  : - update (ta,sa) with the now advective tracer trends
+      !!              - save trends 
+      !!
+      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx   => ua    , zwy   => va          ! (ua,va) used as workspace
+      !
+      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(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars
+      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
+      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy )
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+
+      !                                                     ! ===========
+      DO jn = 1, kjpt                                       ! tracer loop
+         !                                                  ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+         !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk) 
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !                                                    ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )
+         !
+         ! Tracer flux divergence at t-point added to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO        
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
+         ENDIF 
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 
+                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO 
+            END DO
+         END DO
+
+         ! Compute & add the vertical advective trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      ENDDO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl')
+      !
+   END SUBROUTINE tra_adv_muscl
+
+   !!======================================================================
+END MODULE traadv_muscl
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90	(revision 3437)
@@ -0,0 +1,297 @@
+MODULE traadv_muscl2
+   !!======================================================================
+   !!                       ***  MODULE  traadv_muscl2  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!======================================================================
+   !! History :  1.0  !  2002-06  (G. Madec) from traadv_muscl
+   !!            3.2  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_muscl2 : update the tracer trend with the horizontal
+   !!                    and vertical advection trends using MUSCL2 scheme
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends 
+   USE trdtra          ! tracers trends 
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE trabbl          ! tracers: bottom boundary layer
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_muscl2        ! routine called by step.F90
+
+   LOGICAL  :: l_trd       ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_muscl2( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                         ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_adv_muscl2  ***
+      !!
+      !! ** Purpose :   Compute the now trend due to total advection of T and 
+      !!      S using a MUSCL scheme (Monotone Upstream-centered Scheme for
+      !!      Conservation Laws) and add it to the general tracer trend.
+      !!
+      !! ** Method  : MUSCL scheme plus centered scheme at ocean boundaries
+      !!
+      !! ** Action  : - update (pta) with the now advective tracer trends
+      !!              - save trends 
+      !!
+      !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation
+      !!              IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa)
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx   => ua    , zwy   => va         ! (ua,va) used as 3D workspace
+      !!
+      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(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before & now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zu, z0u, zzwx, zw         ! local scalars
+      REAL(wp) ::   zv, z0v, zzwy, z0w        !   -      -
+      REAL(wp) ::   ztra, zbtr, zdt, zalpha   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zslpx, zslpy
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_muscl2')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zslpx, zslpy )
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE.
+      ENDIF
+
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! I. Horizontal advective fluxes
+         ! ------------------------------
+         ! first guess of the slopes
+         zwx(:,:,jpk) = 0.e0   ;   zwy(:,:,jpk) = 0.e0        ! bottom values
+         ! interior values
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1      
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )
+                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+           END DO
+         END DO
+         !
+         CALL lbc_lnk( zwx, 'U', -1. )                        ! lateral boundary conditions on zwx, zwy   (changed sign)
+         CALL lbc_lnk( zwy, 'V', -1. )
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,jpk) = 0.e0   ;   zslpy(:,:,jpk) = 0.e0    ! bottom values
+         DO jk = 1, jpkm1                                     ! interior values
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) )
+                  zslpy(ji,jj,jk) =                    ( zwy(ji,jj,jk) + zwy(ji  ,jj-1,jk) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwy(ji,jj,jk) * zwy(ji  ,jj-1,jk) ) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1                                     ! Slopes limitation
+            DO jj = 2, jpj
+               DO ji = fs_2, jpi   ! vector opt.
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   &
+                     &                                                 2.*ABS( zwx  (ji  ,jj,jk) ) )
+                  zslpy(ji,jj,jk) = SIGN( 1., zslpy(ji,jj,jk) ) * MIN(    ABS( zslpy(ji,jj  ,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj-1,jk) ),   &
+                     &                                                 2.*ABS( zwy  (ji,jj  ,jk) ) )
+               END DO
+           END DO
+         END DO             ! interior values
+
+        !                                             !-- MUSCL horizontal advective fluxes
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! MUSCL fluxes
+                  z0u = SIGN( 0.5, pun(ji,jj,jk) )
+                  zalpha = 0.5 - z0u
+                  zu  = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) )
+                  zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)
+                  zzwy = ptb(ji  ,jj,jk,jn) + zu * zslpx(ji  ,jj,jk)
+                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+                  !
+                  z0v = SIGN( 0.5, pvn(ji,jj,jk) )
+                  zalpha = 0.5 - z0v
+                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) )
+                  zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)
+                  zzwy = ptb(ji,jj  ,jk,jn) + zv * zslpy(ji,jj  ,jk)
+                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+
+         !!  centered scheme at lateral b.C. if off-shore velocity
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( umask(ji,jj,jk) == 0. ) THEN
+                     IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN
+                        zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk,jn) + ptn(ji+2,jj,jk,jn) )
+                     ENDIF
+                     IF( pun(ji-1,jj,jk) < 0. ) THEN
+                        zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+                  IF( vmask(ji,jj,jk) == 0. ) THEN
+                     IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN
+                        zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk,jn) + ptn(ji,jj+2,jk,jn) )
+                     ENDIF
+                     IF( pvn(ji,jj-1,jk) < 0. ) THEN
+                        zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )   ! lateral boundary condition (changed sign)
+
+         ! Tracer flux divergence at t-point added to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                  &               + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+           END DO
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptb(:,:,:,jn) )
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptb(:,:,:,jn) )
+         END IF
+
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! II. Vertical advective fluxes
+         ! -----------------------------
+         !                                             !-- first guess of the slopes
+         zwx (:,:, 1 ) = 0.e0    ;    zwx (:,:,jpk) = 0.e0    ! surface & bottom boundary conditions
+         DO jk = 2, jpkm1                                     ! interior values
+            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) )
+         END DO
+
+         !                                             !-- Slopes of tracer
+         zslpx(:,:,1) = 0.e0                                  ! surface values
+         DO jk = 2, jpkm1                                     ! interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )   &
+                     &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) )
+               END DO
+            END DO
+         END DO
+         !                                             !-- Slopes limitation
+         DO jk = 2, jpkm1                                     ! interior values
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   &
+                     &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  )
+               END DO
+            END DO
+         END DO
+         !                                             !-- vertical advective flux
+         !                                                    ! surface values  (bottom already set to zero)
+         IF( lk_vvl ) THEN    ;   zwx(:,:, 1 ) = 0.e0                      !  variable volume
+         ELSE                 ;   zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface
+         ENDIF
+         !
+         DO jk = 1, jpkm1                                     ! interior values
+            zdt  = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) )
+                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) )
+                  zalpha = 0.5 + z0w
+                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr
+                  zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)
+                  zzwy = ptb(ji,jj,jk  ,jn) + zw * zslpx(ji,jj,jk  )
+                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 2, jpkm1        ! centered near the bottom
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  IF( tmask(ji,jj,jk+1) == 0. ) THEN
+                     IF( pwn(ji,jj,jk) > 0. ) THEN
+                        zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 
+                     ENDIF
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1        ! Compute & add the vertical advective trend
+            DO jj = 2, jpjm1      
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! vertical advective trends 
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                       ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zslpx, zslpy )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_muscl2')
+      !
+   END SUBROUTINE tra_adv_muscl2
+
+   !!======================================================================
+END MODULE traadv_muscl2
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90	(revision 3437)
@@ -0,0 +1,484 @@
+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 trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean tracers trends 
+   USE trabbl          ! advective term in the BBL
+   USE lib_mpp         ! distribued memory computing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE dynspg_oce      ! surface pressure gradient variables
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_qck   ! routine called by step.F90
+
+   LOGICAL  :: l_trd           ! flag to compute trends
+   REAL(wp) :: r1_6 = 1./ 6.   ! 1/6 ratio
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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
+      !!             - save the trends 
+      !!
+      !! ** 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), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !!----------------------------------------------------------------------
+
+      !
+      IF( 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,*)
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+
+      ! I. The 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 ) 
+
+      ! II. The 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   )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx => ua       ! ua used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfc, zfd
+      !----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zfu, zfc, zfd )
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         zfu(:,:,:) = 0.0     ;   zfc(:,:,:) = 0.0  
+         zfd(:,:,:) = 0.0     ;   zwx(:,:,:) = 0.0     
+         !                                                  
+         DO jk = 1, jpkm1                                
+            !                                             
+            !--- Computation of the ustream and downstream value of the tracer and the mask
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! Upstream in the x-direction for the tracer
+                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)
+                  ! Downstream in the x-direction for the tracer
+                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )   ! Lateral boundary conditions 
+         
+         !
+         ! Horizontal advective fluxes
+         ! ---------------------------
+         !
+         DO jk = 1, jpkm1                             
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.         
+                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T 
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1  
+            zdt =  p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO 
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )   ;   CALL lbc_lnk( zwx(:,:,:), 'T', 1. )
+
+         !--- QUICKEST scheme
+         CALL quickest( zfu, zfd, zfc, zwx )
+         !
+         ! Mask at the T-points in the x-direction (mask=0 or mask=1)
+         DO jk = 1, jpkm1  
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.               
+                  zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2.
+               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 = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) )
+                  !--- add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zfu, zfc, zfd )
+      !
+   END SUBROUTINE tra_adv_qck_i
+
+
+   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                &
+      &                                        ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwy => ua       ! ua used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt       ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  :: ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) :: ztra, zbtr, zdir, zdx, zdt, zmsk   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zfu, zfc, zfd
+      !----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, 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  
+            zdt =  p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0 
+                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk)
+                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * zdt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction)
+                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T
+                  zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T
+               END DO
+            END DO
+         END DO
+
+         !--- Lateral boundary conditions 
+         CALL lbc_lnk( zfu(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zfd(:,:,:), 'T', 1. )
+         CALL lbc_lnk( zfc(:,:,:), 'T', 1. )      ;     CALL lbc_lnk( zwy(:,:,:), 'T', 1. )
+
+         !--- QUICKEST scheme
+         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 = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective trends
+                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) )
+                  !--- add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zfu, zfc, zfd )
+      !
+   END SUBROUTINE tra_adv_qck_j
+
+
+   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           &
+     &                                    ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!
+      !!----------------------------------------------------------------------
+      USE oce, ONLY:   zwz => ua   ! ua used as workspace
+      !
+      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index
+      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zbtr , ztra      ! local scalars
+      !!----------------------------------------------------------------------
+
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         zwz(:,:,jpk) = 0.e0             ! Bottom value : flux set to zero
+         !
+         !                                 ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                      ! Variable volume : flux set to zero
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)   ! Constant volume : advective flux through the surface
+         ENDIF
+         !
+         DO jk = 2, jpkm1                  ! Interior point: second order centered tracer flux at w-point
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) )
+               END DO
+            END DO
+         END DO
+         !
+         DO jk = 1, jpkm1          !==  Tracer flux divergence added to the general trend  ==!
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends 
+                  ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !                                 ! Save the vertical advective trends for diagnostic
+         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) )
+         !
+      END DO
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90	(revision 3437)
@@ -0,0 +1,365 @@
+MODULE traadv_tvd
+   !!==============================================================================
+   !!                       ***  MODULE  traadv_tvd  ***
+   !! Ocean  tracers:  horizontal & vertical advective trend
+   !!==============================================================================
+   !! History :  OPA  !  1995-12  (L. Mortier)  Original code
+   !!                 !  2000-01  (H. Loukos)  adapted to ORCA 
+   !!                 !  2000-10  (MA Foujols E.Kestenare)  include file not routine
+   !!                 !  2000-12  (E. Kestenare M. Levy)  fix bug in trtrd indexes
+   !!                 !  2001-07  (E. Durand G. Madec)  adaptation to ORCA config
+   !!            8.5  !  2002-06  (G. Madec)  F90: Free form and module
+   !!    NEMO    1.0  !  2004-01  (A. de Miranda, G. Madec, J.M. Molines ): advective bbl
+   !!            2.0  !  2008-04  (S. Cravatte) add the i-, j- & k- trends computation
+   !!             -   !  2009-11  (V. Garnier) Surface pressure gradient organization
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA + switch from velocity to transport
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_adv_tvd  : update the tracer trend with the horizontal
+   !!                  and vertical advection trends using a TVD scheme
+   !!   nonosc       : compute monotonic tracer fluxes by a nonoscillatory
+   !!                  algorithm 
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! tracers trends
+   USE trdtra          ! tracers trends
+   USE in_out_manager  ! I/O manager
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE lib_mpp         ! MPP library
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_tvd    ! routine called by step.F90
+
+   LOGICAL ::   l_trd   ! flag to compute trends
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_tvd ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_adv_tvd  ***
+      !! 
+      !! **  Purpose :   Compute the now trend due to total advection of 
+      !!       tracers and add it to the general trend of tracer equations
+      !!
+      !! **  Method  :   TVD scheme, i.e. 2nd order centered scheme with
+      !!       corrected flux (monotonic correction)
+      !!       note: - this advection scheme needs a leap-frog time scheme
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!             - save the trends 
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx => ua        , zwy => va          ! (ua,va) used as workspace
+      !
+      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(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   z2dtt, zbtr, ztra        ! local scalar
+      REAL(wp) ::   zfp_ui, zfp_vj, zfp_wk   !   -      -
+      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_adv_tvd')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz )
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+      !
+      IF( l_trd )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0
+      ENDIF
+      !
+      zwi(:,:,:) = 0.e0
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zwx(:,:,jpk) = 0.e0    ;    zwz(:,:,jpk) = 0.e0
+         zwy(:,:,jpk) = 0.e0    ;    zwi(:,:,jpk) = 0.e0
+
+         ! 2. upstream advection with initial mass fluxes & intermediate update
+         ! --------------------------------------------------------------------
+         ! upstream tracer flux in the i and j direction
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream scheme
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) )
+                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! upstream tracer flux in the k direction
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   zwz(:,:, 1 ) = 0.e0                         ! volume variable
+         ELSE                ;   zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn)   ! linear free surface 
+         ENDIF
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) )
+               END DO
+            END DO
+         END DO
+
+         ! total advective trend
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total intermediate advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! update and guess with monotonic sheme
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn)         + ztra
+                  zwi(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !                             ! Lateral boundary conditions on zwi  (unchanged sign)
+         CALL lbc_lnk( zwi, 'T', 1. )  
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ! store intermediate advective trends
+            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:)
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+
+         ! 3. antidiffusive flux : high order minus low order
+         ! --------------------------------------------------
+         ! antidiffusive flux on i and j
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)
+                  zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      
+         ! antidiffusive flux on k
+         zwz(:,:,1) = 0.e0         ! Surface value
+         !
+         DO jk = 2, jpkm1          ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         CALL lbc_lnk( zwx, 'U', -1. )   ;   CALL lbc_lnk( zwy, 'V', -1. )         ! Lateral bondary conditions
+         CALL lbc_lnk( zwz, 'W',  1. )
+
+         ! 4. monotonicity algorithm
+         ! -------------------------
+         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )
+
+
+         ! 5. final trend with corrected fluxes
+         ! ------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.  
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! total advective trends
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   &
+                     &             + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) )
+                  ! add them to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd )  THEN 
+            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed
+            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed
+            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed
+            
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, ztrdx, pun, ptn(:,:,:,jn) )   
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) )  
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:)
+           IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:)
+         ENDIF
+         !
+      END DO
+      !
+                   CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz )
+      IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_tvd')
+      !
+   END SUBROUTINE tra_adv_tvd
+
+
+   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), DIMENSION(jpk)         , INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field
+      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      INTEGER ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! 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(:,:,jpk) = 0._wp   ;   zbetdo(:,:,jpk) = 0._wp
+
+
+      ! Search local extrema
+      ! --------------------
+      ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land
+      zbup = MAX( pbef * tmask - zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask - zbig * ( 1.e0 - tmask )  )
+      zbdo = MIN( pbef * tmask + zbig * ( 1.e0 - tmask ),   &
+         &        paft * tmask + zbig * ( 1.e0 - tmask )  )
+
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         z2dtt = p2dt(jk)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+
+               ! search maximum in neighbourhood
+               zup = MAX(  zbup(ji  ,jj  ,jk  ),   &
+                  &        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 = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               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.e0, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) )
+               zbu = MIN( 1.e0, 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.e0 - zcu) * zbu )
+
+               zav = MIN( 1.e0, zbetdo(ji,jj,jk), zbetup(ji,jj+1,jk) )
+               zbv = MIN( 1.e0, 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.e0 - 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.e0 - 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
+
+   !!======================================================================
+END MODULE traadv_tvd
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90	(revision 3437)
@@ -0,0 +1,385 @@
+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 trdmod_oce         ! ocean space and time domain
+   USE trdtra
+   USE lib_mpp
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_adv_ubs   ! routine called by traadv module
+
+   LOGICAL :: l_trd  ! flag to compute trends or not
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_adv_ubs ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      &
+      &                                       ptb, ptn, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                  ***  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 upstream biased third (UBS) is order scheme 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 :
+      !!                !  e1u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0
+      !!          zwx = !  or 
+      !!                !  e1u 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 TVD scheme, as
+      !!      the UBS have been found to be too diffusive.
+      !!
+      !! ** Action : - update (pta) with the now advective tracer trends
+      !!
+      !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. 
+      !!             Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zwx  => ua       , zwy  => va         ! (ua,va) used as workspace
+      !
+      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(        jpk     ), INTENT(in   ) ::   p2dt            ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   ztra, zbtr, zcoef, z2dtt                       ! 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,*) '~~~~~~~~~~~~'
+         !
+         l_trd = .FALSE.
+         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE.
+      ENDIF
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! 1. Bottom value : flux set to zero
+         ! ----------------------------------
+         zltu(:,:,jpk) = 0.e0       ;      zltv(:,:,jpk) = 0.e0
+         !                                              
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                   
+            !  Laplacian
+            DO jj = 1, jpjm1            ! First derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
+                  zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+            DO jj = 2, jpjm1            ! Second derivative (divergence)
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef = 1. / ( 6. * fse3t(ji,jj,jk) )
+                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef
+                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef
+               END DO
+            END DO
+            !                                    
+         END DO                                           ! End of slab         
+         CALL lbc_lnk( zltu, 'T', 1. )   ;    CALL lbc_lnk( zltv, 'T', 1. )   ! Lateral boundary cond. (unchanged sgn)
+
+         !    
+         !  Horizontal advective fluxes               
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ! upstream transport
+                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )
+                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) )
+                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )
+                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )
+                  ! centered scheme
+                  zcenut = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) )
+                  zcenvt = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) )
+                  ! UBS scheme
+                  zwx(ji,jj,jk) =  zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) 
+                  zwy(ji,jj,jk) =  zcenvt - zfp_vj * zltv(ji,jj,jk) - zfm_vj * zltv(ji,jj+1,jk) 
+               END DO
+            END DO
+         END DO                                           ! End of slab         
+
+         zltu(:,:,:) = pta(:,:,:,jn)      ! store pta trends
+
+         ! Horizontal advective trends
+         DO jk = 1, jpkm1
+            !  Tracer flux divergence at t-point added to the general trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal advective
+                  ztra = - zbtr * (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk)   &
+                     &             + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             
+         END DO                                           !   End of slab
+
+         ! Horizontal trend used in tra_adv_ztvd subroutine
+         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)
+
+         ! 3. Save the horizontal advective trends for diagnostic
+         ! ------------------------------------------------------
+         !                                 ! trend diagnostics (contribution of upstream fluxes)
+         IF( l_trd ) THEN
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) )
+             CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) )
+         END IF
+         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+            IF( jn == jp_tem )  htr_adv(:) = ptr_vj( zwy(:,:,:) )
+            IF( jn == jp_sal )  str_adv(:) = ptr_vj( zwy(:,:,:) )
+         ENDIF
+         
+         ! TVD scheme for the vertical direction  
+         ! ----------------------
+         IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag.
+
+         !  Bottom value : flux set to zero
+         ztw(:,:,jpk) = 0.e0   ;   zti(:,:,jpk) = 0.e0
+
+         ! Surface value
+         IF( lk_vvl ) THEN   ;   ztw(:,:,1) = 0.e0                      ! variable volume : flux set to zero
+         ELSE                ;   ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn)   ! free constant surface 
+         ENDIF
+         !  upstream advection with initial mass fluxes & intermediate update
+         ! -------------------------------------------------------------------
+         ! Interior value
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                   zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )
+                   zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )
+                   ztw(ji,jj,jk) = 0.5 * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  )
+               END DO
+            END DO
+         END DO 
+         ! update and guess with monotonic sheme
+         DO jk = 1, jpkm1
+            z2dtt = p2dt(jk)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr
+                  pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak 
+                  zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( zti, 'T', 1. )      ! Lateral boundary conditions on zti, zsi   (unchanged sign)
+
+         !  antidiffusive flux : high order minus low order
+         ztw(:,:,1) = 0.e0       ! Surface value
+         DO jk = 2, jpkm1        ! Interior value
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+         CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm
+
+         !  final trend with corrected fluxes
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.   
+                  zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! k- vertical advective trends  
+                  ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) )
+                  ! added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+
+         !  Save the final vertical advective trends
+         IF( l_trd )  THEN                        ! vertical advective trend diagnostics
+            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w])
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     z_hdivn = (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  ) * zbtr
+                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn
+                  END DO
+               END DO
+            END DO
+            CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zltv )
+         ENDIF
+         !
+      ENDDO
+      !
+      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   ), DIMENSION(jpk)          ::   p2dt   ! vertical profile of tracer time-step
+      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field
+      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field
+      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ikm1         ! local integer
+      REAL(wp) ::   zpos, zneg, zbt, za, zb, zc, zbig, zrtrn, z2dtt   ! 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(:,:,:) )
+      ! search maximum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetup(ji,jj,jk) = MAX(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+      ! large positive value (+zbig) inside land
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:) + zbig * ( 1.e0 - tmask(:,:,:) )
+      ! search minimum in neighbourhood
+      DO jk = 1, jpkm1
+         ikm1 = MAX(jk-1,1)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbetdo(ji,jj,jk) = MIN(  pbef(ji  ,jj  ,jk  ), paft(ji  ,jj  ,jk  ),   &
+                  &                     pbef(ji  ,jj  ,ikm1), pbef(ji  ,jj  ,jk+1),   &
+                  &                     paft(ji  ,jj  ,ikm1), paft(ji  ,jj  ,jk+1)  )
+            END DO
+         END DO
+      END DO
+
+      ! restore masked values to zero
+      pbef(:,:,:) = pbef(:,:,:) * tmask(:,:,:)
+      paft(:,:,:) = paft(:,:,:) * tmask(:,:,:)
+
+
+      ! 2. Positive and negative part of fluxes and beta terms
+      ! ------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         z2dtt = p2dt(jk)
+         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 = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) / z2dtt
+               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt
+               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
+            END DO
+         END DO
+      END DO
+      ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90	(revision 3437)
@@ -0,0 +1,179 @@
+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 trdmod_oce      ! trends: ocean variables 
+   USE trdtra          ! trends: active tracers 
+   USE in_out_manager  ! I/O manager
+   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     = .FALSE.      !: Geothermal heat flux flag
+   INTEGER         ::   nn_geoflx     = 1            !  Geothermal flux (=1:constant flux, =2:read in file )
+   REAL(wp)        ::   rn_geoflx_cst = 86.4e-3_wp   !  Constant value of geothermal heat flux
+
+   REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
+ 
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 (ta) with the trend of
+      !!                the ocean bottom boundary condition
+      !!
+      !! 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, ik    ! dummy loop indices
+      REAL(wp) ::   zqgh_trd      ! geothermal heat flux trend
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_bbc')
+      !
+      IF( l_trdtra )   THEN         ! Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt )
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+      ENDIF
+      !
+      !                             !  Add the geothermal heat flux trend on temperature
+#if defined key_vectopt_loop
+      DO jj = 1, 1
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+#else
+      DO jj = 2, jpjm1
+         DO ji = 2, jpim1
+#endif
+            ik = mbkt(ji,jj)
+            zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
+            tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd
+         END DO
+      END DO
+      !
+      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
+         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
+      !!----------------------------------------------------------------------
+      USE iom
+      !!
+      INTEGER  ::   ji, jj              ! dummy loop indices
+      INTEGER  ::   inum                ! temporary logical unit
+      !!
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )                 ! Read Namelist nambbc : bottom momentum boundary condition
+      READ  ( numnam, 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(:,:) = ro0cpr * rn_geoflx_cst
+            !
+         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
+            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
+            CALL iom_open ( 'geothermal_heating.nc', inum )
+            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
+            CALL iom_close( inum )
+            qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            !
+         CASE DEFAULT
+            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx
+            CALL ctl_stop( ctmp1 )
+            !
+         END SELECT
+         !
+      ELSE
+         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux'
+      ENDIF
+      !
+   END SUBROUTINE tra_bbc_init
+
+   !!======================================================================
+END MODULE trabbc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90	(revision 3437)
@@ -0,0 +1,676 @@
+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
+   !!----------------------------------------------------------------------
+#if   defined key_trabbl   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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 trdmod_oce     ! trends: ocean variables
+   USE trdtra         ! trends: active tracers
+   USE iom            ! IOM server               
+   USE in_out_manager ! I/O manager
+   USE lbclnk         ! ocean lateral boundary conditions
+   USE prtctl         ! Print control
+   USE wrk_nemo       ! Memory Allocation
+   USE timing         ! Timing
+
+
+   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 = 0         !: =1   : diffusive bbl or not (=0)
+   INTEGER , PUBLIC ::   nn_bbl_adv = 0         !: =1/2 : advective bbl or not (=0)
+   !                                            !  =1 : advective bbl using the bottom ocean velocity
+   !                                            !  =2 :     -      -  using utr_bbl proportional to grad(rho)
+   REAL(wp), PUBLIC ::   rn_ahtbbl  = 1.e3_wp   !: along slope bbl diffusive coefficient [m2/s]
+   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s]
+
+   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(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mgrhu    , mgrhv       ! = +/-1, sign of grad(H) in u-(v-)direction
+   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(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   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) , r1_e1e2t(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 ta and sa 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                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbl, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbl, ztrds )
+         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 (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
+         !                                                ! ===========
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = 1, jpij
+#else
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+#endif
+               ik = mbkt(ji,jj)                        ! bottom T-level index
+               zptb(ji,jj) = ptb(ji,jj,ik,jn)              ! bottom before T and S
+            END DO
+         END DO
+         !                                                ! Compute the trend
+#  if defined key_vectopt_loop
+         DO jj = 1, 1   ! vector opt. (forced unrolling)
+            DO ji = jpi+1, jpij-jpi-1
+#  else
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+#  endif
+               ik = mbkt(ji,jj)                            ! bottom T-level index
+               zbtr = r1_e1e2t(ji,jj)  / fse3t(ji,jj,ik)
+               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         &
+                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   &
+                  &                   - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )   &
+                  &                   + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )   &
+                  &                   - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )   ) * zbtr
+            END DO
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      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
+         !                                                       ! ===========         
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1            ! CAUTION start from i=1 to update i=2 when cyclic east-west
+# endif
+               IF( utr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero i-direction bbl advection
+                  ! down-slope i/k-indices (deep)      &   up-slope i/k indices (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )   ;   iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                 ;   ikus = mbku(ji,jj)
+                  zu_bbl = ABS( utr_bbl(ji,jj) )
+                  !
+                  !                                               ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus)
+                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr
+                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra
+                  !                   
+                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk)
+                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr
+                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra
+                  END DO
+                  ! 
+                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud)
+                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr
+                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra
+               ENDIF
+               !
+               IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN            ! non-zero j-direction bbl advection
+                  ! down-slope j/k-indices (deep)        &   up-slope j/k indices (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )     ;   ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                   ;   ikvs = mbkv(ji,jj)
+                  zv_bbl = ABS( vtr_bbl(ji,jj) )
+                  ! 
+                  ! up  -slope T-point (shelf bottom point)
+                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs)
+                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr
+                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra
+                  !                   
+                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column)
+                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk)
+                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr
+                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra
+                  END DO
+                  !                                               ! down-slope T-point (deep bottom point)
+                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd)
+                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr
+                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra
+               ENDIF
+            END DO
+            !
+         END DO
+         !                                                  ! ===========
+      END DO                                                ! end tracer
+      !                                                     ! ===========
+      !
+      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 , ijs , ijd     !   -       -
+      INTEGER  ::   ikus, ikud, ikvs, ikvd    !   -       -
+      REAL(wp) ::   zsign, zsigna, zgbbl      ! local scalars
+      REAL(wp) ::   zgdrho, zt, zs, zh        !   -      -
+      !!
+      REAL(wp) ::   fsalbt, fsbeta, pft, pfs, pfh   ! statement function
+      REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb, ztb, zsb, zdep
+      !!----------------------- zv_bbl-----------------------------------------------
+      ! ratio alpha/beta = fsalbt : ratio of thermal over saline expension coefficients
+      ! ================            pft :  potential temperature in degrees celcius
+      !                             pfs :  salinity anomaly (s-35) in psu
+      !                             pfh :  depth in meters
+      ! nn_eos = 0  (Jackett and McDougall 1994 formulation)
+      fsalbt( pft, pfs, pfh ) =                                              &   ! alpha/beta
+         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    &
+                                   - 0.203814e-03 ) * pft                    &
+                                   + 0.170907e-01 ) * pft                    &
+                                   + 0.665157e-01                            &
+         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   &
+         +  ( ( - 0.302285e-13 * pfh                                         &
+                - 0.251520e-11 * pfs                                         &
+                + 0.512857e-12 * pft * pft          ) * pfh                  &
+                                     - 0.164759e-06   * pfs                  &
+             +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  &
+                                     + 0.380374e-04 ) * pfh
+      fsbeta( pft, pfs, pfh ) =                                              &   ! beta
+         ( ( -0.415613e-09 * pft + 0.555579e-07 ) * pft                      &
+                                 - 0.301985e-05 ) * pft                      &
+                                 + 0.785567e-03                              &
+         + (     0.515032e-08 * pfs                                          &
+               + 0.788212e-08 * pft - 0.356603e-06 ) * pfs                   &
+               +(  (   0.121551e-17 * pfh                                    &
+                     - 0.602281e-15 * pfs                                    &
+                     - 0.175379e-14 * pft + 0.176621e-12 ) * pfh             &
+                                          + 0.408195e-10   * pfs             &
+                 + ( - 0.213127e-11 * pft + 0.192867e-09 ) * pft             &
+                                          - 0.121555e-07 ) * pfh
+      !!----------------------------------------------------------------------
+      
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'bbl')
+      !
+      CALL wrk_alloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+     
+      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 temperature, salinity, velocity and depth
+#if defined key_vectopt_loop
+      DO jj = 1, 1   ! vector opt. (forced unrolling)
+         DO ji = 1, jpij
+#else
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+#endif
+            ik = mbkt(ji,jj)                        ! bottom T-level index
+            ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1)      ! bottom before T and S
+            zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1)
+            zdep(ji,jj) = fsdept_0(ji,jj,ik)        ! bottom T-level reference depth
+            !
+            zub(ji,jj) = un(ji,jj,mbku(ji,jj))      ! bottom velocity
+            zvb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
+         END DO
+      END DO
+      
+      !                                   !-------------------!
+      IF( nn_bbl_ldf == 1 ) THEN          !   diffusive bbl   !
+         !                                !-------------------!
+         DO jj = 1, jpjm1                      ! (criteria for non zero flux: grad(rho).grad(h) < 0 )
+            DO ji = 1, jpim1              
+               !                                                ! i-direction 
+               zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )  ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+               !                                                         ! masked bbl i-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+               !                                                     
+               zsign          = SIGN(  0.5, - zgdrho * REAL( mgrhu(ji,jj) )  )    ! sign of ( i-gradient * i-slope )
+               ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj)                  ! masked diffusive flux coeff.
+               !
+               !                                                ! j-direction 
+               zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                ! T, S anomalie, and depth
+               zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+               !                                                         ! masked bbl j-gradient of density
+               zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &
+                  &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+               !                                                    
+               zsign          = SIGN(  0.5, -zgdrho * REAL( mgrhv(ji,jj) )  )     ! sign of ( j-gradient * j-slope )
+               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
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  !                                                           ! masked bbl i-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji+1,jj) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji+1,jj) - zsb(ji,jj) )  ) * umask(ji,jj,1)
+                  !                                                         
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhu(ji,jj) )  )    ! sign of i-gradient * i-slope
+                  zsigna= SIGN(  0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj)
+                  !
+                  !                                               ! j-direction
+                  zt = 0.5 * ( ztb (ji,jj+1) + ztb (ji,jj) )                  ! T, S anomalie, and depth
+                  zs = 0.5 * ( zsb (ji,jj+1) + zsb (ji,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )
+                  !                                                           ! masked bbl j-gradient of density
+                  zgdrho = (  fsalbt( zt, zs, zh ) * ( ztb(ji,jj+1) - ztb(ji,jj) )    &  
+                     &                             - ( zsb(ji,jj+1) - zsb(ji,jj) )  ) * vmask(ji,jj,1)
+                  zsign = SIGN(  0.5, - zgdrho   * REAL( mgrhv(ji,jj) )  )    ! sign of j-gradient * j-slope
+                  zsigna= SIGN(  0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) )  )    ! sign of u * i-slope
+                  !
+                  !                                                           ! bbl velocity
+                  vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj)
+               END DO
+            END DO
+            !
+         CASE( 2 )                                 != bbl velocity = F( delta rho )
+            zgbbl = grav * rn_gambbl
+            DO jj = 1, jpjm1                            ! criteria: rho_up > rho_down
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  !                                         ! i-direction
+                  ! down-slope T-point i/k-index (deep)  &   up-slope T-point i/k-index (shelf)
+                  iid  = ji + MAX( 0, mgrhu(ji,jj) )     ;    iis  = ji + 1 - MAX( 0, mgrhu(ji,jj) )
+                  ikud = mbku_d(ji,jj)                   ;    ikus = mbku(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji+1,jj) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji+1,jj) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(iid,jj) - ztb(iis,jj) )    &  
+                     &                             - ( zsb(iid,jj) - zsb(iis,jj) )  ) * umask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) )
+                  !
+                  !                                         ! j-direction
+                  !  down-slope T-point j/k-index (deep)  &   of the up  -slope T-point j/k-index (shelf)
+                  ijd  = jj + MAX( 0, mgrhv(ji,jj) )      ;    ijs  = jj + 1 - MAX( 0, mgrhv(ji,jj) )
+                  ikvd = mbkv_d(ji,jj)                    ;    ikvs = mbkv(ji,jj)
+                  !
+                  !                                             ! mid-depth density anomalie (up-slope minus down-slope)
+                  zt = 0.5 * ( ztb (ji,jj) + ztb (ji,jj+1) )           ! mid slope depth of T, S, and depth
+                  zs = 0.5 * ( zsb (ji,jj) + zsb (ji,jj+1) ) - 35.0
+                  zh = 0.5 * ( zdep(ji,jj) + zdep(ji,jj+1) )
+                  zgdrho =    fsbeta( zt, zs, zh )                                    &
+                     &   * (  fsalbt( zt, zs, zh ) * ( ztb(ji,ijd) - ztb(ji,ijs) )    &  
+                     &                             - ( zsb(ji,ijd) - zsb(ji,ijs) )  ) * vmask(ji,jj,1)
+                  zgdrho = MAX( 0.e0, zgdrho )                         ! only if shelf is denser than deep
+                  !
+                  !                                             ! bbl transport (down-slope direction)
+                  vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) )
+               END DO
+            END DO
+         END SELECT
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zub, zvb, ztb, zsb, zdep ) 
+      !
+      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   ! temporary integer
+      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')
+      !
+      CALL wrk_alloc( jpi, jpj, zmbk ) 
+      !
+
+      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme
+      READ   ( numnam, nambbl )
+      !
+      l_bbl = .TRUE.                 !* flag to compute bbl coef and transport
+      !
+      IF(lwp) THEN                   !* Parameter control and print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '       Namelist nambbl : set bbl parameters'
+         WRITE(numout,*) '          diffusive bbl (=1)   or not (=0)    nn_bbl_ldf = ', nn_bbl_ldf
+         WRITE(numout,*) '          advective bbl (=1/2) or not (=0)    nn_bbl_adv = ', nn_bbl_adv
+         WRITE(numout,*) '          diffusive bbl coefficient           rn_ahtbbl  = ', rn_ahtbbl, ' m2/s'
+         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s'
+      ENDIF
+
+      !                              ! 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)'
+
+      IF( nn_eos /= 0 )   CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' )
+
+
+      !                             !* inverse of surface of T-cells
+      r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) )
+      
+      !                             !* vertical index of  "deep" bottom u- and v-points
+      DO jj = 1, jpjm1                    ! (the "shelf" bottom k-indices are mbku and mbkv)
+         DO ji = 1, jpim1
+            mbku_d(ji,jj) = MAX(  mbkt(ji+1,jj  ) , mbkt(ji,jj)  )   ! >= 1 as mbkt=1 over land
+            mbkv_d(ji,jj) = MAX(  mbkt(ji  ,jj+1) , mbkt(ji,jj)  )
+         END DO
+      END DO
+      ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 
+      zmbk(:,:) = REAL( mbku_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'U',1.)   ;   mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+      zmbk(:,:) = REAL( mbkv_d(:,:), wp )   ;   CALL lbc_lnk(zmbk,'V',1.)   ;   mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 )
+
+                                        !* sign of grad(H) at u- and v-points
+      mgrhu(jpi,:) = 0.    ;    mgrhu(:,jpj) = 0.   ;    mgrhv(jpi,:) = 0.    ;    mgrhv(:,jpj) = 0.
+      DO jj = 1, jpjm1                
+         DO ji = 1, jpim1
+            mgrhu(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+            mgrhv(ji,jj) = INT(  SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) )  )
+         END DO
+      END 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( fse3u_0(ji,jj,mbkt(ji+1,jj  )), fse3u_0(ji,jj,mbkt(ji,jj)) )  
+            e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji  ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )  
+         END DO 
+      END DO
+      CALL lbc_lnk( e3u_bbl_0, 'U', 1. )   ;   CALL lbc_lnk( e3v_bbl_0, 'V', 1. )      ! lateral boundary conditions
+
+      !                             !* masked diffusive flux coefficients 
+      ahu_bbl_0(:,:) = rn_ahtbbl * e2u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)  * umask(:,:,1)
+      ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)  * vmask(:,:,1)
+
+
+      IF( cp_cfg == "orca" ) THEN   !* ORCA configuration : regional enhancement of ah_bbl
+         !
+         SELECT CASE ( jp_cfg )
+         CASE ( 2 )                          ! ORCA_R2
+            ij0 = 102   ;   ij1 = 102              ! Gibraltar enhancement of BBL
+            ii0 = 139   ;   ii1 = 140  
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            !
+            ij0 =  88   ;   ij1 =  88              ! Red Sea enhancement of BBL
+            ii0 = 161   ;   ii1 = 162
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            !
+         CASE ( 4 )                          ! ORCA_R4
+            ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL
+            ii0 =  70   ;   ii1 =  71  
+            ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))
+         END SELECT
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zmbk ) 
+      !
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90	(revision 3437)
@@ -0,0 +1,776 @@
+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
+   !!                 ! 1996-01  (G. Madec)  statement function for e3
+   !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab
+   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version
+   !!            7.0  ! 2001-02  (M. Imbard)  cofdis, 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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_dmp_alloc : allocate tradmp arrays
+   !!   tra_dmp       : update the tracer trend with the internal damping
+   !!   tra_dmp_init  : initialization, namlist read, parameters control
+   !!   dtacof_zoom   : restoring coefficient for zoom domain
+   !!   dtacof        : restoring coefficient for global domain
+   !!   cofdis        : compute the distance to the coastline
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean: variables
+   USE dom_oce        ! ocean: domain variables
+   USE trdmod_oce     ! ocean: trend variables
+   USE trdtra         ! active tracers: trends
+   USE zdf_oce        ! ocean: vertical physics
+   USE phycst         ! physical constants
+   USE 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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_dmp      ! routine called by step.F90
+   PUBLIC   tra_dmp_init ! routine called by opa.F90
+   PUBLIC   dtacof       ! routine called by in both tradmp.F90 and trcdmp.F90
+   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90
+
+   !                                !!* Namelist namtra_dmp : T & S newtonian damping *
+   LOGICAL, PUBLIC ::   ln_tradmp = .TRUE.    !: internal damping flag
+   INTEGER         ::   nn_hdmp   =   -1      ! = 0/-1/'latitude' for damping over T and S
+   INTEGER         ::   nn_zdmp   =    0      ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp)        ::   rn_surf   =   50._wp  ! surface time scale for internal damping        [days]
+   REAL(wp)        ::   rn_bot    =  360._wp  ! bottom time scale for internal damping         [days]
+   REAL(wp)        ::   rn_dep    =  800._wp  ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER         ::   nn_file   =    2      ! = 1 create a damping.coeff NetCDF file 
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION tra_dmp_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION tra_dmp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), 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  : - (ta,sa)   tracer trends updated with the damping trend
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   zta, zsa             ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  zts_dta 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_dmp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, jpts,  zts_dta )
+      !                           !==   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 jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta      
+               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
+                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  ELSE
+                     zta = 0._wp
+                     zsa = 0._wp  
+                  ENDIF
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta
+               END DO
+            END DO
+         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( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) )
+                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) )
+                  ELSE
+                     zta = 0._wp
+                     zsa = 0._wp  
+                  ENDIF
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta
+                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa
+                  strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj)
+                  ttrdmp(ji,jj,jk) = zta
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+      IF( l_trdtra )   THEN       ! trend diagnostic
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_dmp, ttrdmp )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_dmp, strdmp )
+      ENDIF
+      !                           ! Control print
+      IF(ln_ctl)   CALL prt_ctl( tab3d_1=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 nammbf namelist and check the parameters
+      !!----------------------------------------------------------------------
+      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file
+      !!----------------------------------------------------------------------
+
+      REWIND ( numnam )                  ! Read Namelist namtra_dmp : temperature and salinity damping term
+      READ   ( numnam, namtra_dmp )
+      
+      IF( lzoom )   nn_zdmp = 0          ! restoring to climatology at closed north or south boundaries
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter'
+         WRITE(numout,*) '      add a damping termn or not      ln_tradmp = ', ln_tradmp
+         WRITE(numout,*) '      T and S damping option          nn_hdmp   = ', nn_hdmp
+         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(zoom: forced to 0)'
+         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf
+         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot
+         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep
+         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file
+         WRITE(numout,*)
+      ENDIF
+
+      IF( ln_tradmp ) THEN               ! initialization for T-S damping
+         !
+         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' )
+         !
+         SELECT CASE ( nn_hdmp )
+         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
+         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees'
+         CASE DEFAULT
+            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp
+            CALL ctl_stop(ctmp1)
+         END SELECT
+         !
+         SELECT CASE ( nn_zdmp )
+         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column'
+         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)'
+         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer'
+         CASE DEFAULT
+            WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp
+            CALL ctl_stop(ctmp1)
+         END SELECT
+         !
+         IF( .NOT.ln_tsd_tradmp ) THEN
+            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' )
+            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data
+         ENDIF
+         !
+         strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj)
+         ttrdmp(:,:,:) = 0._wp
+         !                          ! Damping coefficients initialization
+         IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto )
+         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto )
+         ENDIF
+         !
+      ENDIF
+      !
+   END SUBROUTINE tra_dmp_init
+
+
+   SUBROUTINE dtacof_zoom( presto )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof_zoom  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient for zoom domain
+      !!
+      !! ** Method  : - set along closed boundary due to zoom a damping over
+      !!                6 points with a max time scale of 5 days.
+      !!              - ORCA arctic/antarctic zoom: set the damping along
+      !!                south/north boundary over a latitude strip.
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
+      REAL(wp), DIMENSION(6)  ::   zfact               ! 1Dworkspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom')
+      !
+
+      zfact(1) =  1._wp
+      zfact(2) =  1._wp
+      zfact(3) = 11._wp / 12._wp
+      zfact(4) =  8._wp / 12._wp
+      zfact(5) =  4._wp / 12._wp
+      zfact(6) =  1._wp / 12._wp
+      zfact(:) = zfact(:) / ( 5._wp * rday )    ! 5 days max restoring time scale
+
+      presto(:,:,:) = 0._wp
+
+      ! damping along the forced closed boundary over 6 grid-points
+      DO jn = 1, 6
+         IF( lzoom_w )   presto( mi0(jn+jpizoom):mi1(jn+jpizoom), : , : )                    = zfact(jn)   ! west  closed
+         IF( lzoom_s )   presto( : , mj0(jn+jpjzoom):mj1(jn+jpjzoom), : )                    = zfact(jn)   ! south closed 
+         IF( lzoom_e )   presto( mi0(jpiglo+jpizoom-1-jn):mi1(jpiglo+jpizoom-1-jn) , : , : ) = zfact(jn)   ! east  closed 
+         IF( lzoom_n )   presto( : , mj0(jpjglo+jpjzoom-1-jn):mj1(jpjglo+jpjzoom-1-jn) , : ) = zfact(jn)   ! north closed
+      END DO
+
+      !                                           ! ====================================================
+      IF( lzoom_arct .AND. lzoom_anta ) THEN      !  ORCA configuration : arctic zoom or antarctic zoom
+         !                                        ! ====================================================
+         IF(lwp) WRITE(numout,*)
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
+         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA Antarctic zoom'
+         IF(lwp) WRITE(numout,*)
+         !
+         !                          ! Initialization : 
+         presto(:,:,:) = 0._wp
+         zlat0 = 10._wp                     ! zlat0 : latitude strip where resto decreases
+         zlat1 = 30._wp                     ! zlat1 : resto = 1 before zlat1
+         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
+         z1_5d = 1._wp / ( 5._wp * rday )   ! z1_5d : 1 / 5days
+
+         DO jk = 2, jpkm1           ! Compute arrays resto ; value for internal damping : 5 days
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlat = ABS( gphit(ji,jj) )
+                  IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                     presto(ji,jj,jk) = 0.5_wp * z1_5d * (  1._wp - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
+                  ELSEIF( zlat < zlat1 ) THEN
+                     presto(ji,jj,jk) = z1_5d
+                  ENDIF
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !                             ! Mask resto array
+      presto(:,:,:) = presto(:,:,:) * tmask(:,:,:)
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'dtacof_zoom')
+      !
+   END SUBROUTINE dtacof_zoom
+
+
+   SUBROUTINE dtacof( kn_hdmp, pn_surf, pn_bot, pn_dep,  &
+      &               kn_file, cdtype , presto           )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dtacof  ***
+      !!
+      !! ** Purpose :   Compute the damping coefficient
+      !!
+      !! ** Method  :   Arrays defining the damping are computed for each grid
+      !!                point for temperature and salinity (resto)
+      !!                Damping depends on distance to coast, depth and latitude
+      !!
+      !! ** Action  : - resto, the damping coeff. for T and S
+      !!----------------------------------------------------------------------
+      USE iom
+      USE ioipsl
+      !!
+      INTEGER                         , INTENT(in   )  ::  kn_hdmp    ! damping option
+      REAL(wp)                        , INTENT(in   )  ::  pn_surf    ! surface time scale (days)
+      REAL(wp)                        , INTENT(in   )  ::  pn_bot     ! bottom time scale (days)
+      REAL(wp)                        , INTENT(in   )  ::  pn_dep     ! depth of transition (meters)
+      INTEGER                         , INTENT(in   )  ::  kn_file    ! save the damping coef on a file or not
+      CHARACTER(len=3)                , INTENT(in   )  ::  cdtype     ! =TRA or TRC (tracer indicator)
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)  ::  presto     ! restoring coeff. (s-1)
+      !
+      INTEGER  ::   ji, jj, jk                  ! dummy loop indices
+      INTEGER  ::   ii0, ii1, ij0, ij1          ! local integers
+      INTEGER  ::   inum0, icot                 !   -       -
+      REAL(wp) ::   zinfl, zlon                 ! local scalars
+      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !   -      -
+      REAL(wp) ::   zsdmp, zbdmp                !   -      -
+      CHARACTER(len=20)                   :: cfile
+      REAL(wp), POINTER, DIMENSION(:    ) :: zhfac 
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmrs 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdct 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('dtacof')
+      !
+      CALL wrk_alloc( jpk, zhfac          )
+      CALL wrk_alloc( jpi, jpj, zmrs      )
+      CALL wrk_alloc( jpi, jpj, jpk, zdct )
+      !                                   ! ====================
+      !                                   !  ORCA configuration : global domain
+      !                                   ! ====================
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '              dtacof : Global domain of ORCA'
+      IF(lwp) WRITE(numout,*) '              ------------------------------'
+      !
+      presto(:,:,:) = 0._wp
+      !
+      IF( kn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  !
+         !                        !-----------------------------------------!
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) '              Damping poleward of ', kn_hdmp, ' deg.'
+         !
+         CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. )
+         !
+         IF( icot > 0 ) THEN          ! distance-to-coast read in file
+            CALL iom_get  ( icot, jpdom_data, 'Tcoast', zdct )
+            CALL iom_close( icot )
+         ELSE                         ! distance-to-coast computed and saved in file (output in zdct)
+            CALL cofdis( zdct )
+         ENDIF
+
+         !                            ! Compute arrays resto 
+         zinfl = 1000.e3_wp                ! distance of influence for damping term
+         zlat0 = 10._wp                    ! latitude strip where resto decreases
+         zlat1 = REAL( kn_hdmp )           ! resto = 0 between -zlat1 and zlat1
+         zlat2 = zlat1 + zlat0             ! resto increases from 0 to 1 between |zlat1| and |zlat2|
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zlat = ABS( gphit(ji,jj) )
+               IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
+                  presto(ji,jj,1) = 0.5_wp * (  1._wp - COS( rpi*(zlat-zlat1)/zlat0 )  )
+               ELSEIF ( zlat > zlat2 ) THEN
+                  presto(ji,jj,1) = 1._wp
+               ENDIF
+            END DO
+         END DO
+
+         IF ( kn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zlat = gphit(ji,jj)
+                  zlon = MOD( glamt(ji,jj), 360._wp )
+                  IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45._wp < zlon .AND. zlon < 100._wp ) THEN
+                     presto(ji,jj,1) = 0._wp
+                  ENDIF
+               END DO
+            END DO
+         ENDIF
+
+         zsdmp = 1._wp / ( pn_surf * rday )
+         zbdmp = 1._wp / ( pn_bot  * rday )
+         DO jk = 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zdct(ji,jj,jk) = MIN( zinfl, zdct(ji,jj,jk) )
+                  !   ... Decrease the value in the vicinity of the coast
+                  presto(ji,jj,jk) = presto(ji,jj,1 ) * 0.5_wp * (  1._wp - COS( rpi*zdct(ji,jj,jk)/zinfl)  )
+                  !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom)
+                  presto(ji,jj,jk) = presto(ji,jj,jk) * (  zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(ji,jj,jk)/pn_dep)  )
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+
+      !                                  ! =========================
+      !                                  !  Med and Red Sea damping    (ORCA configuration only)
+      !                                  ! =========================
+      IF( cp_cfg == "orca" .AND. ( kn_hdmp > 0 .OR. kn_hdmp == -1 ) ) THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) '              ORCA configuration: Damping in Med and Red Seas'
+         !
+         zmrs(:,:) = 0._wp
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration 
+            !                                        ! =======================
+            ij0 =  50   ;   ij1 =  56                    ! Mediterranean Sea
+
+            ii0 =  81   ;   ii1 =  91   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ij0 =  50   ;   ij1 =  55
+            ii0 =  75   ;   ii1 =  80   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ij0 =  52   ;   ij1 =  53
+            ii0 =  70   ;   ii1 =  74   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5_wp * (  1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1._wp / rday
+            END DO
+            !                                        ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration 
+            !                                        ! =======================
+            ij0 =  96   ;   ij1 = 110                    ! Mediterranean Sea
+            ii0 = 157   ;   ii1 = 181   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ij0 = 100   ;   ij1 = 110
+            ii0 = 144   ;   ii1 = 156   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ij0 = 100   ;   ij1 = 103
+            ii0 = 139   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            !
+            ij0 = 101   ;   ij1 = 102                    ! Decrease before Gibraltar Strait
+            ii0 = 139   ;   ii1 = 141   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
+            ii0 = 142   ;   ii1 = 142   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
+            ii0 = 143   ;   ii1 = 143   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
+            ii0 = 144   ;   ii1 = 144   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
+            !
+            ij0 =  87   ;   ij1 =  96                    ! Red Sea
+            ii0 = 147   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            !
+            ij0 =  91   ;   ij1 =  91                    ! Decrease before Bab el Mandeb Strait
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.80_wp
+            ij0 =  90   ;   ij1 =  90
+            ii0 = 153   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
+            ij0 =  89   ;   ij1 =  89
+            ii0 = 158   ;   ii1 = 160   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
+            ij0 =  88   ;   ij1 =  88
+            ii0 = 160   ;   ii1 = 163   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0._wp
+            ! Smooth transition from 0 at surface to 1./rday at the 18th level in Med and Red Sea
+            DO jk = 1, 17
+               zhfac (jk) = 0.5_wp * (  1._wp - COS( rpi * REAL(jk-1,wp) / 16._wp )  ) / rday
+            END DO
+            DO jk = 18, jpkm1
+               zhfac (jk) = 1._wp / rday
+            END DO
+            !                                        ! =======================
+         CASE ( 05 )                                 !  ORCA_R05 configuration
+            !                                        ! =======================
+            ii0 = 568   ;   ii1 = 574                    ! Mediterranean Sea
+            ij0 = 324   ;   ij1 = 333   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            ii0 = 575   ;   ii1 = 658
+            ij0 = 314   ;   ij1 = 366   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            !
+            ii0 = 641   ;   ii1 = 651                    ! Black Sea (remaining part
+            ij0 = 367   ;   ij1 = 372   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            !
+            ij0 = 324   ;   ij1 = 333                    ! Decrease before Gibraltar Strait
+            ii0 = 565   ;   ii1 = 565   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp / 90._wp
+            ii0 = 566   ;   ii1 = 566   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.40_wp
+            ii0 = 567   ;   ii1 = 567   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 0.75_wp
+            !
+            ii0 = 641   ;   ii1 = 665                    ! Red Sea
+            ij0 = 270   ;   ij1 = 310   ;   zmrs( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) = 1._wp
+            !
+            ii0 = 666   ;   ii1 = 675                    ! Decrease before Bab el Mandeb Strait
+            ij0 = 270   ;   ij1 = 290   
+            DO ji = mi0(ii0), mi1(ii1)
+               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1_wp * ABS( FLOAT(ji - mi1(ii1)) )
+            END DO 
+            zsdmp = 1._wp / ( pn_surf * rday )
+            zbdmp = 1._wp / ( pn_bot  * rday )
+            DO jk = 1, jpk
+               zhfac(jk) = (  zbdmp + (zsdmp-zbdmp) * EXP( -fsdept(1,1,jk)/pn_dep )  )
+            END DO
+            !                                       ! ========================
+         CASE ( 025 )                               !  ORCA_R025 configuration 
+            !                                       ! ========================
+            CALL ctl_stop( ' Not yet implemented in ORCA_R025' )
+            !
+         END SELECT
+
+         DO jk = 1, jpkm1
+            presto(:,:,jk) = zmrs(:,:) * zhfac(jk) + ( 1._wp - zmrs(:,:) ) * presto(:,:,jk)
+         END DO
+
+         ! Mask resto array and set to 0 first and last levels
+         presto(:,:, : ) = presto(:,:,:) * tmask(:,:,:)
+         presto(:,:, 1 ) = 0._wp
+         presto(:,:,jpk) = 0._wp
+         !                         !--------------------!
+      ELSE                         !     No damping     !
+         !                         !--------------------!
+         CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' )
+      ENDIF
+
+      !                            !--------------------------------!
+      IF( kn_file == 1 ) THEN      !  save damping coef. in a file  !
+         !                         !--------------------------------!
+         IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file'
+         IF( cdtype == 'TRA' ) cfile = 'damping.coeff'
+         IF( cdtype == 'TRC' ) cfile = 'damping.coeff.trc'
+         cfile = TRIM( cfile )
+         CALL iom_open  ( cfile, inum0, ldwrt = .TRUE., kiolib = jprstlib )
+         CALL iom_rstput( 0, 0, inum0, 'Resto', presto )
+         CALL iom_close ( inum0 )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpk, zhfac)
+      CALL wrk_dealloc( jpi, jpj, zmrs )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdct )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('dtacof')
+      !
+   END SUBROUTINE dtacof
+
+
+   SUBROUTINE cofdis( pdct )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE cofdis  ***
+      !!
+      !! ** Purpose :   Compute the distance between ocean T-points and the
+      !!      ocean model coastlines. Save the distance in a NetCDF file.
+      !!
+      !! ** Method  :   For each model level, the distance-to-coast is 
+      !!      computed as follows : 
+      !!       - The coastline is defined as the serie of U-,V-,F-points
+      !!      that are at the ocean-land bound.
+      !!       - For each ocean T-point, the distance-to-coast is then 
+      !!      computed as the smallest distance (on the sphere) between the 
+      !!      T-point and all the coastline points.
+      !!       - For land T-points, the distance-to-coast is set to zero.
+      !!      C A U T I O N : Computation not yet implemented in mpp case.
+      !!
+      !! ** Action  : - pdct, distance to the coastline (argument)
+      !!              - NetCDF file 'dist.coast.nc' 
+      !!----------------------------------------------------------------------
+      USE ioipsl      ! IOipsl librairy
+      !!
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline
+      !!
+      INTEGER ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER ::   iju, ijt, icoast, itime, ierr, icot   ! local integers
+      CHARACTER (len=32) ::   clname                     ! local name
+      REAL(wp) ::   zdate0                               ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zxt, zyt, zzt, zmask
+      REAL(wp), POINTER, DIMENSION(:  ) ::  zxc, zyc, zzc, zdis    ! temporary workspace
+      LOGICAL , ALLOCATABLE, DIMENSION(:,:) ::  llcotu, llcotv, llcotf   ! 2D logical workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('cofdis')
+      !
+      CALL wrk_alloc( jpi, jpj , zxt, zyt, zzt, zmask    )
+      CALL wrk_alloc( 3*jpi*jpj, zxc, zyc, zzc, zdis     )
+      ALLOCATE( llcotu(jpi,jpj), llcotv(jpi,jpj), llcotf(jpi,jpj)  )
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'cofdis: requested local arrays unavailable')
+
+      ! 0. Initialization
+      ! -----------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'cofdis : compute the distance to coastline'
+      IF(lwp) WRITE(numout,*) '~~~~~~'
+      IF(lwp) WRITE(numout,*)
+      IF( lk_mpp ) &
+           & CALL ctl_stop('         Computation not yet implemented with key_mpp_...', &
+           &               '         Rerun the code on another computer or ', &
+           &               '         create the "dist.coast.nc" file using IDL' )
+
+      pdct(:,:,:) = 0._wp
+      zxt(:,:) = COS( rad * gphit(:,:) ) * COS( rad * glamt(:,:) )
+      zyt(:,:) = COS( rad * gphit(:,:) ) * SIN( rad * glamt(:,:) )
+      zzt(:,:) = SIN( rad * gphit(:,:) )
+
+
+      ! 1. Loop on vertical levels
+      ! --------------------------
+      !                                                ! ===============
+      DO jk = 1, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the coastline points (U, V and F)
+         DO jj = 2, jpjm1
+            DO ji = 2, jpim1
+               zmask(ji,jj) =  ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) &
+                   &           + tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk) )
+               llcotu(ji,jj) = ( tmask(ji,jj,  jk) + tmask(ji+1,jj  ,jk) == 1._wp ) 
+               llcotv(ji,jj) = ( tmask(ji,jj  ,jk) + tmask(ji  ,jj+1,jk) == 1._wp ) 
+               llcotf(ji,jj) = ( zmask(ji,jj) > 0._wp ) .AND. ( zmask(ji,jj) < 4._wp )
+            END DO
+         END DO
+
+         ! Lateral boundaries conditions
+         llcotu(:, 1 ) = umask(:,  2  ,jk) == 1
+         llcotu(:,jpj) = umask(:,jpjm1,jk) == 1
+         llcotv(:, 1 ) = vmask(:,  2  ,jk) == 1
+         llcotv(:,jpj) = vmask(:,jpjm1,jk) == 1
+         llcotf(:, 1 ) = fmask(:,  2  ,jk) == 1
+         llcotf(:,jpj) = fmask(:,jpjm1,jk) == 1
+
+         IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
+            llcotu( 1 ,:) = llcotu(jpim1,:)
+            llcotu(jpi,:) = llcotu(  2  ,:)
+            llcotv( 1 ,:) = llcotv(jpim1,:)
+            llcotv(jpi,:) = llcotv(  2  ,:)
+            llcotf( 1 ,:) = llcotf(jpim1,:)
+            llcotf(jpi,:) = llcotf(  2  ,:)
+         ELSE
+            llcotu( 1 ,:) = umask(  2  ,:,jk) == 1
+            llcotu(jpi,:) = umask(jpim1,:,jk) == 1
+            llcotv( 1 ,:) = vmask(  2  ,:,jk) == 1
+            llcotv(jpi,:) = vmask(jpim1,:,jk) == 1
+            llcotf( 1 ,:) = fmask(  2  ,:,jk) == 1
+            llcotf(jpi,:) = fmask(jpim1,:,jk) == 1
+         ENDIF
+         IF( nperio == 3 .OR. nperio == 4 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji + 1
+               llcotu(ji,jpj  ) = llcotu(iju,jpj-2)
+               llcotf(ji,jpjm1) = llcotf(iju,jpj-2)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-3)
+            END DO
+            DO ji = jpi/2, jpim1
+               iju = jpi - ji + 1
+               llcotu(ji,jpjm1) = llcotu(iju,jpjm1)
+            END DO
+            DO ji = 2, jpi
+               ijt = jpi - ji + 2
+               llcotv(ji,jpjm1) = llcotv(ijt,jpj-2)
+               llcotv(ji,jpj  ) = llcotv(ijt,jpj-3)
+            END DO
+         ENDIF
+         IF( nperio == 5 .OR. nperio == 6 ) THEN
+            DO ji = 1, jpim1
+               iju = jpi - ji
+               llcotu(ji,jpj  ) = llcotu(iju,jpjm1)
+               llcotf(ji,jpj  ) = llcotf(iju,jpj-2)
+            END DO
+            DO ji = jpi/2, jpim1
+               iju = jpi - ji
+               llcotf(ji,jpjm1) = llcotf(iju,jpjm1)
+            END DO
+            DO ji = 1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpj  ) = llcotv(ijt,jpjm1)
+            END DO
+            DO ji = jpi/2+1, jpi
+               ijt = jpi - ji + 1
+               llcotv(ji,jpjm1) = llcotv(ijt,jpjm1)
+            END DO
+         ENDIF
+
+         ! Compute cartesian coordinates of coastline points
+         ! and the number of coastline points
+         icoast = 0
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( llcotf(ji,jj) ) THEN
+                  icoast = icoast + 1
+                  zxc(icoast) = COS( rad*gphif(ji,jj) ) * COS( rad*glamf(ji,jj) )
+                  zyc(icoast) = COS( rad*gphif(ji,jj) ) * SIN( rad*glamf(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphif(ji,jj) )
+               ENDIF
+               IF( llcotu(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiu(ji,jj) ) * COS( rad*glamu(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiu(ji,jj) ) * SIN( rad*glamu(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiu(ji,jj) )
+               ENDIF
+               IF( llcotv(ji,jj) ) THEN
+                  icoast = icoast+1
+                  zxc(icoast) = COS( rad*gphiv(ji,jj) ) * COS( rad*glamv(ji,jj) )
+                  zyc(icoast) = COS( rad*gphiv(ji,jj) ) * SIN( rad*glamv(ji,jj) )
+                  zzc(icoast) = SIN( rad*gphiv(ji,jj) )
+               ENDIF
+            END DO
+         END DO
+
+         ! Distance for the T-points
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) == 0._wp ) THEN
+                  pdct(ji,jj,jk) = 0._wp
+               ELSE
+                  DO jl = 1, icoast
+                     zdis(jl) = ( zxt(ji,jj) - zxc(jl) )**2   &
+                        &     + ( zyt(ji,jj) - zyc(jl) )**2   &
+                        &     + ( zzt(ji,jj) - zzc(jl) )**2
+                  END DO
+                  pdct(ji,jj,jk) = ra * SQRT( MINVAL( zdis(1:icoast) ) )
+               ENDIF
+            END DO
+         END DO
+         !                                                ! ===============
+      END DO                                              !   End of slab
+      !                                                   ! ===============
+
+
+      ! 2. Create the  distance to the coast file in NetCDF format
+      ! ----------------------------------------------------------    
+      clname = 'dist.coast'
+      itime  = 0
+      CALL ymds2ju( 0     , 1      , 1     , 0._wp , zdate0 )
+      CALL restini( 'NONE', jpi    , jpj   , glamt, gphit ,   &
+         &          jpk   , gdept_0, clname, itime, zdate0,   &
+         &          rdt   , icot                         )
+      CALL restput( icot, 'Tcoast', jpi, jpj, jpk, 0, pdct )
+      CALL restclo( icot )
+      !
+      CALL wrk_dealloc( jpi, jpj , zxt, zyt, zzt, zmask    )
+      CALL wrk_dealloc( 3*jpi*jpj, zxc, zyc, zzc, zdis     )
+      DEALLOCATE( llcotu, llcotv, llcotf  )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('cofdis')
+      !
+   END SUBROUTINE cofdis
+   !!======================================================================
+END MODULE tradmp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90	(revision 3437)
@@ -0,0 +1,350 @@
+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 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf      : update the tracer trend with the lateral diffusion
+   !!   tra_ldf_init : initialization, namelist read, and parameters control
+   !!       ldf_ano  : compute lateral diffusion for constant T-S profiles
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing             (tra_ldf_bilap routine)
+   USE traldf_iso      ! lateral mixing               (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_lap      ! lateral mixing               (tra_ldf_lap routine)
+   USE trdmod_oce      ! ocean space and time domain
+   USE trdtra          ! ocean active tracers trends
+   USE prtctl          ! Print control
+   USE in_out_manager  ! I/O manager
+   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 opa.F90 
+   !
+   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals)
+
+   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile
+   !                                                               !  (key_traldf_ano only)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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')
+      !
+      rldf = 1     ! For active tracers the 
+
+      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 ( 0 )   ;   CALL tra_ldf_lap     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level laplacian
+      CASE ( 1 )                                                                              ! rotated laplacian
+         IF( ln_traldf_grif ) THEN                                                          
+                       CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Griffies operator
+         ELSE                                                                                
+                       CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )      ! Madec operator
+         ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg  ( kt, nit000, 'TRA',             tsb, tsa, jpts        )  ! s-coord. geopot. bilap.
+         !
+      CASE ( -1 )                                ! esopa: test all possibility with control print
+         CALL tra_ldf_lap   ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )
+         ELSE
+            CALL tra_ldf_iso     ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )  
+         ENDIF
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_ldf_bilapg( kt, nit000, 'TRA',             tsb, tsa, jpts        ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+
+#if defined key_traldf_ano
+      tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:)      ! anomaly: substract the reference diffusivity
+      tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:)
+#endif
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_ldf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_ldf, ztrds )
+         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
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers 
+      !!----------------------------------------------------------------------
+
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+    
+      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'
+         WRITE(numout,*)
+      ENDIF
+
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_traldf_lap   )   ioptio = ioptio + 1
+      IF( ln_traldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_traldf_level )   ioptio = ioptio + 1
+      IF( ln_traldf_hor   )   ioptio = ioptio + 1
+      IF( ln_traldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_traldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_traldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_traldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_traldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_traldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   ierr = 1      ! iso-level not allowed 
+            IF ( ln_traldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_traldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_traldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_traldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      ! Reference T & S diffusivity (if necessary)
+      ! ===========================
+      CALL ldf_ano
+      !
+   END SUBROUTINE tra_ldf_init
+
+#if defined key_traldf_ano
+   !!----------------------------------------------------------------------
+   !!   'key_traldf_ano'               T & S lateral diffusion on anomalies
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE ldf_ano
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ano  ***
+      !!
+      !! ** Purpose :   initializations of 
+      !!----------------------------------------------------------------------
+      !
+      USE zdf_oce         ! vertical mixing
+      USE trazdf          ! vertical mixing: double diffusion
+      USE zdfddm          ! vertical mixing: double diffusion
+      !
+      INTEGER  ::   jk              ! Dummy loop indice
+      INTEGER  ::   ierr            ! local integer
+      LOGICAL  ::   llsave          ! local logical
+      REAL(wp) ::   zt0, zs0, z12   ! local scalar
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt     
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldf_ano')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
+      !
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+
+      !                              ! allocate trabbl arrays
+      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )
+
+      ! defined the T & S reference profiles
+      ! ------------------------------------
+      zt0 =10.e0                               ! homogeneous ocean
+      zs0 =35.e0
+      zt_ref(:,:,:) = 10.0 * tmask(:,:,:)
+      zs_ref(:,:,:) = 35.0 * tmask(:,:,:)
+      IF(lwp) WRITE(numout,*) '              homogeneous ocean T = ', zt0, ' S = ',zs0
+
+      !                                        ! T & S profile (to be coded +namelist parameter
+
+      ! prepare the ldf computation
+      ! ---------------------------
+      llsave = l_trdtra
+      l_trdtra = .false.      ! desactivate trend computation
+      t0_ldf(:,:,:) = 0.e0
+      s0_ldf(:,:,:) = 0.e0
+      ztb   (:,:,:) = tsb (:,:,:,jp_tem)
+      zsb   (:,:,:) = tsb (:,:,:,jp_sal)
+      ua    (:,:,:) = tsa (:,:,:,jp_tem)
+      va    (:,:,:) = tsa (:,:,:,jp_sal)
+      zavt  (:,:,:) = avt(:,:,:)
+      IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )
+      ! set tb, sb to reference values and avr to zero
+      tsb (:,:,:,jp_tem) = zt_ref(:,:,:)
+      tsb (:,:,:,jp_sal) = zs_ref(:,:,:)
+      tsa (:,:,:,jp_tem) = 0.e0
+      tsa (:,:,:,jp_sal) = 0.e0
+      avt(:,:,:)         = 0.e0
+
+      ! Compute the ldf trends
+      ! ----------------------
+      CALL tra_ldf( nit000 + 1 )      ! horizontal components (+1: no more init)
+      CALL tra_zdf( nit000     )      ! vertical component (if necessary nit000 to performed the init)
+
+      ! finalise the computation and recover all arrays
+      ! -----------------------------------------------
+      l_trdtra = llsave
+      z12 = 2.e0
+      IF( neuler == 1)   z12 = 1.e0
+      IF( ln_zdfexp ) THEN      ! ta,sa are the trends
+         t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)
+         s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)
+      ELSE
+         DO jk = 1, jpkm1
+            t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )
+            s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )
+         END DO
+      ENDIF
+      tsb(:,:,:,jp_tem) = ztb (:,:,:)
+      tsb(:,:,:,jp_sal) = zsb (:,:,:)
+      tsa(:,:,:,jp_tem) = ua  (:,:,:)
+      tsa(:,:,:,jp_sal) = va  (:,:,:)
+      avt(:,:,:)        = zavt(:,:,:)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldf_ano')
+      !
+   END SUBROUTINE ldf_ano
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO T & S background profiles
+   !!----------------------------------------------------------------------
+   SUBROUTINE ldf_ano
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'
+         WRITE(numout,*) '~~~~~~~~~~~'
+      ENDIF
+   END SUBROUTINE ldf_ano
+#endif
+
+   !!======================================================================
+END MODULE traldf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90	(revision 3437)
@@ -0,0 +1,177 @@
+MODULE traldf_bilap
+   !!==============================================================================
+   !!                   ***  MODULE  traldf_bilap  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  1991-11  (G. Madec)  Original code
+   !!                 !  1993-03  (M. Guyon)  symetrical conditions
+   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  1996-01  (G. Madec)  statement function for e3
+   !!                 !  1996-01  (M. Imbard)  mpp exchange
+   !!                 !  1997-07  (G. Madec)  optimization, and ahtt
+   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module
+   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization
+   !!             -   !  2005-11  (G. Madec)  zps or sco as default option
+   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!==============================================================================
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_bilap : update the tracer trend with the horizontal diffusion
+   !!                   using a iso-level biharmonic operator
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! ocean tracer   lateral physics
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes 
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE diaptr          ! poleward transport diagnostics
+   USE 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_ldf_bilap   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_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_ldf_bilap( kt, kit000, cdtype, pgu, pgv,      &
+      &                                  ptb, pta, kjpt )  
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_bilap  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   4th order diffusive operator along model level surfaces 
+      !!      evaluated using before fields (forward time scheme). The hor.
+      !!      diffusive trends  is given by:
+      !!      Laplacian of tb:
+      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(tb) ]  }
+      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
+      !!        zlt   = ahtt * zlt
+      !!        call to lbc_lnk
+      !!      Bilaplacian (laplacian of zlt):
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
+      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
+      !!
+      !!      Add this trend to the general trend
+      !!         (pta) = (pta) + ( difft )
+      !!
+      !! ** Action : - Update pta arrays with the before iso-level
+      !!               biharmonic mixing trend.
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace
+      !!
+      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,    kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !!
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zbtr, ztra       ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zeeu, zeev, zlt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'tra_ldf_bilap')
+      !
+      CALL wrk_alloc( jpi, jpj, zeeu, zeev, zlt ) 
+      !
+
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         DO jk = 1, jpkm1                                        ! Horizontal slab
+            !                                             
+            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zeeu(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)
+                  zeev(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)
+               END DO
+            END DO
+
+            !                          !==  Laplacian  ==!
+            !
+            DO jj = 1, jpjm1                 ! First derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+            IF( ln_zps ) THEN                ! set gradient at partial step level (last ocean level)
+               DO jj = 1, jpjm1
+                  DO ji = 1, jpim1
+                     IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
+                     IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
+                  END DO
+               END DO
+            ENDIF
+            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   )
+               END DO
+            END DO
+            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
+
+            !                          !==  Bilaplacian  ==!
+            !
+            DO jj = 1, jpjm1                 ! third derivative (gradient)
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
+                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
+               END DO
+            END DO
+            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! horizontal diffusive trends
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                             
+         END DO                                           ! Horizontal slab
+         !                                                
+         ! "zonal" mean lateral diffusive heat and salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN  
+           IF( jn == jp_tem )  htr_ldf(:) = ptr_vj( ztv(:,:,:) )
+           IF( jn == jp_sal )  str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         ENDIF
+         !                                                ! ===========
+      END DO                                              ! tracer loop
+      !                                                   ! ===========
+      IF( nn_timing == 1 )  CALL timing_stop( 'tra_ldf_bilap')
+      !
+      CALL wrk_dealloc( jpi, jpj, zeeu, zeev, zlt ) 
+      !
+   END SUBROUTINE tra_ldf_bilap
+
+   !!==============================================================================
+END MODULE traldf_bilap
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90	(revision 3437)
@@ -0,0 +1,362 @@
+MODULE traldf_bilapg
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_bilapg  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History : 8.0   ! 1997-07  (G. Madec)  Original code
+   !!   NEMO    1.0   ! 2002-08  (G. Madec)  F90: Free form and module
+   !!           3.3   ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!==============================================================================
+#if defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'                  rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_bilapg : update the tracer trend with the horizontal diffusion
+   !!                    using an horizontal biharmonic operator in s-coordinate 
+   !!   ldfght         :  ???
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE ldfslp          ! iso-neutral slopes available
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
+   USE diaptr          ! poleward transport diagnostics 
+   USE 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_ldf_bilapg   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE tra_ldf_bilapg  ***
+      !!                    
+      !! ** Purpose :   Compute the before horizontal tracer diffusive 
+      !!      trend and add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The lateral diffusive trends is provided by a 4th order
+      !!      operator rotated along geopotential surfaces. It is computed
+      !!      using before fields (forward in time) and geopotential slopes
+      !!      computed in routine inildf.
+      !!         -1- compute the geopotential harmonic operator applied to
+      !!        ptb and multiply it by the eddy diffusivity coefficient
+      !!       (done by a call to ldfght routine, result in wk1 arrays).
+      !!      Applied the domain lateral boundary conditions by call to lbc_lnk
+      !!         -2- compute the geopotential harmonic operator applied to
+      !!      wk1 by a second call to ldfght routine (result in wk2)
+      !!      arrays).
+      !!         -3- Add this trend to the general trend 
+      !!            pta = pta + wk2
+      !!
+      !! ** Action : - Update pta arrays with the before geopotential 
+      !!               biharmonic 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
+      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(:,:,:,:) :: zwk1, zwk2 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_bilapg')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'
+      ENDIF
+
+      ! 1. Laplacian of ptb * aht
+      ! ----------------------------- 
+      CALL ldfght( kt, cdtype, ptb, zwk1, kjpt, 1 )      ! rotated harmonic operator applied to ptb and multiply by aht 
+      !                                                 ! output in wk1 
+      !
+      DO jn = 1, kjpt
+         CALL lbc_lnk( zwk1(:,:,:,jn) , 'T', 1. )        ! Lateral boundary conditions on wk1   (unchanged sign)
+      END DO
+
+      ! 2. Bilaplacian of ptb
+      ! -------------------------
+      CALL ldfght( kt, cdtype, zwk1, zwk2, kjpt, 2 )      ! rotated harmonic operator applied to wk1 ; output in wk2
+
+
+      ! 3. Update the tracer trends                    (j-slab :   2, jpj-1)
+      ! ---------------------------
+      DO jn = 1, kjpt
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+               DO ji = 2, jpim1
+                  ! add it to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zwk2(ji,jj,jk,jn)
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, kjpt, zwk1, zwk2 ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_bilapg')
+      !
+   END SUBROUTINE tra_ldf_bilapg
+
+
+   SUBROUTINE ldfght ( kt, cdtype, pt, plt, kjpt, kaht )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldfght  ***
+      !!          
+      !! ** Purpose :   Apply a geopotential harmonic operator to (pt) and 
+      !!      multiply it by the eddy diffusivity coefficient (if kaht=1).
+      !!      Routine only used in s-coordinates (l_sco=T) with bilaplacian
+      !!      operator (ln_traldf_bilap=T) acting along geopotential surfaces
+      !!      (ln_traldf_hor).
+      !!
+      !! ** Method  :   The harmonic operator rotated along geopotential 
+      !!      surfaces is applied to (pt) using the slopes of geopotential
+      !!      surfaces computed in inildf routine. The result is provided in
+      !!      (plt,pls) arrays. It is computed in 2 steps:
+      !!
+      !!      First step: horizontal part of the operator. It is computed on
+      !!      ==========  pt as follows (idem on ps)
+      !!      horizontal fluxes :
+      !!         zftu = e2u*e3u/e1u di[ pt ] - e2u*uslp dk[ mi(mk(pt)) ]
+      !!         zftv = e1v*e3v/e2v dj[ pt ] - e1v*vslp dk[ mj(mk(pt)) ]
+      !!      take the horizontal divergence of the fluxes (no divided by
+      !!      the volume element :
+      !!         plt  = di-1[ zftu ] +  dj-1[ zftv ]
+      !!
+      !!      Second step: vertical part of the operator. It is computed on
+      !!      ===========  pt as follows (idem on ps)
+      !!      vertical fluxes :
+      !!         zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2)  dk-1[ pt ]
+      !!              -     e2t     *       wslpi        di[ mi(mk(pt)) ]
+      !!              -     e1t     *       wslpj        dj[ mj(mk(pt)) ]
+      !!      take the vertical divergence of the fluxes add it to the hori-
+      !!      zontal component, divide the result by the volume element and
+      !!      if kaht=1, multiply by the eddy diffusivity coefficient:
+      !!         plt  = aht / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!      else:
+      !!         plt  =  1  / (e1t*e2t*e3t) { plt + dk[ zftw ] }
+      !!
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zftv => ua       ! ua used as workspace
+      !
+      INTEGER         , INTENT(in )                              ::  kt      ! ocean time-step index
+      CHARACTER(len=3), INTENT(in )                              ::  cdtype  ! =TRA or TRC (tracer indicator) 
+      INTEGER         , INTENT(in )                              ::  kjpt    !: dimension of 
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) ::  pt      ! tracer fields ( before for 1st call
+      !                                                         ! and laplacian of these fields for 2nd call. 
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk,kjpt) ::  plt     !: partial harmonic operator applied to  pt  components except
+      !                                                             !: second order vertical derivative term  
+      INTEGER         , INTENT(in )                              ::  kaht    !: =1 multiply the laplacian by the eddy diffusivity coeff.
+      !                                                             !: =2 no multiplication 
+      !!
+      INTEGER ::   ji, jj, jk,jn          ! dummy loop indices
+      !                                   ! temporary scalars
+      REAL(wp) ::  zabe1, zabe2, zmku, zmkv 
+      REAL(wp) ::  zbtr, ztah, ztav
+      REAL(wp) ::  zcof0, zcof1, zcof2, zcof3, zcof4
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zftu, zdkt, zdk1t
+      REAL(wp), POINTER, DIMENSION(:,:) ::  zftw, zdit, zdjt, zdj1t
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('ldfght')
+      !
+      CALL wrk_alloc( jpi, jpj, zftu, zdkt, zdk1t ) 
+      CALL wrk_alloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
+      !
+      DO jn = 1, kjpt
+         !                               ! ********** !   ! ===============
+         DO jk = 1, jpkm1                ! First step !   ! Horizontal slab
+            !                            ! ********** !   ! ===============
+            
+            ! I.1 Vertical gradient of pt and ps at level jk and jk+1
+            ! -------------------------------------------------------
+            !     surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            
+            zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            IF( jk == 1 ) THEN
+               zdkt(:,:) = zdk1t(:,:)
+            ELSE
+               zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+
+            ! I.2 Horizontal fluxes
+            ! ---------------------
+            
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  zabe1 = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  
+                  zmku = 1./MAX( tmask(ji+1,jj,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji+1,jj,jk+1)+tmask(ji,jj,jk  ),1. )
+                  zmkv = 1./MAX( tmask(ji,jj+1,jk  )+tmask(ji,jj,jk+1)   &
+                     &          +tmask(ji,jj+1,jk+1)+tmask(ji,jj,jk  ),1. )
+                  
+                  zcof1 = -e2u(ji,jj) * uslp(ji,jj,jk) * zmku
+                  zcof2 = -e1v(ji,jj) * vslp(ji,jj,jk) * zmkv
+                  
+                  zftu(ji,jj)= umask(ji,jj,jk) *   &
+                     &         (  zabe1 *( pt   (ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof1 *( zdkt (ji+1,jj) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji+1,jj) + zdkt (ji,jj) )  )
+                  
+                  zftv(ji,jj,jk)= vmask(ji,jj,jk) *   &
+                     &         (  zabe2 *( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) )   &
+                     &          + zcof2 *( zdkt (ji,jj+1) + zdk1t(ji,jj)     &
+                     &                    +zdk1t(ji,jj+1) + zdkt (ji,jj) )  )                  
+               END DO
+            END DO
+
+
+            ! I.3 Second derivative (divergence) (not divided by the volume)
+            ! ---------------------
+            
+            DO jj = 2 , jpjm1
+               DO ji = 2 , jpim1
+                  ztah = zftu(ji,jj) - zftu(ji-1,jj) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)
+                  plt(ji,jj,jk,jn) = ztah
+               END DO
+            END DO
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+         ! "Poleward" diffusive heat or salt transport
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+
+         !                             ! ************ !   ! ===============
+         DO jj = 2, jpjm1              !  Second step !   ! Horizontal slab
+            !                          ! ************ !   ! ===============
+            
+            ! II.1 horizontal tracer gradient
+            ! -------------------------------
+            
+            DO jk = 1, jpk
+               DO ji = 1, jpim1
+                  zdit (ji,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj  ,jk,jn) ) * umask(ji,jj  ,jk)
+                  zdjt (ji,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj  ,jk,jn) ) * vmask(ji,jj  ,jk)
+                  zdj1t(ji,jk) = ( pt(ji  ,jj  ,jk,jn) - pt(ji,jj-1,jk,jn) ) * vmask(ji,jj-1,jk)
+               END DO
+            END DO
+
+
+            ! II.2 Vertical fluxes
+            ! --------------------
+            
+            ! Surface and bottom vertical fluxes set to zero
+            zftw(:, 1 ) = 0.e0
+            zftw(:,jpk) = 0.e0
+            
+            ! interior (2=<jk=<jpk-1)
+            DO jk = 2, jpkm1
+               DO ji = 2, jpim1
+                  zcof0 = e1t(ji,jj) * e2t(ji,jj) / fse3w(ji,jj,jk)   &
+                     &     * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)        &
+                     &        + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  )
+                  
+                  zmku = 1./MAX(  umask(ji  ,jj,jk-1)+umask(ji-1,jj,jk)   &
+                     &           +umask(ji-1,jj,jk-1)+umask(ji  ,jj,jk), 1. )
+                  
+                  zmkv = 1./MAX(  vmask(ji,jj  ,jk-1)+vmask(ji,jj-1,jk)   &
+                     &           +vmask(ji,jj-1,jk-1)+vmask(ji,jj  ,jk), 1. )
+                  
+                  zcof3 = - e2t(ji,jj) * wslpi (ji,jj,jk) * zmku
+                  zcof4 = - e1t(ji,jj) * wslpj (ji,jj,jk) * zmkv
+                  
+                  zftw(ji,jk) = tmask(ji,jj,jk) *   &
+                     &    (  zcof0 * ( pt   (ji,jj,jk-1,jn) - pt   (ji  ,jj,jk,jn) )   &
+                     &     + zcof3 * ( zdit (ji   ,jk-1   ) + zdit (ji-1,jk      )     &
+                     &                +zdit (ji-1 ,jk-1   ) + zdit (ji  ,jk      ) )   &
+                     &     + zcof4 * ( zdjt (ji   ,jk-1   ) + zdj1t(ji  ,jk)     &
+                     &                +zdj1t(ji   ,jk-1   ) + zdjt (ji  ,jk      ) )  )                 
+               END DO
+            END DO
+
+
+            ! II.3 Divergence of vertical fluxes added to the horizontal divergence
+            ! ---------------------------------------------------------------------
+            
+            IF( kaht == 1 ) THEN
+               ! multiply the laplacian by the eddy diffusivity coefficient
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! eddy coef. divided by the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) )
+                     ! harmonic operator applied to (pt,ps) and multiply by aht
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSEIF( kaht == 2 ) THEN
+               ! second call, no multiplication
+               DO jk = 1, jpkm1
+                  DO ji = 2, jpim1
+                     ! inverse of the volume element
+                     zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                     ! vertical divergence
+                     ztav = zftw(ji,jk) - zftw(ji,jk+1)
+                     ! harmonic operator applied to (pt,ps) 
+                     plt(ji,jj,jk,jn) = ( plt(ji,jj,jk,jn) + ztav ) * zbtr
+                  END DO
+               END DO
+            ELSE
+               IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht
+               IF(lwp) WRITE(numout,*) '         We stop'
+               STOP 'ldfght'
+            ENDIF
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, zftu, zdkt, zdk1t ) 
+      CALL wrk_dealloc( jpi, jpk, zftw, zdit, zdjt, zdj1t ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('ldfght')
+      !
+   END SUBROUTINE ldfght
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   Dummy module :             NO rotation of the lateral mixing tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_bilapg( kt, kit000, cdtype, ptb, pta, kjpt )      ! Empty routine
+      INTEGER :: kt, kit000
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', &
+        &         kt, kit000, cdtype, ptb(1,1,1,1), pta(1,1,1,1), kjpt
+   END SUBROUTINE tra_ldf_bilapg
+#endif
+
+   !!==============================================================================
+END MODULE traldf_bilapg
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90	(revision 3437)
@@ -0,0 +1,320 @@
+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
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso  : update the tracer trend with the horizontal 
+   !!                  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_oce      ! ocean active tracers: lateral physics
+   USE ldfslp          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+#if defined key_diaar5
+   USE phycst          ! physical constants
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+#endif
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_iso   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_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_ldf_iso( kt, kit000, cdtype, pgu, pgv,              &
+      &                                ptb, pta, kjpt, pahtb0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  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.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========    
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zftu => ua       , zftv  => va         ! (ua,va) used as workspace
+      !
+      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    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr, ztra            !   -      -
+#if defined key_diaar5
+      REAL(wp)                         ::   zztmp               ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zdkt, zdk1t, z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zdit, zdjt, 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, 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,*) '~~~~~~~~~~~'
+      ENDIF
+      !
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         !                                               
+         !!----------------------------------------------------------------------
+         !!   I - masked horizontal derivative 
+         !!----------------------------------------------------------------------
+         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient....
+         zdit (1,:,:) = 0.e0     ;     zdit (jpi,:,:) = 0.e0
+         zdjt (1,:,:) = 0.e0     ;     zdjt (jpi,:,:) = 0.e0
+         !!end
+
+         ! Horizontal tracer gradient 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level 
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)          
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)      
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+!CDIR PARALLEL DO PRIVATE( zdk1t ) 
+         !                                                ! ===============
+         DO jk = 1, jpkm1                                 ! Horizontal slab
+            !                                             ! ===============
+            ! 1. Vertical tracer gradient at level jk and jk+1
+            ! ------------------------------------------------
+            ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2)
+            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1)
+            !
+            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)
+            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk)
+            ENDIF
+
+            ! 2. Horizontal fluxes
+            ! --------------------   
+            DO jj = 1 , jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj)
+                  zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj)
+                  !
+                  zmsku = 1. / MAX(  tmask(ji+1,jj,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  !
+                  zmskv = 1. / MAX(  tmask(ji,jj+1,jk  ) + tmask(ji,jj,jk+1)   &
+                     &             + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk  ), 1. )
+                  !
+                  zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku
+                  zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv
+                  !
+                  zftu(ji,jj,jk ) = (  zabe1 * zdit(ji,jj,jk)   &
+                     &              + zcof1 * (  zdkt (ji+1,jj) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji+1,jj) + zdkt (ji,jj)  )  ) * umask(ji,jj,jk)
+                  zftv(ji,jj,jk) = (  zabe2 * zdjt(ji,jj,jk)   &
+                     &              + zcof2 * (  zdkt (ji,jj+1) + zdk1t(ji,jj)      &
+                     &                         + zdk1t(ji,jj+1) + zdkt (ji,jj)  )  ) * vmask(ji,jj,jk)                  
+               END DO
+            END DO
+
+            ! II.4 Second derivative (divergence) and add to the general trend
+            ! ----------------------------------------------------------------
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+            !                                          ! ===============
+         END DO                                        !   End of slab  
+         !                                             ! ===============
+         !
+         ! "Poleward" diffusive heat or salt transports (T-S case only)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+ 
+#if defined key_diaar5
+         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+            z2d(:,:) = 0._wp 
+            zztmp = rau0 * rcp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0._wp 
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in i-direction
+         END IF
+#endif
+
+         !!----------------------------------------------------------------------
+         !!   III - vertical trend of T & S (extra diagonal terms only)
+         !!----------------------------------------------------------------------
+         
+         ! Local constant initialization
+         ! -----------------------------
+         ztfw(1,:,:) = 0.e0     ;     ztfw(jpi,:,:) = 0.e0
+         
+         ! Vertical fluxes
+         ! ---------------
+         
+         ! Surface and bottom vertical fluxes set to zero
+         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpk) = 0.e0
+         
+         ! interior (2=<jk=<jpk-1)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk)
+                  !
+                  zmsku = 1./MAX(   umask(ji  ,jj,jk-1) + umask(ji-1,jj,jk)      &
+                     &            + umask(ji-1,jj,jk-1) + umask(ji  ,jj,jk), 1.  )
+                  zmskv = 1./MAX(   vmask(ji,jj  ,jk-1) + vmask(ji,jj-1,jk)      &
+                     &            + vmask(ji,jj-1,jk-1) + vmask(ji,jj  ,jk), 1.  )
+                  !
+                  zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk)
+                  zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk)
+                  !
+                  ztfw(ji,jj,jk) = zcoef3 * (   zdit(ji  ,jj  ,jk-1) + zdit(ji-1,jj  ,jk)      &
+                     &                        + zdit(ji-1,jj  ,jk-1) + zdit(ji  ,jj  ,jk)  )   &
+                     &           + zcoef4 * (   zdjt(ji  ,jj  ,jk-1) + zdjt(ji  ,jj-1,jk)      &
+                     &                        + zdjt(ji  ,jj-1,jk-1) + zdjt(ji  ,jj  ,jk)  )
+               END DO
+            END DO
+         END DO
+         
+         
+         ! I.5 Divergence of vertical fluxes added to the general tracer trend
+         ! -------------------------------------------------------------------
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ztra = (  ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1)  ) * zbtr
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
+               END DO
+            END DO
+         END DO
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdkt, zdk1t, z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso')
+      !
+   END SUBROUTINE tra_ldf_iso
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, ptb, pta, kjpt, pahtb0 )      ! Empty routine
+      INTEGER:: kt, kit000
+      CHARACTER(len=3) ::   cdtype
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype,   &
+         &                       pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
+   END SUBROUTINE tra_ldf_iso
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90	(revision 3437)
@@ -0,0 +1,454 @@
+MODULE traldf_iso_grif
+   !!======================================================================
+   !!                   ***  MODULE  traldf_iso_grif  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!======================================================================
+   !! History : 3.3  ! 2010-10  (G. Nurser, C. Harris, G. Madec)
+   !!                !          Griffies operator version adapted from traldf_iso.F90
+   !!----------------------------------------------------------------------
+#if   defined key_ldfslp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_ldfslp'               slope of the lateral diffusive direction
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_iso_grif  : update the tracer trend with the horizontal component
+   !!                       of the Griffies iso-neutral laplacian operator
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE phycst          ! physical constants
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE zdf_oce         ! ocean vertical physics
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfslp          ! iso-neutral slopes
+   USE diaptr          ! poleward transport diagnostics
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O library
+   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_iso_grif   ! routine called by traldf.F90
+
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
+   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2
+   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt3d               !: vertical tracer gradient at 2 levels
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
+       &                                   ptb, pta, kjpt, pahtb0 )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf_iso_grif  ***
+      !!
+      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
+      !!      trend for a laplacian tensor (ezxcept the dz[ dz[.] ] term) and
+      !!      add it to the general trend of tracer equation.
+      !!
+      !! ** Method  :   The horizontal component of the lateral diffusive trends
+      !!      is provided by a 2nd order operator rotated along neural or geopo-
+      !!      tential surfaces to which an eddy induced advection can be added
+      !!      It is computed using before fields (forward in time) and isopyc-
+      !!      nal or geopotential slopes computed in routine ldfslp.
+      !!
+      !!      1st part :  masked horizontal derivative of T  ( di[ t ] )
+      !!      ========    with partial cell update if ln_zps=T.
+      !!
+      !!      2nd part :  horizontal fluxes of the lateral mixing operator
+      !!      ========
+      !!         zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ]
+      !!               - aht       e2u*uslp    dk[ mi(mk(tb)) ]
+      !!         zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ]
+      !!               - aht       e2u*vslp    dk[ mj(mk(tb)) ]
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ zftu ] +  dj-1[ zftv ]  }
+      !!      Add this trend to the general trend (ta,sa):
+      !!         ta = ta + difft
+      !!
+      !!      3rd part: vertical trends of the lateral mixing operator
+      !!      ========  (excluding the vertical flux proportional to dk[t] )
+      !!      vertical fluxes associated with the rotated lateral mixing:
+      !!         zftw =-aht {  e2t*wslpi di[ mi(mk(tb)) ]
+      !!                     + e1t*wslpj dj[ mj(mk(tb)) ]  }
+      !!      take the horizontal divergence of the fluxes:
+      !!         difft = 1/(e1t*e2t*e3t) dk[ zftw ]
+      !!      Add this trend to the general trend (ta,sa):
+      !!         pta = pta + difft
+      !!
+      !! ** Action :   Update pta arrays with the before rotated diffusion
+      !!----------------------------------------------------------------------
+      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace
+      !
+      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    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
+      REAL(wp)                             , INTENT(in   ) ::   pahtb0     ! background diffusion coef
+      !
+      INTEGER  ::  ji, jj, jk,jn   ! dummy loop indices
+      INTEGER  ::  ip,jp,kp        ! dummy loop indices
+      INTEGER  ::  ierr            ! temporary integer
+      REAL(wp) ::  zmsku, zabe1, zcof1, zcoef3   ! local scalars
+      REAL(wp) ::  zmskv, zabe2, zcof2, zcoef4   !   -      -
+      REAL(wp) ::  zcoef0, zbtr                  !   -      -
+      !
+      REAL(wp) ::   zslope_skew, zslope_iso, zslope2, zbu, zbv
+      REAL(wp) ::   ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt
+      REAL(wp) ::   zah, zah_slp, zaei_slp
+#if defined key_diaar5
+      REAL(wp) ::   zztmp              ! local scalar
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: z2d
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d       ! 3D workspace
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_ldf_iso_grif')
+      !
+      CALL wrk_alloc( jpi, jpj,      z2d ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+
+      IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr )
+         IF( lk_mpp   )   CALL mpp_sum ( ierr )
+         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays')
+         IF( ln_traldf_gdia ) THEN
+            IF (.NOT. ALLOCATED(psix_eiv))THEN
+                ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )
+                IF( lk_mpp   )   CALL mpp_sum ( ierr )
+                IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics')
+            ENDIF
+         ENDIF
+      ENDIF
+
+      !!----------------------------------------------------------------------
+      !!   0 - calculate  ah_wslp2, psix_eiv, psiy_eiv
+      !!----------------------------------------------------------------------
+
+      !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads
+
+      ah_wslp2(:,:,:) = 0._wp
+      IF( ln_traldf_gdia ) THEN
+         psix_eiv(:,:,:) = 0._wp
+         psiy_eiv(:,:,:) = 0._wp
+      ENDIF
+
+      DO ip = 0, 1
+         DO kp = 0, 1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1
+                     ze1ur = 1._wp / e1u(ji,jj)
+                     ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                     zbu   = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                     zah   = fsahtu(ji,jj,jk)                                  ! fsaht(ji+ip,jj,jk)
+                     zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp)
+                     ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces
+                     ! (do this by *adding* gradient of depth)
+                     zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp)
+                     zslope2 = zslope2 *zslope2
+                     ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp)    &
+                        &                     + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2
+                     IF( ln_traldf_gdia ) THEN
+                        zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew           ! fsaeit(ji+ip,jj,jk)*zslope_skew
+                        psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+      DO jp = 0, 1
+         DO kp = 0, 1
+            DO jk = 1, jpkm1
+               DO jj = 1, jpjm1
+                  DO ji=1,fs_jpim1
+                     ze2vr = 1._wp / e2v(ji,jj)
+                     ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)
+                     zbv   = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                     zah   = fsahtv(ji,jj,jk)                                  ! fsaht(ji,jj+jp,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 + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp)
+                     zslope2 = zslope2 * zslope2
+                     ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp)   &
+                        &                     + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2
+                     IF( ln_traldf_gdia ) THEN
+                        zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew           ! fsaeit(ji,jj+jp,jk)*zslope_skew
+                        psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp
+                     ENDIF
+                  END DO
+               END DO
+            END DO
+         END DO
+      END DO
+      !
+#if defined key_iomput
+      IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN
+         CALL wrk_alloc( jpi , jpj , jpk  , zw3d )
+         DO jk=1,jpkm1
+            zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk)  ! u_eiv = -dpsix/dz
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL iom_put( "uoce_eiv", zw3d )    ! i-eiv current
+
+         DO jk=1,jpk-1
+            zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk)  ! v_eiv = -dpsiy/dz
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL iom_put( "voce_eiv", zw3d )    ! j-eiv current
+
+         DO jk=1,jpk-1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + &
+                       &    (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx
+               END DO
+            END DO
+         END DO
+         zw3d(:,:,jpk) = 0._wp
+         CALL iom_put( "woce_eiv", zw3d )    ! vert. eiv current
+         CALL wrk_dealloc( jpi , jpj , jpk  , zw3d )
+      ENDIF
+#endif
+      !                                                          ! ===========
+      DO jn = 1, kjpt                                            ! tracer loop
+         !                                                       ! ===========
+         ! Zero fluxes for each tracer
+         ztfw(:,:,:) = 0._wp
+         zftu(:,:,:) = 0._wp
+         zftv(:,:,:) = 0._wp
+         !
+         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==!
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk)
+                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         IF( ln_zps.and.l_grad_zps ) THEN              ! partial steps: correction at the last level
+# if defined key_vectopt_loop
+            DO jj = 1, 1
+               DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling)
+# else
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+# endif
+                  zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn)
+                  zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn)
+               END DO
+            END DO
+         ENDIF
+
+         !!----------------------------------------------------------------------
+         !!   II - horizontal trend  (full)
+         !!----------------------------------------------------------------------
+         !
+         DO jk = 1, jpkm1
+            !
+            !                    !==  Vertical tracer gradient at level jk and jk+1
+            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
+
+
+            IF (ln_botmix_grif) THEN
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = 1._wp / e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           zdzt  = 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 * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
+                           zah = fsahtu(ji,jj,jk)   !*umask(ji,jj,jk+kp)         !fsaht(ji+ip,jj,jk)           ===>>  ????
+                           zah_slp  = zah * zslope_iso
+                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew    !fsaeit(ji+ip,jj,jk)*zslope_skew
+                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = 1._wp / e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           zdzt  = 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 * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                           ! ln_botmix_grif is .T. don't mask zah for bottom half cells
+                           zah = fsahtv(ji,jj,jk)        !*vmask(ji,jj,jk+kp)  ! fsaht(ji,jj+jp,jk)
+                           zah_slp = zah * zslope_iso
+                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
+                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            ELSE
+               DO ip = 0, 1              !==  Horizontal & vertical fluxes
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze1ur = 1._wp / e1u(ji,jj)
+                           zdxt  = zdit(ji,jj,jk) * ze1ur
+                           ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)
+                           zdzt  = 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 * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk)
+                           ! ln_botmix_grif is .F. mask zah for bottom half cells
+                           zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! fsaht(ji+ip,jj,jk)   ===>>  ????
+                           zah_slp  = zah * zslope_iso
+                           zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew        ! fsaeit(ji+ip,jj,jk)*zslope_skew
+                           zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur
+                           ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+
+               DO jp = 0, 1
+                  DO kp = 0, 1
+                     DO jj = 1, jpjm1
+                        DO ji = 1, fs_jpim1
+                           ze2vr = 1._wp / e2v(ji,jj)
+                           zdyt  = zdjt(ji,jj,jk) * ze2vr
+                           ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)
+                           zdzt  = 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 * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk)
+                           ! ln_botmix_grif is .F. mask zah for bottom half cells
+                           zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! fsaht(ji,jj+jp,jk)
+                           zah_slp = zah * zslope_iso
+                           zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew        ! fsaeit(ji,jj+jp,jk)*zslope_skew
+                           zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr
+                           ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr
+                        END DO
+                     END DO
+                  END DO
+               END DO
+            END IF
+            !                          !==  divergence and add to the general trend  ==!
+            DO jj = 2 , jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (   zftu(ji-1,jj,jk) - zftu(ji,jj,jk)   &
+                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )
+               END DO
+            END DO
+            !
+         END DO
+         !
+         DO jk = 1, jpkm1              !== Divergence of vertical fluxes added to the general tracer trend
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1  ! vector opt.
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk)  )   &
+                     &                                / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         !
+         !                             ! "Poleward" diffusive heat or salt transports (T-S case only)
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn == jp_tem)   htr_ldf(:) = ptr_vj( zftv(:,:,:) )        ! 3.3  names
+            IF( jn == jp_sal)   str_ldf(:) = ptr_vj( zftv(:,:,:) )
+         ENDIF
+
+#if defined key_diaar5
+         IF( cdtype == 'TRA' .AND. jn == jp_tem  ) THEN
+            z2d(:,:) = 0._wp
+            zztmp = rau0 * rcp
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL lbc_lnk( z2d, 'U', -1. )
+            CALL iom_put( "udiff_heattr", z2d )                  ! heat transport in i-direction
+            z2d(:,:) = 0._wp
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+            z2d(:,:) = zztmp * z2d(:,:)
+            CALL lbc_lnk( z2d, 'V', -1. )
+            CALL iom_put( "vdiff_heattr", z2d )                  !  heat transport in j-direction
+         END IF
+#endif
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj,      z2d ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw  ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_iso_grif')
+      !
+  END SUBROUTINE tra_ldf_iso_grif
+
+#else
+   !!----------------------------------------------------------------------
+   !!   default option :   Dummy code   NO rotation of the diffusive tensor
+   !!----------------------------------------------------------------------
+   REAL, PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only)
+CONTAINS
+   SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv,              &
+       &                                   ptb, pta, kjpt, pahtb0 )
+      CHARACTER(len=3) ::   cdtype
+      INTEGER          ::   kit000     ! first time step index
+      REAL, DIMENSION(:,:,:) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL, DIMENSION(:,:,:,:) ::   ptb, pta
+      WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, cdtype,    &
+         &                  pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0
+   END SUBROUTINE tra_ldf_iso_grif
+#endif
+
+   !!==============================================================================
+END MODULE traldf_iso_grif
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90	(revision 3437)
@@ -0,0 +1,160 @@
+MODULE traldf_lap
+   !!==============================================================================
+   !!                       ***  MODULE  traldf_lap  ***
+   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
+   !!==============================================================================
+   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
+   !!                 !  91-11  (G. Madec)
+   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
+   !!                 !  96-01  (G. Madec)  statement function for e3
+   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
+   !!            1.0  !  04-08  (C. Talandier) New trends organization
+   !!                 !  05-11  (G. Madec)  add zps case
+   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
+   !!                 using a iso-level harmonic (laplacien) operator.
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE in_out_manager  ! I/O manager
+   USE diaptr          ! poleward transport diagnostics
+   USE trc_oce         ! share passive tracers/Ocean variables
+   USE lib_mpp         ! MPP library
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_ldf_lap   ! routine called by step.F90
+
+   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_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_ldf_lap( kt, kit000, cdtype, pgu, pgv,      &
+      &                                ptb, pta, kjpt ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  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/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
+      !!                                   + dj-1[ aht 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.
+      !!----------------------------------------------------------------------
+      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
+      !
+      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    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
+      !
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      INTEGER  ::   iku, ikv, ierr       ! local integers
+      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
+      !!----------------------------------------------------------------------
+      !
+      CALL timing_start('tra_ldf_lap')
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( .NOT. ALLOCATED( e1ur ) ) THEN
+            ! This routine may be called for both active and passive tracers. 
+            ! Allocate and set saved arrays on first call only.
+            ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr )
+            IF( lk_mpp    )   CALL mpp_sum( ierr )
+            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' )
+            !
+            e1ur(:,:) = e2u(:,:) / e1u(:,:)
+            e2vr(:,:) = e1v(:,:) / e2v(:,:)
+         ENDIF
+      ENDIF
+
+      !                                                          ! =========== !
+      DO jn = 1, kjpt                                            ! tracer loop !
+         !                                                       ! =========== !    
+         DO jk = 1, jpkm1                                            ! slab loop
+            !                                           
+            ! 1. First derivative (gradient)
+            ! -------------------
+            DO jj = 1, jpjm1
+               DO ji = 1, fs_jpim1   ! vector opt.
+                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk)
+                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk)
+                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
+                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
+               END DO
+            END DO
+            IF( ln_zps ) THEN      ! set gradient at partial step level
+               DO jj = 1, jpjm1
+                  DO ji = 1, fs_jpim1   ! vector opt.
+                     ! last level
+                     iku = mbku(ji,jj)
+                     ikv = mbkv(ji,jj)
+                     IF( iku == jk ) THEN
+                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku)
+                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
+                     ENDIF
+                     IF( ikv == jk ) THEN
+                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv)
+                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+         
+         
+            ! 2. Second derivative (divergence) added to the general tracer trends
+            ! ---------------------------------------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zbtr = 1._wp / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )
+                  ! horizontal diffusive trends added to the general tracer trends
+                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
+                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
+               END DO
+            END DO
+            !
+         END DO                                             !  End of slab  
+         !
+         ! "Poleward" diffusive heat or salt transports
+         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
+            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) )
+            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) )
+         ENDIF
+         !                                                  ! ==================
+      END DO                                                ! end of tracer loop
+      !                                                     ! ==================
+      CALL timing_stop('tra_ldf_lap')
+      !
+   END SUBROUTINE tra_ldf_lap
+
+   !!==============================================================================
+END MODULE traldf_lap
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranpc.F90	(revision 3437)
@@ -0,0 +1,228 @@
+MODULE tranpc
+   !!==============================================================================
+   !!                       ***  MODULE  tranpc  ***
+   !! Ocean active tracers:  non penetrative convection 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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_npc : apply the non penetrative convection scheme
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE trdmod_oce      ! ocean active tracer trends
+   USE trdtra          ! ocean active tracer trends
+   USE eosbn2          ! equation of state (eos routine) 
+   USE lbclnk          ! lateral boundary conditions (or mpp link)
+   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 "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $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  :   The algorithm used converges in a maximium of jpk 
+      !!      iterations. instabilities are treated when the vertical density
+      !!      gradient is less than 1.e-5.
+      !!      l_trdtra=T: the trend associated with this algorithm is saved.
+      !!
+      !! ** Action  : - (ta,sa) after the application od the npc scheme
+      !!              - save the associated trends (ttrd,strd) ('key_trdtra')
+      !!
+      !! 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  ::   inpci        ! number of iteration for npc scheme
+      INTEGER  ::   jiter, jkdown, jkp        ! ???
+      INTEGER  ::   ikbot, ik, ikup, ikdown   ! ???
+      REAL(wp) ::   ze3tot, zta, zsa, zraua, ze3dwn
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwx, zwy, zwz
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds, zrhop
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_npc')
+      !
+      CALL wrk_alloc(jpi, jpj, jpk, zrhop )
+      CALL wrk_alloc(jpi, jpk, zwx, zwy, zwz )
+      !
+      IF( MOD( kt, nn_npc ) == 0 ) THEN
+
+         inpcc = 0
+         inpci = 0
+
+         CALL eos( tsa, rhd, zrhop )         ! Potential density
+
+         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
+
+         !                                                ! ===============
+         DO jj = 1, jpj                                   !  Vertical slab
+            !                                             ! ===============
+            !  Static instability pointer 
+            ! ----------------------------
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zwx(ji,jk) = ( zrhop(ji,jj,jk) - zrhop(ji,jj,jk+1) ) * tmask(ji,jj,jk+1)
+               END DO
+            END DO
+
+            ! 1.1 do not consider the boundary points
+
+            ! even if east-west cyclic b. c. do not considere ji=1 or jpi
+            DO jk = 1, jpkm1
+               zwx( 1 ,jk) = 0.e0
+               zwx(jpi,jk) = 0.e0
+            END DO
+            ! even if south-symmetric b. c. used, do not considere jj=1
+            IF( jj == 1 )   zwx(:,:) = 0.e0
+
+            DO jk = 1, jpkm1
+               DO ji = 1, jpi
+                  zwx(ji,jk) = 1.
+                  IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0
+               END DO
+            END DO
+
+            zwy(:,1) = 0.e0
+            DO ji = 1, jpi
+               DO jk = 1, jpkm1
+                  zwy(ji,1) = zwy(ji,1) + zwx(ji,jk)
+               END DO
+            END DO
+
+            zwz(1,1) = 0.e0
+            DO ji = 1, jpi
+               zwz(1,1) = zwz(1,1) + zwy(ji,1)
+            END DO
+
+            inpcc = inpcc + NINT( zwz(1,1) )
+
+
+            ! 2. Vertical mixing for each instable portion of the density profil
+            ! ------------------------------------------------------------------
+
+            IF( zwz(1,1) /= 0.e0 ) THEN         ! -->> the density profil is statically instable :
+               DO ji = 1, jpi
+                  IF( zwy(ji,1) /= 0.e0 ) THEN
+                     !
+                     ikbot = mbkt(ji,jj)        ! ikbot: ocean bottom T-level
+                     !
+                     DO jiter = 1, jpk          ! vertical iteration
+                        !
+                        ! search of ikup : the first static instability from the sea surface
+                        !
+                        ik = 0
+220                     CONTINUE
+                        ik = ik + 1
+                        IF( ik >= ikbot ) GO TO 200
+                        zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1)
+                        IF( zwx(ji,ik) <= 0.e0 ) GO TO 220
+                        ikup = ik
+                        ! the density profil is instable below ikup
+                        ! ikdown : bottom of the instable portion of the density profil
+                        ! search of ikdown and vertical mixing from ikup to ikdown
+                        !
+                        ze3tot= fse3t(ji,jj,ikup)
+                        zta   = tsa  (ji,jj,ikup,jp_tem)
+                        zsa   = tsa  (ji,jj,ikup,jp_sal)
+                        zraua = zrhop(ji,jj,ikup)
+                        !
+                        DO jkdown = ikup+1, ikbot-1
+                           IF( zraua <= zrhop(ji,jj,jkdown) ) THEN
+                              ikdown = jkdown
+                              GO TO 240
+                           ENDIF
+                           ze3dwn =  fse3t(ji,jj,jkdown)
+                           ze3tot =  ze3tot + ze3dwn
+                           zta   = ( zta*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_tem)*ze3dwn )/ze3tot
+                           zsa   = ( zsa*(ze3tot-ze3dwn) + tsa(ji,jj,jkdown,jp_sal)*ze3dwn )/ze3tot
+                           zraua = ( zraua*(ze3tot-ze3dwn) + zrhop(ji,jj,jkdown)*ze3dwn )/ze3tot
+                           inpci = inpci+1
+                        END DO
+                        ikdown = ikbot-1
+240                     CONTINUE
+                        !
+                        DO jkp = ikup, ikdown-1
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,jkp       ) = zraua
+                        END DO
+                        IF (ikdown == ikbot-1 .AND. zraua >= zrhop(ji,jj,ikdown) ) THEN
+                           tsa  (ji,jj,jkp,jp_tem) = zta
+                           tsa  (ji,jj,jkp,jp_sal) = zsa
+                           zrhop(ji,jj,ikdown    ) = zraua
+                        ENDIF
+                     END DO
+                  ENDIF
+200               CONTINUE
+               END DO
+               ! <<-- no more static instability on slab jj
+            ENDIF
+            !                                             ! ===============
+         END DO                                           !   End of slab
+         !                                                ! ===============
+         ! 
+         IF( l_trdtra )   THEN         ! save the Non penetrative mixing trends for diagnostic
+            ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+            ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+            CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_npc, ztrdt )
+            CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_npc, ztrds )
+            CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds )
+         ENDIF
+      
+         ! Lateral boundary conditions on ( ta, sa )   ( Unchanged sign)
+         ! ------------------------------============
+         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ;   CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      
+
+         !  2. non penetrative convective scheme statistics
+         !  -----------------------------------------------
+         IF( nn_npcp /= 0 .AND. MOD( kt, nn_npcp ) == 0 ) THEN
+            IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable',   &
+               &                   ' water column : ',inpcc, ' number of iteration : ',inpci
+         ENDIF
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc(jpi, jpj, jpk, zrhop )
+      CALL wrk_dealloc(jpi, jpk, zwx, zwy, zwz )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_npc')
+      !
+   END SUBROUTINE tra_npc
+
+   !!======================================================================
+END MODULE tranpc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90	(revision 3437)
@@ -0,0 +1,341 @@
+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 zdf_oce         ! ???
+   USE domvvl          ! variable volume
+   USE dynspg_oce      ! surface     pressure gradient variables
+   USE dynhpg          ! hydrostatic pressure gradient 
+   USE trdmod_oce      ! ocean space and time domain variables 
+   USE trdtra          ! ocean active tracers trends 
+   USE phycst
+   USE obc_oce
+   USE obctra          ! open boundary condition (obc_tra routine)
+   USE bdy_oce
+   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 traqsr          ! penetrative solar radiation (needed for nksr)
+#if defined key_agrif
+   USE agrif_opa_update
+   USE agrif_opa_interp
+#endif
+   USE wrk_nemo        ! Memory allocation
+   USE timing          ! Timing
+
+   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
+
+   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO-Consortium (2010) 
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 (lk_obc=T), 
+      !!             at the AGRIF zoom     boundaries (lk_agrif=T)
+      !!
+      !!              - Update lateral boundary conditions on AGRIF children
+      !!             domains (lk_agrif=T)
+      !!
+      !! ** 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  ::   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,*) '~~~~~~~'
+         !
+         rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg
+      ENDIF
+
+      ! Update after tracer on domain lateral boundaries
+      ! 
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      ! local domain boundaries  (T-point, unchanged sign)
+      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+      !
+#if defined key_obc 
+      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries
+#endif
+#if defined key_bdy 
+      IF( lk_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_tra                     ! AGRIF zoom boundaries
+#endif
+ 
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler)
+      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+      IF( l_trdtra )   THEN                    ! store now fields before applying the Asselin filter
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds )
+         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( lk_vvl )  THEN   ;   CALL tra_nxt_vvl( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! variable volume level (vvl)     
+         ELSE                 ;   CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts )  ! fixed    volume level 
+         ENDIF
+      ENDIF 
+      !
+#if defined key_agrif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only
+#endif      
+      !
+      ! trends computation
+      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
+         DO jk = 1, jpkm1
+            zfact = 1.e0 / r2dtra(jk)             
+            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_trd_atf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_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.
+      !!              - save in (ta,sa) an 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 = tn + rbcp * [ta -2 tn + tb ]       ln_dynhpg_imp = T
+      !!             ztm = 0                                   otherwise
+      !!                   with rbcp=1/4 * (1-atfp^4) / (1-atfp)
+      !!             tb  = tn + atfp*[ tb - 2 tn + ta ]
+      !!             tn  = ta  
+      !!             ta  = ztm       (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         , INTENT(in   )                               ::   kit000   ! first time step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      !
+      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
+      LOGICAL  ::   ll_tra_hpg       ! local logical
+      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
+      !
+      IF( cdtype == 'TRA' )  THEN   ;   ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg    
+      ELSE                          ;   ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+      ENDIF
+      !
+      DO jn = 1, kjpt
+         !
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztn = ptn(ji,jj,jk,jn)                                    
+                  ztd = pta(ji,jj,jk,jn) - 2. * ztn + ptb(ji,jj,jk,jn)      !  time laplacian on tracers
+                  !
+                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                       ! ptb <-- filtered ptn 
+                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                       ! ptn <-- pta
+                  !
+                  IF( ll_tra_hpg )   pta(ji,jj,jk,jn) = ztn + rbcp * ztd    ! pta <-- Brown & Campana average
+               END DO
+           END DO
+         END DO
+         !
+      END DO
+      !
+   END SUBROUTINE tra_nxt_fix
+
+
+   SUBROUTINE tra_nxt_vvl( kt, kit000, cdtype, ptb, ptn, pta, 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.
+      !!              - 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         , INTENT(in   )                               ::   kit000   ! first time step index
+      CHARACTER(len=3), INTENT(in   )                               ::   cdtype   ! =TRA or TRC (tracer indicator)
+      INTEGER         , INTENT(in   )                               ::   kjpt     ! number of tracers
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptb      ! before tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   ptn      ! now tracer fields
+      REAL(wp)        , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt)  ::   pta      ! tracer trend
+      !!     
+      LOGICAL  ::   ll_tra, ll_tra_hpg, ll_traqsr   ! 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_tra     = .TRUE.           ! active tracers case  
+         ll_tra_hpg = ln_dynhpg_imp    ! active  tracers case  and  semi-implicit hpg
+         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
+      ELSE                          
+         ll_tra     = .FALSE.          ! passive tracers case
+         ll_tra_hpg = .FALSE.          ! passive tracers case or NO semi-implicit hpg
+         ll_traqsr  = .FALSE.          ! active  tracers case and NO solar penetration
+      ENDIF
+      !
+      DO jn = 1, kjpt      
+         DO jk = 1, jpkm1
+            zfact1 = atfp * rdttra(jk)
+            zfact2 = zfact1 / rau0
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = fse3t_b(ji,jj,jk)
+                  ze3t_n = fse3t_n(ji,jj,jk)
+                  ze3t_a = fse3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
+                  !
+                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+                  !
+                  ze3t_f = ze3t_n + atfp * ze3t_d
+                  ztc_f  = ztc_n  + atfp * ztc_d
+                  !
+                  IF( ll_tra .AND. jk == 1 ) THEN           ! first level only for T & S
+                      ze3t_f = ze3t_f - zfact2 * ( emp_b(ji,jj) - emp(ji,jj) )
+                      ztc_f  = ztc_f  - zfact1 * ( sbc_tsc(ji,jj,jn) - sbc_tsc_b(ji,jj,jn) )
+                  ENDIF
+                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )   &     ! solar penetration (temperature only)
+                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
+
+                   ze3t_f = 1.e0 / ze3t_f
+                   ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                   ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
+                   !
+                   IF( ll_tra_hpg ) THEN        ! semi-implicit hpg (T & S only)
+                      ze3t_d           = 1.e0   / ( ze3t_n + rbcp * ze3t_d )
+                      pta(ji,jj,jk,jn) = ze3t_d * ( ztc_n  + rbcp * ztc_d  )   ! ta <-- Brown & Campana average
+                   ENDIF
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE tra_nxt_vvl
+
+   !!======================================================================
+END MODULE tranxt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90	(revision 3437)
@@ -0,0 +1,519 @@
+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) 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   tra_qsr      : trend due to the solar radiation penetration
+   !!   tra_qsr_init : solar radiation penetration initialization
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers
+   USE dom_oce         ! ocean space and time domain
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE trc_oce         ! share SMS/Ocean variables
+   USE trdmod_oce      ! ocean variables trends
+   USE trdtra          ! ocean active tracers trends 
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! physical constants
+   USE prtctl          ! Print control
+   USE iom             ! I/O manager
+   USE fldread         ! read input fields
+   USE restart         ! ocean restart
+   USE lib_mpp         ! MPP library
+   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 opa.F90
+
+   !                                           !!* Namelist namtra_qsr: penetrative solar radiation
+   LOGICAL , PUBLIC ::   ln_traqsr  = .TRUE.    !: light absorption (qsr) flag
+   LOGICAL , PUBLIC ::   ln_qsr_rgb = .FALSE.   !: Red-Green-Blue light absorption flag  
+   LOGICAL , PUBLIC ::   ln_qsr_2bd = .TRUE.    !: 2 band         light absorption flag
+   LOGICAL , PUBLIC ::   ln_qsr_bio = .FALSE.   !: bio-model      light absorption flag
+   INTEGER , PUBLIC ::   nn_chldta  = 0         !: use Chlorophyll data (=1) or not (=0)
+   REAL(wp), PUBLIC ::   rn_abs     = 0.58_wp   !: fraction absorbed in the very near surface (RGB & 2 bands)
+   REAL(wp), PUBLIC ::   rn_si0     = 0.35_wp   !: very near surface depth of extinction      (RGB & 2 bands)
+   REAL(wp), PUBLIC ::   rn_si1     = 23.0_wp   !: deepest depth of extinction (water type I)       (2 bands)
+   
+   ! Module variables
+   REAL(wp) ::   xsi0r                           !: inverse of rn_si0
+   REAL(wp) ::   xsi1r                           !: inverse of rn_si1
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read)
+   INTEGER, PUBLIC ::   nksr              ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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.
+      !!         In z-coordinate case, the computation is only done down to the
+      !!      level where I(k) < 1.e-15 W/m2. In addition, the coefficients 
+      !!      used for the computation are calculated one for once as they
+      !!      depends on k only.
+      !!
+      !! ** Action  : - update ta with the penetrative solar radiation trend
+      !!              - save the trend in ttrd ('key_trdtra')
+      !!
+      !! Reference  : Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
+      !!              Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt     ! ocean time-step
+      !
+      INTEGER  ::   ji, jj, jk           ! dummy loop indices
+      INTEGER  ::   irgb                 ! local integers
+      REAL(wp) ::   zchl, zcoef, zfact   ! local scalars
+      REAL(wp) ::   zc0, zc1, zc2, zc3   !    -         -
+      REAL(wp) ::   zz0, zz1, z1_e3t     !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea, ztrdt
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_qsr')
+      !
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
+         IF(lwp) WRITE(numout,*) '~~~~~~~'
+         IF( .NOT.ln_traqsr )   RETURN
+      ENDIF
+
+      IF( l_trdtra ) THEN      ! Save ta and sa trends
+         CALL wrk_alloc( jpi, jpj, jpk, ztrdt ) 
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+      ENDIF
+
+      !                                        Set before qsr tracer content field
+      !                                        ***********************************
+      IF( kt == nit000 ) THEN                     ! Set the forcing field at nit000 - 1
+         !                                        ! -----------------------------------
+         IF( ln_rstart .AND.    &                    ! Restart: read in restart file
+              & iom_varid( numror, 'qsr_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field red in the restart file'
+            zfact = 0.5e0
+            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux
+         ELSE                                           ! No restart or restart not found: Euler forward time stepping
+            zfact = 1.e0
+            qsr_hc_b(:,:,:) = 0.e0
+         ENDIF
+      ELSE                                        ! Swap of forcing field
+         !                                        ! ---------------------
+         zfact = 0.5e0
+         qsr_hc_b(:,:,:) = qsr_hc(:,:,:)
+      ENDIF
+      !                                        Compute now qsr tracer content field
+      !                                        ************************************
+      
+      !                                           ! ============================================== !
+      IF( lk_qsr_bio .AND. ln_qsr_bio ) THEN      !  bio-model fluxes  : all vertical coordinates  !
+         !                                        ! ============================================== !
+         DO jk = 1, jpkm1
+            qsr_hc(:,:,jk) = ro0cpr * ( etot3(:,:,jk) - etot3(:,:,jk+1) )
+         END DO
+         !                                        Add to the general trend
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z1_e3t = zfact / fse3t(ji,jj,jk)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
+               END DO
+            END DO
+         END DO
+         CALL iom_put( 'qsr3d', etot3 )   ! Shortwave Radiation 3D distribution
+         !                                        ! ============================================== !
+      ELSE                                        !  Ocean alone : 
+         !                                        ! ============================================== !
+         !
+         !                                                ! ------------------------- !
+         IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration !
+            !                                             ! ------------------------- !
+            ! Set chlorophyl concentration
+            IF( nn_chldta == 1 .OR. lk_vvl ) THEN            !*  Variable Chlorophyll or ocean volume
+               !
+               IF( nn_chldta == 1 ) THEN                             !*  Variable Chlorophyll
+                  !
+                  CALL fld_read( kt, 1, sf_chl )                         ! Read Chl data and provides it at the current time step
+                  !         
+!CDIR COLLAPSE
+!CDIR NOVERRCHK
+                  DO jj = 1, jpj                                         ! Separation in R-G-B depending of the surface Chl
+!CDIR NOVERRCHK
+                     DO ji = 1, jpi
+                        zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) )
+                        irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                        zekb(ji,jj) = rkrgb(1,irgb)
+                        zekg(ji,jj) = rkrgb(2,irgb)
+                        zekr(ji,jj) = rkrgb(3,irgb)
+                     END DO
+                  END DO
+               ELSE                                            ! Variable ocean volume but constant chrlorophyll
+                  zchl = 0.05                                     ! constant chlorophyll
+                  irgb = NINT( 41 + 20.*LOG10( zchl ) + 1.e-15 )
+                  zekb(:,:) = rkrgb(1,irgb)                       ! Separation in R-G-B depending of the chlorophyll 
+                  zekg(:,:) = rkrgb(2,irgb)
+                  zekr(:,:) = rkrgb(3,irgb)
+               ENDIF
+               !
+               zcoef  = ( 1. - rn_abs ) / 3.e0                        ! equi-partition in R-G-B
+               ze0(:,:,1) = rn_abs  * qsr(:,:)
+               ze1(:,:,1) = zcoef * qsr(:,:)
+               ze2(:,:,1) = zcoef * qsr(:,:)
+               ze3(:,:,1) = zcoef * qsr(:,:)
+               zea(:,:,1) =         qsr(:,:)
+               !
+               DO jk = 2, nksr+1
+!CDIR NOVERRCHK
+                  DO jj = 1, jpj
+!CDIR NOVERRCHK   
+                     DO ji = 1, jpi
+                        zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r     )
+                        zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) )
+                        zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) )
+                        zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekr(ji,jj) )
+                        ze0(ji,jj,jk) = zc0
+                        ze1(ji,jj,jk) = zc1
+                        ze2(ji,jj,jk) = zc2
+                        ze3(ji,jj,jk) = zc3
+                        zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
+                     END DO
+                  END DO
+               END DO
+               !
+               DO jk = 1, nksr                                        ! compute and add qsr trend to ta
+                  qsr_hc(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) )
+               END DO
+               zea(:,:,nksr+1:jpk) = 0.e0     ! below 400m set to zero
+               CALL iom_put( 'qsr3d', zea )   ! Shortwave Radiation 3D distribution
+               !
+            ELSE                                                 !*  Constant Chlorophyll
+               DO jk = 1, nksr
+                  qsr_hc(:,:,jk) =  etot3(:,:,jk) * qsr(:,:)
+               END DO
+            ENDIF
+
+         ENDIF
+         !                                                ! ------------------------- !
+         IF( ln_qsr_2bd ) THEN                            !  2 band light penetration !
+            !                                             ! ------------------------- !
+            !
+            IF( lk_vvl ) THEN                                  !* variable volume
+               zz0   =        rn_abs   * ro0cpr
+               zz1   = ( 1. - rn_abs ) * ro0cpr
+               DO jk = 1, nksr                    ! solar heat absorbed at T-point in the top 400m 
+                  DO jj = 1, jpj
+                     DO ji = 1, jpi
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 
+                     END DO
+                  END DO
+               END DO
+            ELSE                                               !* constant volume: coef. computed one for all
+               DO jk = 1, nksr
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        qsr_hc(ji,jj,jk) =  etot3(ji,jj,jk) * qsr(ji,jj)
+                     END DO
+                  END DO
+               END DO
+               !
+            ENDIF
+            !
+         ENDIF
+         !
+         !                                        Add to the general trend
+         DO jk = 1, nksr
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  z1_e3t = zfact / fse3t(ji,jj,jk)
+                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + ( qsr_hc_b(ji,jj,jk) + qsr_hc(ji,jj,jk) ) * z1_e3t
+               END DO
+            END DO
+         END DO
+         !
+      ENDIF
+      !
+      IF( lrst_oce ) THEN   !                  Write in the ocean restart file
+         !                                     *******************************
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'qsr tracer content forcing field written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc )
+         !
+      ENDIF
+
+      IF( l_trdtra ) THEN     ! qsr tracers trends saved for diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_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' )
+      !
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+      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  ::   irgb, ierror, ioptio, nqsr   ! local integer
+      REAL(wp) ::   zz0, zc0  , zc1, zcoef       ! local scalars
+      REAL(wp) ::   zz1, zc2  , zc3, zchl        !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zekb, zekg, zekr
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ze0, ze1, ze2, ze3, zea
+      !
+      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_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   &
+         &                  nn_chldta, rn_abs, rn_si0, rn_si1
+      !!----------------------------------------------------------------------
+
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_qsr_init')
+      !
+      CALL wrk_alloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+
+      cn_dir = './'       ! directory in which the model is executed
+      ! ... default values (NB: frequency positive => hours, negative => months)
+      !            !     file       ! frequency !  variable  ! time interp !  clim   ! 'yearly' or ! weights  ! rotation   !
+      !            !     name       !  (hours)  !    name    !    (T/F)    !  (T/F)  ! 'monthly'   ! filename ! pairs      !
+      sn_chl = FLD_N( 'chlorophyll' ,    -1     ,  'CHLA'    ,  .true.     , .true.  ,   'yearly'  , ''       , ''         )
+      !
+      REWIND( numnam )            ! Read Namelist namtra_qsr : ratio and length of penetration
+      READ  ( numnam, 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,*) '      Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr
+         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,*) '      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
+      ENDIF
+
+      IF( ln_traqsr ) THEN     ! control consistency
+         !                      
+         IF( .NOT.lk_qsr_bio .AND. ln_qsr_bio )   THEN
+            CALL ctl_warn( 'No bio model : force ln_qsr_bio = FALSE ' )
+            ln_qsr_bio = .FALSE.
+         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 =  1 
+         IF( ln_qsr_rgb .AND. nn_chldta == 1 )   nqsr =  2
+         IF( ln_qsr_2bd                      )   nqsr =  3
+         IF( ln_qsr_bio                      )   nqsr =  4
+         !
+         IF(lwp) THEN                   ! Print the choice
+            WRITE(numout,*)
+            IF( nqsr ==  1 )   WRITE(numout,*) '         R-G-B   light penetration - Constant Chlorophyll'
+            IF( nqsr ==  2 )   WRITE(numout,*) '         R-G-B   light penetration - Chl data '
+            IF( nqsr ==  3 )   WRITE(numout,*) '         2 bands light penetration'
+            IF( nqsr ==  4 )   WRITE(numout,*) '         bio-model light penetration'
+         ENDIF
+         !
+      ENDIF
+      !                          ! ===================================== !
+      IF( ln_traqsr  ) THEN      !  Initialisation of Light Penetration  !  
+         !                       ! ===================================== !
+         !
+         xsi0r = 1.e0 / rn_si0
+         xsi1r = 1.e0 / rn_si1
+         !                                ! ---------------------------------- !
+         IF( ln_qsr_rgb ) THEN            !  Red-Green-Blue light penetration  !
+            !                             ! ---------------------------------- !
+            !
+            CALL trc_oce_rgb( rkrgb )           !* tabulated attenuation coef.
+            !
+            !                                   !* level of light extinction
+            IF(  ln_sco ) THEN   ;   nksr = jpkm1
+            ELSE                 ;   nksr = trc_oce_ext_lev( r_si2, 0.33e2 )
+            ENDIF
+
+            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
+            !
+            IF( nn_chldta == 1 ) THEN           !* Chl data : set sf_chl structure
+               IF(lwp) WRITE(numout,*)
+               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' )
+               !
+            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3)
+               IF(lwp) WRITE(numout,*)
+               IF(lwp) WRITE(numout,*) '        Constant Chlorophyll concentration = 0.05'
+               IF( lk_vvl ) THEN                   ! variable volume
+                  IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
+               ELSE                                ! constant volume: computes one for all
+                  IF(lwp) WRITE(numout,*) '        fixed volume: light distribution computed one for all'
+                  !
+                  zchl = 0.05                                 ! constant chlorophyll
+                  irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 )
+                  zekb(:,:) = rkrgb(1,irgb)                   ! Separation in R-G-B depending of the chlorophyll 
+                  zekg(:,:) = rkrgb(2,irgb)
+                  zekr(:,:) = rkrgb(3,irgb)
+                  !
+                  zcoef = ( 1. - rn_abs ) / 3.e0              ! equi-partition in R-G-B
+                  ze0(:,:,1) = rn_abs
+                  ze1(:,:,1) = zcoef
+                  ze2(:,:,1) = zcoef 
+                  ze3(:,:,1) = zcoef
+                  zea(:,:,1) = tmask(:,:,1)                   ! = ( ze0+ze1+z2+ze3 ) * tmask
+               
+                  DO jk = 2, nksr+1
+!CDIR NOVERRCHK
+                     DO jj = 1, jpj
+!CDIR NOVERRCHK   
+                        DO ji = 1, jpi
+                           zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * xsi0r     )
+                           zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekb(ji,jj) )
+                           zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekg(ji,jj) )
+                           zc3 = ze3(ji,jj,jk-1) * EXP( - fse3t_0(ji,jj,jk-1) * zekr(ji,jj) )
+                           ze0(ji,jj,jk) = zc0
+                           ze1(ji,jj,jk) = zc1
+                           ze2(ji,jj,jk) = zc2
+                           ze3(ji,jj,jk) = zc3
+                           zea(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
+                        END DO
+                     END DO
+                  END DO 
+                  !
+                  DO jk = 1, nksr
+                     etot3(:,:,jk) = ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) 
+                  END DO
+                  etot3(:,:,nksr+1:jpk) = 0.e0                ! below 400m set to zero
+               ENDIF
+            ENDIF
+            !
+         ENDIF
+            !                             ! ---------------------------------- !
+         IF( ln_qsr_2bd ) THEN            !    2 bands    light penetration    !
+            !                             ! ---------------------------------- !
+            !
+            !                                ! level of light extinction
+            nksr = trc_oce_ext_lev( rn_si1, 1.e2 )
+            IF(lwp) THEN
+               WRITE(numout,*)
+            IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksr, ' ref depth = ', gdepw_0(nksr+1), ' m'
+            ENDIF
+            !
+            IF( lk_vvl ) THEN                   ! variable volume
+               IF(lwp) WRITE(numout,*) '        key_vvl: light distribution will be computed at each time step'
+            ELSE                                ! constant volume: computes one for all
+               zz0 =        rn_abs   * ro0cpr
+               zz1 = ( 1. - rn_abs ) * ro0cpr
+               DO jk = 1, nksr                    !*  solar heat absorbed at T-point computed once for all
+                  DO jj = 1, jpj                              ! top 400 meters
+                     DO ji = 1, jpi
+                        zc0 = zz0 * EXP( -fsdepw(ji,jj,jk  )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk  )*xsi1r )
+                        zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )
+                        etot3(ji,jj,jk) = (  zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1)  ) 
+                     END DO
+                  END DO
+               END DO
+               etot3(:,:,nksr+1:jpk) = 0.e0                   ! below 400m set to zero
+               !
+            ENDIF
+         ENDIF
+         !                       ! ===================================== !
+      ELSE                       !        No light penetration           !                   
+         !                       ! ===================================== !
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
+            WRITE(numout,*) '~~~~~~~~~~~~'
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zekb, zekg, zekr        ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_qsr_init')
+      !
+   END SUBROUTINE tra_qsr_init
+
+   !!======================================================================
+END MODULE traqsr
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90	(revision 3437)
@@ -0,0 +1,246 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 traqsr          ! solar radiation penetration
+   USE trdmod_oce      ! ocean trends 
+   USE trdtra          ! ocean trends
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE restart         ! ocean restart
+   USE sbcrnf          ! River runoff  
+   USE sbcmod          ! ln_rnf  
+   USE iom
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_sbc    ! routine called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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 :
+      !!      Following Roullet and Madec (2000), the air-sea flux can be divided 
+      !!      into three effects: (1) Fext, external forcing; 
+      !!      (2) Fwi, concentration/dilution effect due to water exchanged 
+      !!         at the surface by evaporation, precipitations and runoff (E-P-R); 
+      !!      (3) Fwe, tracer carried with the water that is exchanged. 
+      !!
+      !!      Fext, flux through the air-sea interface for temperature and salt: 
+      !!            - temperature : heat flux q (w/m2). If penetrative solar
+      !!         radiation q is only the non solar part of the heat flux, the
+      !!         solar part is added in traqsr.F routine.
+      !!            ta = ta + q /(rau0 rcp e3t)  for k=1
+      !!            - salinity    : no salt flux
+      !!
+      !!      The formulation for Fwb and Fwi vary according to the free 
+      !!      surface formulation (linear or variable volume). 
+      !!      * Linear free surface
+      !!            The surface freshwater flux modifies the ocean volume
+      !!         and thus the concentration of a tracer and the temperature.
+      !!         First order of the effect of surface freshwater exchange 
+      !!         for salinity, it can be neglected on temperature (especially
+      !!         as the temperature of precipitations and runoffs is usually
+      !!         unknown).
+      !!            - temperature : we assume that the temperature of both
+      !!         precipitations and runoffs is equal to the SST, thus there
+      !!         is no additional flux since in this case, the concentration
+      !!         dilution effect is balanced by the net heat flux associated
+      !!         to the freshwater exchange (Fwe+Fwi=0):
+      !!            (Tp P - Te E) + SST (P-E) = 0 when Tp=Te=SST
+      !!            - salinity    : evaporation, precipitation and runoff
+      !!         water has a zero salinity (Fwe=0), thus only Fwi remains:
+      !!            sa = sa + emp * sn / e3t   for k=1
+      !!         where emp, the surface freshwater budget (evaporation minus
+      !!         precipitation minus runoff) given in kg/m2/s is divided
+      !!         by 1035 kg/m3 (density of ocena water) to obtain m/s.    
+      !!         Note: even though Fwe does not appear explicitly for 
+      !!         temperature in this routine, the heat carried by the water
+      !!         exchanged through the surface is part of the total heat flux
+      !!         forcing and must be taken into account in the global heat
+      !!         balance).
+      !!      * nonlinear free surface (variable volume, lk_vvl)
+      !!         contrary to the linear free surface case, Fwi is properly 
+      !!         taken into account by using the true layer thicknesses to       
+      !!         calculate tracer content and advection. There is no need to 
+      !!         deal with it in this routine.
+      !!           - temperature: Fwe=SST (P-E+R) is added to Fext.
+      !!           - salinity:  Fwe = 0, there is no surface flux of salt.
+      !!
+      !! ** Action  : - Update the 1st level of (ta,sa) with the trend associated
+      !!                with the tracer surface boundary condition 
+      !!              - save the trend it in ttrd ('key_trdtra')
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices  
+      REAL(wp) ::   zfact, z1_e3t, zsrau, zdep
+      REAL(wp), 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
+
+      zsrau = 1. / rau0             ! initialization
+
+      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      IF( .NOT.ln_traqsr )   qsr(:,:) = 0.e0   ! no solar radiation penetration
+      IF( .NOT.ln_traqsr ) THEN     ! no solar radiation penetration
+         qns(:,:) = qns(:,:) + qsr(:,:)      ! total heat flux in qns
+         qsr(:,:) = 0.e0                     ! qsr set to zero
+      ENDIF
+
+      !----------------------------------------
+      !        EMP, EMPS and QNS effects
+      !----------------------------------------
+      !                                          Set before sbc tracer content fields
+      !                                          ************************************
+      IF( kt == nit000 ) THEN                      ! Set the forcing field at nit000 - 1
+         !                                         ! -----------------------------------
+         IF( ln_rstart .AND.    &                     ! Restart: read in restart file
+              & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN
+            IF(lwp) WRITE(numout,*) '          nit000-1 surface tracer content forcing fields red in the restart file'
+            zfact = 0.5e0
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend
+            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend
+         ELSE                                         ! No restart or restart not found: Euler forward time stepping
+            zfact = 1.e0
+            sbc_tsc_b(:,:,:) = 0.e0
+         ENDIF
+      ELSE                                         ! Swap of forcing fields
+         !                                         ! ----------------------
+         zfact = 0.5e0
+         sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:)
+      ENDIF
+      !                                          Compute now sbc tracer content fields
+      !                                          *************************************
+
+                                                   ! Concentration dilution effect on (t,s) due to  
+                                                   ! evaporation, precipitation and qns, but not river runoff 
+                                               
+      IF( lk_vvl ) THEN                            ! Variable Volume case
+         DO jj = 1, jpj
+            DO ji = 1, jpi 
+               ! temperature : heat flux + cooling/heating effet of EMP flux
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem)
+               ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration
+               sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal)
+            END DO
+         END DO
+      ELSE                                         ! Constant Volume case
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ! temperature : heat flux
+               sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj)
+               ! salinity    : salt flux + concent./dilut. effect (both in emps)
+               sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal)
+            END DO
+         END DO
+      ENDIF
+      ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff  
+      DO jn = 1, jpts
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               z1_e3t = zfact / fse3t(ji,jj,1)
+               tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t
+            END DO
+         END DO
+      END DO
+      !                                          Write in the ocean restart file
+      !                                          *******************************
+      IF( lrst_oce ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ',   &
+            &                    'at it= ', kt,' date= ', ndastp
+         IF(lwp) WRITE(numout,*) '~~~~'
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) )
+         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) )
+      ENDIF
+      !
+      !----------------------------------------
+      !        River Runoff effects
+      !----------------------------------------
+      !
+      zfact = 0.5e0
+
+      ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 
+      IF( ln_rnf ) THEN  
+         DO jj = 2, jpj 
+            DO ji = fs_2, fs_jpim1
+               zdep = 1. / h_rnf(ji,jj)
+               zdep = zfact * zdep  
+               IF ( rnf(ji,jj) /= 0._wp ) THEN
+                  DO jk = 1, nk_rnf(ji,jj)
+                                        tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   &
+                                          &               +  ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep
+                     IF( ln_rnf_sal )   tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   &
+                                          &               +  ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 
+                  END DO
+               ENDIF
+            END DO  
+         END DO  
+      ENDIF  
+!!gm  It should be useless
+      CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )    ;    CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )
+
+      IF( l_trdtra )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds )
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90	(revision 3437)
@@ -0,0 +1,156 @@
+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 dynspg_oce
+
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE trdmod_oce      ! ocean active tracers: lateral physics
+   USE trdtra      ! ocean tracers trends 
+   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 "domzgr_substitute.h90"
+#  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( 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
+         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping)
+      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1
+         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (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', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme 
+      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme 
+      CASE ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, nit000, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+         CALL tra_zdf_imp( kt, nit000, 'TRA', r2dtra,            tsb, tsa, jpts ) 
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      END SELECT
+
+      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics
+         DO jk = 1, jpkm1
+            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk)
+            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk)
+         END DO
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_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 or KPP scheme,
+      !!      the implicit scheme is required.
+      !!----------------------------------------------------------------------
+      USE zdftke
+      USE zdfgls
+      USE zdfkpp
+      !!----------------------------------------------------------------------
+
+      ! 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 .OR. lk_zdfkpp )   nzdf = 1      ! TKE, GLS or KPP physics
+      IF( ln_traldf_iso                           )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_traldf_hor .AND. ln_sco              )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+      IF( ln_zdfexp .AND. nzdf == 1 )   CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator',   &
+            &                         ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' )
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+      !
+   END SUBROUTINE tra_zdf_init
+
+   !!==============================================================================
+END MODULE trazdf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_exp.F90	(revision 3437)
@@ -0,0 +1,176 @@
+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 "domzgr_substitute.h90"
+#  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, kn_zdfexp,   &
+      &                                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:
+      !!                zwx = ptb + p2dt difft
+      !!      where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) )
+      !!           (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt)
+      !!      difft is evaluated with an Euler split-explit scheme using a
+      !!      no flux boundary condition at both surface and bottomi boundaries.
+      !!      (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 by :
+      !!          pta = zwx + p2dt pta
+      !!              - in case of variable level thickness (lk_vvl=T) the 
+      !!     the leap-frog is applied on thickness weighted tracer. That is:
+      !!          pta = [ ptb*e3tb + e3tn*( zwx - 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   ) ::   kn_zdfexp   ! number of sub-time step
+      REAL(wp), DIMENSION(        jpk     ), INTENT(in   ) ::   p2dt        ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb         ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta         ! tracer trend 
+      !
+      INTEGER  ::  ji, jj, jk, jn, jl        ! dummy loop indices
+      REAL(wp) ::  zlavmr, zave3r, ze3tr     ! local scalars
+      REAL(wp) ::  ztra, ze3tb               !   -      -
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_exp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwx, zwy ) 
+      !
+
+      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
+      ! ---------------
+      zlavmr = 1. / float( kn_zdfexp )         ! Local constant
+      !
+      !
+      DO jn = 1, kjpt                          ! loop over tracers
+         !
+         zwy(:,:, 1 ) = 0.e0     ! surface boundary conditions: no flux
+         zwy(:,:,jpk) = 0.e0     ! bottom  boundary conditions: no flux
+         !
+         zwx(:,:,:)   = ptb(:,:,:,jn)  ! zwx array set to before tracer values
+
+         ! Split-explicit loop  (after tracer due to the vertical diffusion alone)
+         ! -------------------
+         !
+         DO jl = 1, kn_zdfexp
+            !                     ! first vertical derivative
+            DO jk = 2, jpk
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     zave3r = 1.e0 / fse3w_n(ji,jj,jk) 
+                     IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN  ! temperature : use of avt
+                        zwy(ji,jj,jk) =   avt(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                     ELSE                                           ! salinity or pass. tracer : use of avs
+                        zwy(ji,jj,jk) = fsavs(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) * zave3r
+                     END IF
+                  END DO
+               END DO
+            END DO
+            !
+            DO jk = 1, jpkm1      ! second vertical derivative   ==> tracer at kt+l*2*rdt/nn_zdfexp
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3tr = zlavmr / fse3t_n(ji,jj,jk)
+                     zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt(jk) * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) * ze3tr
+                  END DO
+               END DO
+            END DO
+            !
+         END DO
+
+         ! After tracer due to all trends
+         ! ------------------------------
+         IF( lk_vvl ) THEN          ! variable level thickness : leap-frog on tracer*e3t
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk)                          ! before e3t
+                     ztra  = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn)       ! total trends * 2*rdt 
+                     pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ELSE                       ! fixed level thickness : leap-frog on tracers
+            DO jk = 1, jpkm1
+               DO jj = 2, jpjm1 
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk)
+                  END DO
+               END DO
+            END DO
+         ENDIF
+         !
+      END DO
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, zwx, zwy ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_exp')
+      !
+   END SUBROUTINE tra_zdf_exp
+
+   !!==============================================================================
+END MODULE trazdf_exp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90	(revision 3437)
@@ -0,0 +1,239 @@
+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
+   !!----------------------------------------------------------------------
+  
+   !!----------------------------------------------------------------------
+   !!   tra_zdf_imp : Update the tracer trend with the diagonal vertical  
+   !!                 part of the mixing tensor.
+   !!----------------------------------------------------------------------
+   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_oce      ! ocean active tracers: lateral physics
+   USE ldftra          ! lateral mixing type
+   USE ldfslp          ! lateral physics: slope of diffusion
+   USE zdfddm          ! ocean vertical physics: double diffusion
+   USE traldf_iso_grif ! active tracers: Griffies operator
+   USE in_out_manager  ! I/O manager
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory Allocation
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   tra_zdf_imp   !  routine called by step.F90
+
+   REAL(wp) ::  r_vvl     ! variable volume indicator, =1 if lk_vvl=T, =0 otherwise 
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  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_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 the tracer t  is given by:
+      !!                  difft = dz( avt dz(t) ) = 1/e3t dk+1( avt/e3w dk(t) )
+      !!      It is computed using a backward time scheme (t=ta).
+      !!      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
+      !!---------------------------------------------------------------------
+      USE oce     , ONLY:   zwd => ua       , zws => va         ! (ua,va) used as 3D workspace
+      !
+      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(        jpk     ), INTENT(in   ) ::   p2dt     ! vertical profile of tracer time-step
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb      ! before and now tracer fields
+      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend 
+      !
+      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
+      REAL(wp) ::  zrhs, ze3tb, ze3tn, ze3ta   ! local scalars
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwi, zwt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_zdf_imp')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zwi, zwt ) 
+      !
+      IF( kt == kit000 )  THEN
+         IF(lwp)WRITE(numout,*)
+         IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype
+         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '
+         !
+         IF( lk_vvl ) THEN   ;    r_vvl = 1._wp       ! Variable volume indicator
+         ELSE                ;    r_vvl = 0._wp       
+         ENDIF
+      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 defined key_ldfslp
+            ! isoneutral diffusion: add the contribution 
+            IF( ln_traldf_grif    ) THEN     ! Griffies isoneutral diff
+               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
+            ELSE IF( l_traldf_rot ) THEN     ! standard isoneutral diff
+               DO jk = 2, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk)                       &
+                           &                          * (  wslpi(ji,jj,jk) * wslpi(ji,jj,jk)   &
+                           &                             + wslpj(ji,jj,jk) * wslpj(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.
+                     ze3ta =  ( 1. - r_vvl ) +        r_vvl   * fse3t_a(ji,jj,jk)   ! after scale factor at T-point
+                     ze3tn =         r_vvl   + ( 1. - r_vvl ) * fse3t_n(ji,jj,jk)   ! now   scale factor at T-point
+                     zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk  ) / ( ze3tn * fse3w(ji,jj,jk  ) )
+                     zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) )
+                     zwd(ji,jj,jk) = ze3ta - zwi(ji,jj,jk) - zws(ji,jj,jk)
+                 END DO
+               END DO
+            END DO
+            !
+            !! 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.
+            !
+            ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k)
+            ! done once for all passive tracers (so included in the IF instruction)
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  zwt(ji,jj,1) = zwd(ji,jj,1)
+               END DO
+            END DO
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                    zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) / zwt(ji,jj,jk-1)
+                  END DO
+               END DO
+            END DO
+            !
+         END IF 
+         !         
+         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1)
+               ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1)
+               pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn)
+            END DO
+         END DO
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1
+                  ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,jk)
+                  ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t  (ji,jj,jk)
+                  zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn)   ! zrhs=right hand side 
+                  pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn)
+               END DO
+            END DO
+         END DO
+
+         ! third recurrence:    Xk = (Zk - Sk Xk+1 ) / Tk   (result is the after tracer)
+         DO jj = 2, jpjm1
+            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 ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_zdf_imp')
+      !
+   END SUBROUTINE tra_zdf_imp
+
+   !!==============================================================================
+END MODULE trazdf_imp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90	(revision 3437)
@@ -0,0 +1,219 @@
+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 
+   !!======================================================================
+   
+   !!----------------------------------------------------------------------
+   !!   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
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE 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_insitu_2d which will compute rd~(t~,s~) at 
+      !!      the good depth zh from interpolated T and S for the different
+      !!      formulation of the equation of state (eos).
+      !!      Gradient formulation for rho :
+      !!          di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~
+      !!
+      !! ** Action  : - pgtu, 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 
+      !
+      INTEGER  ::   ji, jj, jn      ! Dummy loop indices
+      INTEGER  ::   iku, ikv, ikum1, ikvm1   ! partial step level (ocean bottom level) at u- and v-points
+      REAL(wp) ::  ze3wu, ze3wv, zmaxu, zmaxv  ! temporary scalars
+      REAL(wp), POINTER, DIMENSION(:,:  ) ::  zri, zrj, zhi, zhj
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zti, ztj    ! interpolated value of tracer
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start( 'zps_hde')
+      !
+      CALL wrk_alloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+      CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj           ) 
+      !
+      DO jn = 1, kjpt      !==   Interpolation of tracers at the last ocean level   ==!
+         !
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku(ji,jj)   ;   ikum1 = MAX( iku - 1 , 1 )    ! last and before last ocean level at u- & v-points
+               ikv = mbkv(ji,jj)   ;   ikvm1 = MAX( ikv - 1 , 1 )    ! if level first is a p-step, ik.m1=1
+               ze3wu = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               !
+               ! i- direction
+               IF( ze3wu >= 0._wp ) THEN      ! case 1
+                  zmaxu =  ze3wu / fse3w(ji+1,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) )
+                  ! gradient of  tracers
+                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )
+               ELSE                           ! case 2
+                  zmaxu = -ze3wu / fse3w(ji,jj,iku)
+                  ! interpolated values of tracers
+                  zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) )
+                  ! gradient of tracers
+                  pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )
+               ENDIF
+               !
+               ! j- direction
+               IF( ze3wv >= 0._wp ) THEN      ! case 1
+                  zmaxv =  ze3wv / fse3w(ji,jj+1,ikv)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )
+               ELSE                           ! case 2
+                  zmaxv =  -ze3wv / fse3w(ji,jj,ikv)
+                  ! interpolated values of tracers
+                  ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) )
+                  ! gradient of tracers
+                  pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) )
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         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
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   zhi(ji,jj) = fsdept(ji  ,jj,iku)     ! i-direction: case 1
+               ELSE                        ;   zhi(ji,jj) = fsdept(ji+1,jj,iku)     ! -     -      case 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   zhj(ji,jj) = fsdept(ji,jj  ,ikv)     ! j-direction: case 1
+               ELSE                        ;   zhj(ji,jj) = fsdept(ji,jj+1,ikv)     ! -     -      case 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+
+         ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial
+         ! step and store it in  zri, zrj for each  case
+         CALL eos( zti, zhi, zri )  
+         CALL eos( ztj, zhj, zrj )
+
+         ! Gradient of density at the last level 
+# if defined key_vectopt_loop
+         jj = 1
+         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
+# else
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+# endif
+               iku = mbku(ji,jj)
+               ikv = mbkv(ji,jj)
+               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
+               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
+               IF( ze3wu >= 0._wp ) THEN   ;   pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji  ,jj) - prd(ji,jj,iku) )   ! i: 1
+               ELSE                        ;   pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) )   ! i: 2
+               ENDIF
+               IF( ze3wv >= 0._wp ) THEN   ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj  ) - prd(ji,jj,ikv) )   ! j: 1
+               ELSE                        ;   pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) )   ! j: 2
+               ENDIF
+# if ! defined key_vectopt_loop
+            END DO
+# endif
+         END DO
+         CALL lbc_lnk( pgru , 'U', -1. )   ;   CALL lbc_lnk( pgrv , 'V', -1. )   ! Lateral boundary conditions
+         !
+      END IF
+      !
+      CALL wrk_dealloc( jpi, jpj,       zri, zrj, zhi, zhj ) 
+      CALL wrk_dealloc( jpi, jpj, kjpt, zti, ztj           ) 
+      !
+      IF( nn_timing == 1 )  CALL timing_stop( 'zps_hde')
+      !
+   END SUBROUTINE zps_hde
+
+   !!======================================================================
+END MODULE zpshde
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90	(revision 3437)
@@ -0,0 +1,608 @@
+MODULE trdicp
+   !!======================================================================
+   !!                       ***  MODULE  trdicp  ***
+   !! Ocean diagnostics:  ocean tracers and dynamic trends
+   !!=====================================================================
+   !! History :  1.0  !  2004-08 (C. Talandier) New trends organization
+   !!----------------------------------------------------------------------
+#if  defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdtra'  or                  active tracers trends diagnostics
+   !!   'key_trddyn'                            momentum trends diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_icp          : compute the basin averaged properties for tra/dyn 
+   !!   trd_dwr          : print dynmaic trends in ocean.output file
+   !!   trd_twr          : print tracers trends in ocean.output file
+   !!   trd_icp_init     : initialization step
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trdmod_oce      ! ocean variables trends
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics: lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE lib_mpp         ! distibuted memory computing library
+   USE eosbn2          ! equation of state
+   USE phycst          ! physical constants
+   USE wrk_nemo        ! Memory allocation
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE trd_icp
+      MODULE PROCEDURE trd_2d, trd_3d
+   END INTERFACE
+
+   PUBLIC   trd_icp       ! called by trdmod.F90
+   PUBLIC   trd_dwr       ! called by step.F90
+   PUBLIC   trd_twr       ! called by step.F90
+   PUBLIC   trd_icp_init  ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_2d  ***
+      !! 
+      !! ** Purpose : verify the basin averaged properties of tracers and/or
+      !!              momentum equations at every time step frequency nn_trd.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dy   ! Salinity    or V trend
+      INTEGER                     , INTENT(in   ) ::   ktrd      ! tracer trend index
+      CHARACTER(len=3)            , INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends
+      !!
+      INTEGER ::   ji, jj   ! loop indices
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( ctype )    !==  Mask trends  ==!
+      !
+      CASE( 'DYN' )                    ! Momentum
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1
+               ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,1)
+               ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1)
+            END DO
+         END DO
+         ptrd2dx(jpi, : ) = 0._wp      ;      ptrd2dy(jpi, : ) = 0._wp
+         ptrd2dx( : ,jpj) = 0._wp      ;      ptrd2dy( : ,jpj) = 0._wp
+         !
+      CASE( 'TRA' )                    ! Tracers
+         ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:)
+         ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:)
+         !
+      END SELECT
+      
+      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==!
+      !
+      CASE( 'DYN' )                    ! Momentum
+         umo(ktrd) = 0._wp
+         vmo(ktrd) = 0._wp
+         !
+         SELECT CASE( ktrd )
+         CASE( jpdyn_trd_swf )         ! surface forcing
+            umo(ktrd) = SUM( ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1) )
+            vmo(ktrd) = SUM( ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1) )
+         END SELECT
+         !
+      CASE( 'TRA' )              ! Tracers
+         tmo(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) )
+         smo(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) )
+      END SELECT
+      
+      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field)
+      !
+      CASE( 'DYN' )              ! Momentum
+         hke(ktrd) = SUM(   un(:,:,1) * ptrd2dx(:,:) * e1u(:,:) * e2u(:,:) * fse3u(:,:,1)   &
+            &             + vn(:,:,1) * ptrd2dy(:,:) * e1v(:,:) * e2v(:,:) * fse3v(:,:,1)   )
+         !
+      CASE( 'TRA' )              ! Tracers
+         t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_tem) )
+         s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_sal) )
+         !      
+      END SELECT
+      !
+   END SUBROUTINE trd_2d
+
+
+   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd, ctype )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_3d  ***
+      !! 
+      !! ** Purpose : verify the basin averaged properties of tracers and/or
+      !!              momentum equations at every time step frequency nn_trd.
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dy   ! Salinity    or V trend
+      INTEGER,                          INTENT(in   ) ::   ktrd      ! momentum or tracer trend index
+      CHARACTER(len=3),                 INTENT(in   ) ::   ctype     ! momentum ('DYN') or tracers ('TRA') trends
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( ctype )    !==  Mask the trends  ==!
+      !
+      CASE( 'DYN' )              ! Momentum        
+         DO jk = 1, jpkm1
+            DO jj = 1, jpjm1
+               DO ji = 1, jpim1
+                  ptrd3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+                  ptrd3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * tmask_i(ji  ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         ptrd3dx(jpi, : ,:) = 0._wp      ;      ptrd3dy(jpi, : ,:) = 0._wp
+         ptrd3dx( : ,jpj,:) = 0._wp      ;      ptrd3dy( : ,jpj,:) = 0._wp
+         !
+      CASE( 'TRA' )              ! Tracers
+         DO jk = 1, jpkm1
+            ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
+            ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)
+         END DO
+         !
+      END SELECT   
+
+      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum trends  ==!
+      !
+      CASE( 'DYN' )              ! Momentum
+         umo(ktrd) = 0._wp
+         vmo(ktrd) = 0._wp
+         DO jk = 1, jpkm1
+            umo(ktrd) = umo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk) )
+            vmo(ktrd) = vmo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk) )
+         END DO
+         !
+      CASE( 'TRA' )              ! Tracers
+         tmo(ktrd) = 0._wp
+         smo(ktrd) = 0._wp
+         DO jk = 1, jpkm1
+            tmo(ktrd) = tmo(ktrd) + SUM( ptrd3dx(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+            smo(ktrd) = smo(ktrd) + SUM( ptrd3dy(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) )
+         END DO
+         !
+      END SELECT
+
+      SELECT CASE( ctype )    !==  Basin averaged tracer/momentum square trends  ==!   (now field)
+      !
+      CASE( 'DYN' )              ! Momentum
+         hke(ktrd) = 0._wp
+         DO jk = 1, jpkm1
+            hke(ktrd) = hke(ktrd) + SUM(   un(:,:,jk) * ptrd3dx(:,:,jk) * e1u(:,:) * e2u(:,:) * fse3u(:,:,jk)   &
+               &                         + vn(:,:,jk) * ptrd3dy(:,:,jk) * e1v(:,:) * e2v(:,:) * fse3v(:,:,jk)   )
+         END DO
+         !
+      CASE( 'TRA' )              ! Tracers
+         t2(ktrd) = 0._wp
+         s2(ktrd) = 0._wp
+         DO jk = 1, jpkm1
+            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tsn(:,:,jk,jp_tem) * e1e2t(:,:) * fse3t(:,:,jk) )
+            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * tsn(:,:,jk,jp_sal) * e1e2t(:,:) * fse3t(:,:,jk) )
+         END DO
+         !
+      END SELECT
+      !
+   END SUBROUTINE trd_3d
+
+
+   SUBROUTINE trd_icp_init
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_icp_init  ***
+      !! 
+      !! ** Purpose :   Read the namtrd namelist
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trd_icp_init : integral constraints properties trends'
+         WRITE(numout,*) '~~~~~~~~~~~~~'
+      ENDIF
+
+      ! Total volume at t-points:
+      tvolt = 0._wp
+      DO jk = 1, jpkm1
+         tvolt = SUM( e1e2t(:,:) * fse3t(:,:,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
+
+#if  defined key_trddyn
+      ! Initialization of potential to kinetic energy conversion
+      rpktrd = 0._wp
+
+      ! Total volume at u-, v- points:
+      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) * fse3u(ji,jj,jk) * tmask_i(ji+1,jj  ) * tmask_i(ji,jj) * umask(ji,jj,jk)
+               tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * fse3v(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
+#endif
+      !
+   END SUBROUTINE trd_icp_init
+
+
+   SUBROUTINE trd_dwr( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_dwr  ***
+      !! 
+      !! ** Purpose :  write dynamic 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 and in situ densities
+
+         zcof = 0.5_wp / rau0             ! Density flux at w-point
+         zkz(:,:,1) = 0._wp
+         DO jk = 2, jpk
+            zkz(:,:,jk) = 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) * fse3u(ji,jj,jk) * un(ji,jj,jk) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) )
+                  zky(ji,jj,jk) = zcof * e1v(ji,jj) * fse3v(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) * fse3t(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) * fsdept(:,:,jk) * e1e2t(:,:) * fse3t(:,:,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(jpicpd_hpg) / tvolu, vmo(jpicpd_hpg) / tvolv
+            WRITE (numout,9502) umo(jpicpd_keg) / tvolu, vmo(jpicpd_keg) / tvolv
+            WRITE (numout,9503) umo(jpicpd_rvo) / tvolu, vmo(jpicpd_rvo) / tvolv
+            WRITE (numout,9504) umo(jpicpd_pvo) / tvolu, vmo(jpicpd_pvo) / tvolv
+            WRITE (numout,9505) umo(jpicpd_ldf) / tvolu, vmo(jpicpd_ldf) / tvolv
+            WRITE (numout,9506) umo(jpicpd_had) / tvolu, vmo(jpicpd_had) / tvolv
+            WRITE (numout,9507) umo(jpicpd_zad) / tvolu, vmo(jpicpd_zad) / tvolv
+            WRITE (numout,9508) umo(jpicpd_zdf) / tvolu, vmo(jpicpd_zdf) / tvolv
+            WRITE (numout,9509) umo(jpicpd_spg) / tvolu, vmo(jpicpd_spg) / tvolv
+            WRITE (numout,9510) umo(jpicpd_swf) / tvolu, vmo(jpicpd_swf) / tvolv
+            WRITE (numout,9511) umo(jpicpd_dat) / tvolu, vmo(jpicpd_dat) / tvolv
+            WRITE (numout,9512) umo(jpicpd_bfr) / tvolu, vmo(jpicpd_bfr) / tvolv
+            WRITE (numout,9513)
+            WRITE (numout,9514)                                                 &
+            &     (  umo(jpicpd_hpg) + umo(jpicpd_keg) + umo(jpicpd_rvo) + umo(jpicpd_pvo) + umo(jpicpd_ldf)   &
+            &      + umo(jpicpd_had) + umo(jpicpd_zad) + umo(jpicpd_zdf) + umo(jpicpd_spg) + umo(jpicpd_dat)   &
+            &      + umo(jpicpd_swf) + umo(jpicpd_bfr) ) / tvolu,   &
+            &     (  vmo(jpicpd_hpg) + vmo(jpicpd_keg) + vmo(jpicpd_rvo) + vmo(jpicpd_pvo) + vmo(jpicpd_ldf)   &
+            &      + vmo(jpicpd_had) + vmo(jpicpd_zad) + vmo(jpicpd_zdf) + vmo(jpicpd_spg) + vmo(jpicpd_dat)   &
+            &      + vmo(jpicpd_swf) + vmo(jpicpd_bfr) ) / tvolv
+         ENDIF
+
+ 9500    FORMAT(' momentum trend at it= ', i6, ' :', /' ==============================')
+ 9501    FORMAT(' 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(' coriolis term              u= ', e20.13, '    v= ', e20.13)
+ 9505    FORMAT(' horizontal diffusion       u= ', e20.13, '    v= ', e20.13)
+ 9506    FORMAT(' horizontal advection       u= ', e20.13, '    v= ', e20.13)
+ 9507    FORMAT(' vertical advection         u= ', e20.13, '    v= ', e20.13)
+ 9508    FORMAT(' vertical diffusion         u= ', e20.13, '    v= ', e20.13)
+ 9509    FORMAT(' surface pressure gradient  u= ', e20.13, '    v= ', e20.13)
+ 9510    FORMAT(' surface wind forcing       u= ', e20.13, '    v= ', e20.13)
+ 9511    FORMAT(' dampimg term               u= ', e20.13, '    v= ', e20.13)
+ 9512    FORMAT(' bottom flux                u= ', e20.13, '    v= ', e20.13)
+ 9513    FORMAT(' -----------------------------------------------------------------------------')
+ 9514    FORMAT(' total trend                u= ', e20.13, '    v= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9520) kt
+            WRITE (numout,9521) hke(jpicpd_hpg) / tvolt
+            WRITE (numout,9522) hke(jpicpd_keg) / tvolt
+            WRITE (numout,9523) hke(jpicpd_rvo) / tvolt
+            WRITE (numout,9524) hke(jpicpd_pvo) / tvolt
+            WRITE (numout,9525) hke(jpicpd_ldf) / tvolt
+            WRITE (numout,9526) hke(jpicpd_had) / tvolt
+            WRITE (numout,9527) hke(jpicpd_zad) / tvolt
+            WRITE (numout,9528) hke(jpicpd_zdf) / tvolt
+            WRITE (numout,9529) hke(jpicpd_spg) / tvolt
+            WRITE (numout,9530) hke(jpicpd_swf) / tvolt
+            WRITE (numout,9531) hke(jpicpd_dat) / tvolt
+            WRITE (numout,9532) hke(jpicpd_bfr) / tvolt
+            WRITE (numout,9533)
+            WRITE (numout,9534)   &
+            &     (  hke(jpicpd_hpg) + hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_pvo) + hke(jpicpd_ldf)   &
+            &      + hke(jpicpd_had) + hke(jpicpd_zad) + hke(jpicpd_zdf) + hke(jpicpd_spg) + hke(jpicpd_dat)   &
+            &      + hke(jpicpd_swf) + hke(jpicpd_bfr) ) / tvolt
+         ENDIF
+
+ 9520    FORMAT(' kinetic energy trend at it= ', i6, ' :', /' ====================================')
+ 9521    FORMAT(' pressure gradient         u2= ', e20.13)
+ 9522    FORMAT(' ke gradient               u2= ', e20.13)
+ 9523    FORMAT(' relative vorticity term   u2= ', e20.13)
+ 9524    FORMAT(' coriolis term             u2= ', e20.13)
+ 9525    FORMAT(' horizontal diffusion      u2= ', e20.13)
+ 9526    FORMAT(' horizontal advection      u2= ', e20.13)
+ 9527    FORMAT(' vertical advection        u2= ', e20.13)
+ 9528    FORMAT(' vertical diffusion        u2= ', e20.13)
+ 9529    FORMAT(' surface pressure gradient u2= ', e20.13)
+ 9530    FORMAT(' surface wind forcing      u2= ', e20.13)
+ 9531    FORMAT(' dampimg term              u2= ', e20.13)
+ 9532    FORMAT(' bottom flux               u2= ', e20.13)
+ 9533    FORMAT(' --------------------------------------------------')
+ 9534    FORMAT(' total trend               u2= ', e20.13)
+
+         IF(lwp) THEN
+            WRITE (numout,*)
+            WRITE (numout,*)
+            WRITE (numout,9540) kt
+            WRITE (numout,9541) ( hke(jpicpd_keg) + hke(jpicpd_rvo) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
+            WRITE (numout,9542) ( hke(jpicpd_keg) + hke(jpicpd_had) + hke(jpicpd_zad) ) / tvolt
+            WRITE (numout,9543) ( hke(jpicpd_pvo) ) / tvolt
+            WRITE (numout,9544) ( hke(jpicpd_rvo) ) / tvolt
+            WRITE (numout,9545) ( hke(jpicpd_spg) ) / tvolt
+            WRITE (numout,9546) ( hke(jpicpd_ldf) ) / tvolt
+            WRITE (numout,9547) ( hke(jpicpd_zdf) ) / tvolt
+            WRITE (numout,9548) ( hke(jpicpd_hpg) ) / tvolt, rpktrd / tvolt
+            WRITE (numout,*)
+            WRITE (numout,*)
+         ENDIF
+
+ 9540    FORMAT(' energetic consistency at it= ', i6, ' :', /' =========================================')
+ 9541    FORMAT(' 0 = non linear term(true if key_vorenergy or key_combined): ', e20.13)
+ 9542    FORMAT(' 0 = ke gradient + horizontal + vertical advection         : ', e20.13)
+ 9543    FORMAT(' 0 = coriolis term  (true if key_vorenergy or key_combined): ', e20.13)
+ 9544    FORMAT(' 0 = uh.( rot(u) x uh ) (true if enstrophy conser.)        : ', 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 trd_dwr
+
+
+   SUBROUTINE trd_twr( kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_twr  ***
+      !! 
+      !! ** Purpose :  write active tracers trends in ocean.output 
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!----------------------------------------------------------------------
+
+      ! 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(jpicpt_xad) / tvolt, smo(jpicpt_xad) / tvolt
+            WRITE (numout,9411)  tmo(jpicpt_yad) / tvolt, smo(jpicpt_yad) / tvolt
+            WRITE (numout,9402)  tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt
+            WRITE (numout,9403)  tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt
+            WRITE (numout,9404)  tmo(jpicpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt
+            WRITE (numout,9405)  tmo(jpicpt_npc) / tvolt, smo(jpicpt_npc) / tvolt
+            WRITE (numout,9406)  tmo(jpicpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt
+            WRITE (numout,9407)  tmo(jpicpt_qsr) / tvolt
+            WRITE (numout,9408)  tmo(jpicpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt
+            WRITE (numout,9409) 
+            WRITE (numout,9410) (  tmo(jpicpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf)   &
+            &                    + tmo(jpicpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt,   &
+            &                   (  smo(jpicpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf)   &
+            &                    + smo(jpicpt_npc) + smo(jpicpt_dmp)                   + smo(jpicpt_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(jpicpt_xad) / tvolt, s2(jpicpt_xad) / tvolt
+            WRITE (numout,9431)   t2(jpicpt_yad) / tvolt, s2(jpicpt_yad) / tvolt
+            WRITE (numout,9422)   t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt
+            WRITE (numout,9423)   t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt
+            WRITE (numout,9424)   t2(jpicpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt
+            WRITE (numout,9425)   t2(jpicpt_npc) / tvolt, s2(jpicpt_npc) / tvolt
+            WRITE (numout,9426)   t2(jpicpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt
+            WRITE (numout,9427)   t2(jpicpt_qsr) / tvolt
+            WRITE (numout,9428)   t2(jpicpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt
+            WRITE (numout,9429)
+            WRITE (numout,9430) (  t2(jpicpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf)   &
+            &                    + t2(jpicpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt,   &
+            &                   (  s2(jpicpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf)   &
+            &                    + s2(jpicpt_npc) + s2(jpicpt_dmp)                  + s2(jpicpt_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(jpicpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt,   &
+            &                   ( smo(jpicpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt
+            WRITE (numout,9442)   tmo(jpicpt_zl1)/tvolt,  smo(jpicpt_zl1)/tvolt
+            WRITE (numout,9443)   tmo(jpicpt_ldf)/tvolt,  smo(jpicpt_ldf)/tvolt
+            WRITE (numout,9444)   tmo(jpicpt_zdf)/tvolt,  smo(jpicpt_zdf)/tvolt
+            WRITE (numout,9445)   tmo(jpicpt_npc)/tvolt,  smo(jpicpt_npc)/tvolt
+            WRITE (numout,9446) ( t2(jpicpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt,    &
+            &                   ( s2(jpicpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt
+            WRITE (numout,9447)   t2(jpicpt_ldf)/tvolt,   s2(jpicpt_ldf)/tvolt
+            WRITE (numout,9448)   t2(jpicpt_zdf)/tvolt,   s2(jpicpt_zdf)/tvolt
+            WRITE (numout,9449)   t2(jpicpt_npc)/tvolt,   s2(jpicpt_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 trd_twr
+
+#   else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   INTERFACE trd_icp
+      MODULE PROCEDURE trd_2d, trd_3d
+   END INTERFACE
+
+CONTAINS
+   SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype )       ! Empty routine
+      REAL, DIMENSION(:,:) ::   ptrd2dx, ptrd2dy
+      INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
+      CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
+      WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', &
+          &       ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype
+   END SUBROUTINE trd_2d
+   SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype )       ! Empty routine
+      REAL, DIMENSION(:,:,:) ::   ptrd3dx, ptrd3dy
+      INTEGER                     , INTENT(in   ) ::   ktrd         ! tracer trend index
+      CHARACTER(len=3)            , INTENT(in   ) ::   ctype        ! momentum ('DYN') or tracers ('TRA') trends
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', &
+          &       ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype
+   END SUBROUTINE trd_3d
+   SUBROUTINE trd_icp_init               ! Empty routine
+   END SUBROUTINE trd_icp_init
+   SUBROUTINE trd_dwr( kt )          ! Empty routine
+      WRITE(*,*) 'trd_dwr: You should not have seen this print! error ?', kt
+   END SUBROUTINE trd_dwr
+   SUBROUTINE trd_twr( kt )          ! Empty routine
+      WRITE(*,*) 'trd_twr: You should not have seen this print! error ?', kt
+   END SUBROUTINE trd_twr
+#endif
+
+   !!======================================================================
+END MODULE trdicp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp_oce.F90	(revision 3437)
@@ -0,0 +1,90 @@
+MODULE trdicp_oce
+   !!======================================================================
+   !!                   ***  MODULE trdicp_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+
+   !!----------------------------------------------------------------------
+   !!   'key_trdtra'   or                         tracer trends diagnostics
+   !!   'key_trddyn'                            momentum trends diagnostics
+   !!----------------------------------------------------------------------
+   USE par_oce                 ! ocean parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+#if  defined key_trdtra   &&   defined key_trddyn    ||   defined key_esopa
+   LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag
+   LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag
+#elif  defined key_trdtra
+   LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag
+   LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag
+#elif  defined key_trddyn
+   LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag
+   LOGICAL, PARAMETER ::   lk_trddyn = .TRUE.    !: momentum trend flag
+#else
+   LOGICAL, PARAMETER ::   lk_trdtra = .FALSE.   !: tracers  trend flag
+   LOGICAL, PARAMETER ::   lk_trddyn = .FALSE.   !: momentum trend flag
+#endif
+
+   !                                        !!! => tracer trends indexes <=
+   INTEGER, PARAMETER ::   jpicpt_xad =  1   !: x- horizontal advection
+   INTEGER, PARAMETER ::   jpicpt_yad =  2   !: y- horizontal advection
+   INTEGER, PARAMETER ::   jpicpt_zad =  3   !: z- vertical   advection
+   INTEGER, PARAMETER ::   jpicpt_ldf =  4   !: lateral       diffusion
+   INTEGER, PARAMETER ::   jpicpt_zdf =  5   !: vertical diffusion (Kz)
+   INTEGER, PARAMETER ::   jpicpt_bbc =  6   !: Bottom Boundary Condition (geoth. flux) 
+   INTEGER, PARAMETER ::   jpicpt_bbl =  7   !: Bottom Boundary Layer (diffusive/convective)
+   INTEGER, PARAMETER ::   jpicpt_npc =  8   !: static instability mixing
+   INTEGER, PARAMETER ::   jpicpt_dmp =  9   !: damping
+   INTEGER, PARAMETER ::   jpicpt_qsr = 10   !: penetrative solar radiation
+   INTEGER, PARAMETER ::   jpicpt_nsr = 11   !: non solar radiation
+   INTEGER, PARAMETER ::   jpicpt_zl1 = 12   !: first level vertical flux
+
+   !                                        !!! => Total tracer trends indexes <=
+   INTEGER, PARAMETER ::   jptot_tra  = 12   !: change it when adding/removing one indice above
+   
+   !                                        !!! => dynamic trends indexes <=
+   INTEGER, PARAMETER ::   jpicpd_hpg =  1   !: hydrostatic pressure gradient 
+   INTEGER, PARAMETER ::   jpicpd_keg =  2   !: kinetic energy gradient
+   INTEGER, PARAMETER ::   jpicpd_rvo =  3   !: relative vorticity
+   INTEGER, PARAMETER ::   jpicpd_pvo =  4   !: planetary vorticity
+   INTEGER, PARAMETER ::   jpicpd_ldf =  5   !: lateral diffusion
+   INTEGER, PARAMETER ::   jpicpd_had =  6   !: horizontal advection
+   INTEGER, PARAMETER ::   jpicpd_zad =  7   !: vertical advection
+   INTEGER, PARAMETER ::   jpicpd_zdf =  8   !: vertical diffusion
+   INTEGER, PARAMETER ::   jpicpd_spg =  9   !: surface pressure gradient
+   INTEGER, PARAMETER ::   jpicpd_dat = 10   !: damping term
+   INTEGER, PARAMETER ::   jpicpd_swf = 11   !: surface wind forcing
+   INTEGER, PARAMETER ::   jpicpd_bfr = 12   !: bottom friction 
+
+   !                                        !!! => Total dynamic trends indexes <=
+   INTEGER, PARAMETER ::   jptot_dyn  = 12   !: change it when adding/removing one indice above
+   
+#if   defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa
+
+   !! 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
+
+   !! Tracers trends diagnostics variables
+   !!---------------------------------------------------------------------
+   REAL(wp), DIMENSION(jptot_tra) ::   tmo, smo         !: tracers trends average 
+   REAL(wp), DIMENSION(jptot_tra) ::   t2, s2           !: tracers square trends average 
+   
+   !! Momentum trends diagnostics variables
+   !!---------------------------------------------------------------------
+   REAL(wp), DIMENSION(jptot_dyn) ::   umo, vmo         !: momentum trends average 
+   REAL(wp), DIMENSION(jptot_dyn) ::   hke              !: momentum square trends average 
+   REAL(wp) ::   rpktrd   !: potential to kinetic energy conversion
+   REAL(wp) ::   peke     !: conversion potential energy - kinetic energy trend
+
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdicp_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90	(revision 3437)
@@ -0,0 +1,980 @@
+MODULE trdmld
+   !!======================================================================
+   !!                       ***  MODULE  trdmld  ***
+   !! Ocean diagnostics:  mixed layer T-S trends 
+   !!=====================================================================
+   !! History :       !  95-04  (J. Vialard)    Original code
+   !!                 !  97-02  (E. Guilyardi)  Adaptation global + base cmo
+   !!                 !  99-09  (E. Guilyardi)  Re-writing + netCDF output
+   !!            8.5  !  02-06  (G. Madec)      F90: Free form and module
+   !!            9.0  !  04-08  (C. Talandier)  New trends organization
+   !!                 !  05-05  (C. Deltel)     Diagnose trends of time averaged ML T & S
+   !!----------------------------------------------------------------------
+#if   defined key_trdmld   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld'                          mixed layer trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mld          : T and S cumulated trends averaged over the mixed layer
+   !!   trd_mld_zint     : T and S trends vertical integration
+   !!   trd_mld_init     : initialization step
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and tracers variables
+   USE dom_oce         ! ocean space and time domain variables
+   USE trdmod_oce      ! ocean variables trends
+   USE trdmld_oce      ! ocean variables trends
+   USE ldftra_oce      ! ocean active tracers lateral physics
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   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 ioipsl          ! NetCDF library
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE diadimg         ! dimg direct access file format output
+   USE trdmld_rst      ! restart for diagnosing the ML trends
+   USE prtctl          ! Print control
+   USE restart         ! for lrst_oce
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_mld        ! routine called by step.F90
+   PUBLIC   trd_mld_init   ! routine called by opa.F90
+   PUBLIC   trd_mld_zint   ! routine called by tracers routines
+
+   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 "domzgr_substitute.h90"
+#  include "ldftra_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
+
+   INTEGER FUNCTION trd_mld_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ndextrd1(jpi*jpj) , STAT=trd_mld_alloc )
+      !
+      IF( lk_mpp             )   CALL mpp_sum ( trd_mld_alloc )
+      IF( trd_mld_alloc /= 0 )   CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1')
+   END FUNCTION trd_mld_alloc
+
+
+   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_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 ) ::   pttrdmld   ! temperature trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   pstrdmld   ! 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        
+         !
+         tmltrd(:,:,:) = 0.e0    ;    smltrd(:,:,:) = 0.e0    ! <<< reset trend arrays to zero
+         
+         ! ... Set nmld(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 
+            nmld(:,:) = nmln(:,:)    ! array nmln computed in zdfmxl.F90
+         ELSE IF( nn_ctls == 1 ) THEN  ! * control surface = read index from file 
+            nmld(:,:) = nbol(:,:)
+         ELSE IF( nn_ctls >= 2 ) THEN  ! * control surface = model level
+            nn_ctls = MIN( nn_ctls, jpktrd - 1 )
+            nmld(:,:) = nn_ctls + 1
+         ENDIF
+
+         ! ... Compute ndextrd1 and ndimtrd1 only once
+         IF( ionce == 1 ) THEN
+            !
+            ! Check of validity : nmld(ji,jj) <= jpktrd
+            isum        = 0
+            zvlmsk(:,:) = 0.e0
+
+            IF( jpktrd < jpk ) THEN 
+               DO jj = 1, jpj
+                  DO ji = 1, jpi
+                     IF( nmld(ji,jj) <= jpktrd ) THEN
+                        zvlmsk(ji,jj) = tmask(ji,jj,1)
+                     ELSE
+                        isum = isum + 1
+                        zvlmsk(ji,jj) = 0.
+                     ENDIF
+                  END DO
+               END DO
+            ENDIF
+
+            ! Index of ocean points (2D only)
+            IF( isum > 0 ) THEN
+               WRITE(numout,*)' Number of invalid points nmld > jpktrd', isum 
+               CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 )    ! surface
+            ELSE 
+               CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 )    ! surface
+            ENDIF                                
+
+            ionce = 0                ! no more pass here
+            !
+         END IF
+         
+         ! ... Weights for vertical averaging
+         wkx(:,:,:) = 0.e0
+         DO jk = 1, jpktrd             ! initialize wkx with vertical scale factor in mixed-layer
+            DO jj = 1,jpj
+               DO ji = 1,jpi
+                  IF( jk - nmld(ji,jj) < 0.e0 )   wkx(ji,jj,jk) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         
+         rmld(:,:) = 0.e0                ! compute mixed-layer depth : rmld
+         DO jk = 1, jpktrd
+            rmld(:,:) = rmld(:,:) + wkx(:,:,jk)
+         END DO
+         
+         DO jk = 1, jpktrd             ! compute integration weights
+            wkx(:,:,jk) = wkx(:,:,jk) / MAX( 1., rmld(:,:) )
+         END DO
+
+         icount = 0                    ! <<< flag = off : control surface & integr. weights
+         !                             !     computed only once per time step
+      END IF
+
+      ! II. Vertical integration of trends in the mixed-layer
+      ! -----------------------------------------------------
+
+      SELECT CASE (ctype)
+      CASE ( '3D' )   ! mean T/S trends in the mixed-layer
+         DO jk = 1, jpktrd
+            tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,jk) * wkx(:,:,jk)   ! temperature
+            smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,jk) * wkx(:,:,jk)   ! salinity
+         END DO
+      CASE ( '2D' )   ! forcing at upper boundary of the mixed-layer
+         tmltrd(:,:,ktrd) = tmltrd(:,:,ktrd) + pttrdmld(:,:,1) * wkx(:,:,1)        ! non penetrative
+         smltrd(:,:,ktrd) = smltrd(:,:,ktrd) + pstrdmld(:,:,1) * wkx(:,:,1)            
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, zvlmsk ) 
+      !
+   END SUBROUTINE trd_mld_zint
+    
+
+   SUBROUTINE trd_mld( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld  ***
+      !! 
+      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
+      !!               period, and write NetCDF (or dimg) outputs.
+      !!
+      !! ** Method/usage :
+      !!          The stored trends can be chosen twofold (according to the ln_trdmld_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_trdmld_instant=.false.
+      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmld_instant=.true.
+      !!
+      !! ** Action :
+      !!       At each time step, mixed-layer averaged trends are stored in the 
+      !!       tmltrd(:,:,jpmld_xxx) array (see trdmld_oce.F90 for definitions of jpmld_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
+      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
+#if defined key_dimgout
+      INTEGER ::  iyear,imon,iday
+      CHARACTER(LEN=80) :: cltext, clmode
+#endif
+      !!----------------------------------------------------------------------
+  
+      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                                                               )
+
+      ! ======================================================================
+      ! 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( T ) and (-1/h) * K_z * d_z( S ))
+      IF( ln_traldf_iso ) THEN
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               ik = nmld(ji,jj)
+               zavt = avt(ji,jj,ik)
+               tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  &
+                  &                      * ( tsn(ji,jj,ik-1,jp_tem) - tsn(ji,jj,ik,jp_tem) )         &
+                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)
+               zavt = fsavs(ji,jj,ik)
+               smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  &
+                  &                      * ( tsn(ji,jj,ik-1,jp_sal) - tsn(ji,jj,ik,jp_sal) )         &
+                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)
+            END DO
+         END DO
+
+         ! ... Remove this K_z trend from the iso-neutral diffusion term (if any)
+         tmltrd(:,:,jpmld_ldf) = tmltrd(:,:,jpmld_ldf) - tmltrd(:,:,jpmld_zdf)
+         smltrd(:,:,jpmld_ldf) = smltrd(:,:,jpmld_ldf) - smltrd(:,:,jpmld_zdf)
+      END IF
+
+      ! ... Lateral boundary conditions
+      DO jl = 1, jpltrd
+         CALL lbc_lnk( tmltrd(:,:,jl), 'T', 1. )
+         CALL lbc_lnk( smltrd(:,:,jl), 'T', 1. )
+      END DO
+
+      ! ======================================================================
+      ! 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(:,:,jpmld_atf) ; smlatfn(:,:) = smltrd(:,:,jpmld_atf)
+      END IF
+
+      ! II.2 Vertically averaged T and S
+      ! --------------------------------
+      tml(:,:) = 0.e0   ;   sml(:,:) = 0.e0
+      DO jk = 1, jpktrd - 1
+         tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem)
+         sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal)
+      END DO
+
+      ! 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
+
+         rmldbn(:,:) = rmld(:,:)
+
+         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_trdmld_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=rmldbn         , clinfo1=' rmldbn          -  : ', 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       (:,:)
+         rmld_sum      (:,:)   = rmld_sum      (:,:)   + rmld      (:,:)   ! rmld
+         !
+      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 trdmld(:,:,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  = float(nmoymltrd)    ;    zfn2 = zfn * zfn
+         
+         ! III.1 Prepare fields for output ("instantaneous" diagnostics) 
+         ! -------------------------------------------------------------
+         
+         !-- Compute total trends
+         ztmltot(:,:) = ( tml(:,:) - tmlbn(:,:) + tmlb(:,:) - tmlbb(:,:) ) / ( 2.*rdt )
+         zsmltot(:,:) = ( sml(:,:) - smlbn(:,:) + smlb(:,:) - smlbb(:,:) ) / ( 2.*rdt )
+         
+         !-- 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. )
+
+#if defined key_diainstant
+         CALL ctl_stop( 'tml_trd : key_diainstant was never checked within trdmld. Comment this to proceed.')
+#endif
+         ! III.2 Prepare fields for output ("mean" diagnostics) 
+         ! ----------------------------------------------------
+         
+         !-- Update the ML depth time sum (to build the Leap-Frog time mean)
+         rmld_sum(:,:) = rmldbn(:,:) + 2 * ( rmld_sum(:,:) - rmld(:,:) ) + rmld(:,:)
+
+         !-- Compute temperature total trends
+         tml_sum (:,:) = tmlbn(:,:) + 2 * ( tml_sum(:,:) - tml(:,:) ) + tml(:,:)
+         ztmltot2(:,:) = ( tml_sum(:,:) - tml_sumb(:,:) ) /  ( 2.*rdt )    ! now in degC/s
+         
+         !-- Compute salinity total trends
+         sml_sum (:,:) = smlbn(:,:) + 2 * ( sml_sum(:,:) - sml(:,:) ) + sml(:,:)
+         zsmltot2(:,:) = ( sml_sum(:,:) - sml_sumb(:,:) ) /  ( 2.*rdt )    ! 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(:,:,jpmld_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(:,:,jpmld_atf) + smltrd_atf_sumb(:,:) )
+         
+         !-- Diagnose Asselin trend over the analysis window
+         ztmlatf2(:,:) = ztmltrd2(:,:,jpmld_atf) - tmltrd_sum(:,:,jpmld_atf) + tmltrd_atf_sumb(:,:)
+         zsmlatf2(:,:) = zsmltrd2(:,:,jpmld_atf) - smltrd_sum(:,:,jpmld_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(:,:,jpmld_atf)
+         
+         ! For S mean diagnostics 
+         smltrd_csum_ub (:,:,:) = zfn * smltrd_sum(:,:,:) - smltrd_csum_ln(:,:,:)
+         sml_sumb       (:,:)   = sml_sum(:,:)
+         smltrd_atf_sumb(:,:)   = smltrd_sum(:,:,jpmld_atf)
+         
+         ! ML depth
+         rmldbn         (:,:)   = rmld    (:,:)
+         
+         IF( ln_ctl ) THEN
+            IF( ln_trdmld_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=rmldbn         , clinfo1=' rmldbn          -  : ', 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
+
+         rmld_sum(:,:)   = rmld_sum(:,:)  /  (2*zfn)  ! similar to tml_sum and sml_sum
+
+         ! * Debugging information *
+         IF( lldebug ) THEN
+            !
+            WRITE(numout,*)
+            WRITE(numout,*) 'trd_mld : 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 jpmld_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 jpmld_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
+      ! ======================================================================
+
+      ! IV.1 Code for dimg mpp output
+      ! -----------------------------
+
+#if defined key_dimgout
+
+      IF( MOD( itmod, nn_trd ) == 0 ) THEN
+         iyear =  ndastp/10000
+         imon  = (ndastp-iyear*10000)/100
+         iday  =  ndastp - imon*100 - iyear*10000
+         WRITE(clname,9000) TRIM(cexper),'MLDiags',iyear,imon,iday
+         WRITE(clmode,'(f5.1,a)') nn_trd*rdt/86400.,' days average'
+         cltext = TRIM(cexper)//' mld diags'//TRIM(clmode)
+         CALL dia_wri_dimg (clname, cltext, smltrd, jpltrd, '2')
+      END IF
+
+9000  FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
+
+#else
+      
+      ! IV.2 Code for IOIPSL/NetCDF output
+      ! ----------------------------------
+
+      IF( lwp .AND. MOD( itmod , nn_trd ) == 0 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'trd_mld : write trends in the NetCDF file :'
+         WRITE(numout,*) '~~~~~~~  '
+         WRITE(numout,*) '          ', TRIM(clhstnam), ' at kt = ', kt
+         WRITE(numout,*) '          N.B. nmoymltrd = ', nmoymltrd
+         WRITE(numout,*) ' '
+      END IF
+         
+      !-- Write the trends for T/S instantaneous diagnostics 
+      IF( ln_trdmld_instant ) THEN           
+
+         CALL histwrite( nidtrd, "mxl_depth", it, rmld(:,:), ndimtrd1, ndextrd1 )
+         
+         !................................. ( ML temperature ) ...................................
+         
+         !-- Output the fields
+         CALL histwrite( nidtrd, "tml"     , it, tml    (:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "tml_tot" , it, ztmltot(:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "tml_res" , it, ztmlres(:,:), ndimtrd1, ndextrd1 ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL histwrite( nidtrd, trim("tml"//ctrd(jl,2)),            &
+                 &          it, tmltrd (:,:,jl), ndimtrd1, ndextrd1 )
+         END DO
+         
+         CALL histwrite( nidtrd, trim("tml"//ctrd(jpmld_atf,2)),        &
+              &          it, ztmlatf(:,:), ndimtrd1, ndextrd1 )
+         
+         !.................................. ( ML salinity ) .....................................
+         
+         !-- Output the fields
+         CALL histwrite( nidtrd, "sml"     , it, sml    (:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "sml_tot" , it, zsmltot(:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "sml_res" , it, zsmlres(:,:), ndimtrd1, ndextrd1 ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL histwrite( nidtrd, trim("sml"//ctrd(jl,2)),            &
+                 &          it, smltrd(:,:,jl), ndimtrd1, ndextrd1 )
+         END DO
+         
+         CALL histwrite( nidtrd, trim("sml"//ctrd(jpmld_atf,2)),        &
+              &          it, zsmlatf(:,:), ndimtrd1, ndextrd1 )
+         
+         IF( kt == nitend )   CALL histclo( nidtrd )
+
+      !-- Write the trends for T/S mean diagnostics 
+      ELSE
+         
+         CALL histwrite( nidtrd, "mxl_depth", it, rmld_sum(:,:), ndimtrd1, ndextrd1 ) 
+         
+         !................................. ( ML temperature ) ...................................
+         
+         !-- Output the fields
+         CALL histwrite( nidtrd, "tml"     , it, tml_sum (:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "tml_tot" , it, ztmltot2(:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "tml_res" , it, ztmlres2(:,:), ndimtrd1, ndextrd1 ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL histwrite( nidtrd, trim("tml"//ctrd(jl,2)),            &
+                 &          it, ztmltrd2(:,:,jl), ndimtrd1, ndextrd1 )
+         END DO
+         
+         CALL histwrite( nidtrd, trim("tml"//ctrd(jpmld_atf,2)),        &
+              &          it, ztmlatf2(:,:), ndimtrd1, ndextrd1 )
+         
+         !.................................. ( ML salinity ) .....................................
+                     
+         !-- Output the fields
+         CALL histwrite( nidtrd, "sml"     , it, sml_sum (:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "sml_tot" , it, zsmltot2(:,:), ndimtrd1, ndextrd1 ) 
+         CALL histwrite( nidtrd, "sml_res" , it, zsmlres2(:,:), ndimtrd1, ndextrd1 ) 
+         
+         DO jl = 1, jpltrd - 1
+            CALL histwrite( nidtrd, trim("sml"//ctrd(jl,2)),            &
+                 &          it, zsmltrd2(:,:,jl), ndimtrd1, ndextrd1 )
+         END DO
+         
+         CALL histwrite( nidtrd, trim("sml"//ctrd(jpmld_atf,2)),        &
+              &          it, zsmlatf2(:,:), ndimtrd1, ndextrd1 )
+         
+         IF( kt == nitend )   CALL histclo( nidtrd )
+
+      END IF
+      
+      ! Compute the control surface (for next time step) : flag = on
+      icount = 1
+      !
+#endif
+
+      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
+
+         rmld_sum       (:,:)   = 0.e0
+         !
+      END IF
+
+      ! ======================================================================
+      ! V. Write restart file
+      ! ======================================================================
+
+      IF( lrst_oce )   CALL trd_mld_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_mld
+
+
+   SUBROUTINE trd_mld_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_init  ***
+      !! 
+      !! ** Purpose :   computation of vertically integrated T and S budgets
+      !!      from ocean surface down to control surface (NetCDF output)
+      !!----------------------------------------------------------------------
+      INTEGER :: jl
+      INTEGER :: inum   ! logical unit
+      REAL(wp) ::   zjulian, zsto, zout
+      CHARACTER (LEN=40) ::   clop
+      CHARACTER (LEN=12) ::   clmxl, cltu, clsu
+      !!----------------------------------------------------------------------
+
+      ! ======================================================================
+      ! I. initialization
+      ! ======================================================================
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mld_init : Mixed-layer trends'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~'
+         WRITE(numout,*) '                namelist namtrd read in trd_mod_init                        '
+         WRITE(numout,*)
+      END IF
+
+      ! I.1 Check consistency of user defined preferences
+      ! -------------------------------------------------
+
+      IF( ( lk_trdmld ) .AND. ( 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 sea-ice frequency parameter (typically 5) '
+         nstop = nstop + 1
+      END IF
+
+      IF( ( lk_trdmld ) .AND. ( nn_cla == 1 ) ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) '                You set n_cla = 1. Note that the Mixed-Layer diagnostics  '
+         WRITE(numout,*) '                are not exact along the corresponding straits.            '
+         nwarn = nwarn + 1
+      END IF
+
+      !                                   ! allocate trdmld arrays
+      IF( trd_mld_alloc()    /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld     arrays' )
+      IF( trdmld_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trd_mld_init : unable to allocate trdmld_oce arrays' )
+
+      ! 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
+
+      rmld           (:,:)   = 0.e0            
+      rmld_sum       (:,:)   = 0.e0
+
+      IF( ln_rstart .AND. ln_trdmld_restart ) THEN
+         CALL trd_mld_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
+      ! ======================================================================
+
+#if defined key_dimgout 
+      ???
+#else
+      ! 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.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
+      IF( .NOT. ln_trdmld_instant ) THEN
+         CALL ctl_stop( 'trd_mld : this was never checked. Comment this line to proceed...' )
+      END IF
+      zsto = nn_trd * rdt
+      clop = "inst("//TRIM(clop)//")"
+#  else
+      IF( ln_trdmld_instant ) THEN
+         zsto = rdt                 ! inst. diags : we use IOIPSL time averaging
+      ELSE
+         zsto = nn_trd * rdt          ! mean  diags : we DO NOT use any IOIPSL time averaging
+      END IF
+      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 (nidtrd)
+      ! ------------------------------------------
+      !-- Define long and short names for the NetCDF output variables
+      !       ==> choose them according to trdmld_oce.F90 <==
+
+      ctrd(jpmld_xad,1) = " Zonal advection"                  ;   ctrd(jpmld_xad,2) = "_xad"
+      ctrd(jpmld_yad,1) = " Meridional advection"             ;   ctrd(jpmld_yad,2) = "_yad"
+      ctrd(jpmld_zad,1) = " Vertical advection"               ;   ctrd(jpmld_zad,2) = "_zad"
+      ctrd(jpmld_ldf,1) = " Lateral diffusion"                ;   ctrd(jpmld_ldf,2) = "_ldf"
+      ctrd(jpmld_for,1) = " Forcing"                          ;   ctrd(jpmld_for,2) = "_for"
+      ctrd(jpmld_zdf,1) = " Vertical diff. (Kz)"              ;   ctrd(jpmld_zdf,2) = "_zdf"
+      ctrd(jpmld_bbc,1) = " Geothermal flux"                  ;   ctrd(jpmld_bbc,2) = "_bbc"
+      ctrd(jpmld_bbl,1) = " Adv/diff. Bottom boundary layer"  ;   ctrd(jpmld_bbl,2) = "_bbl"
+      ctrd(jpmld_dmp,1) = " Tracer damping"                   ;   ctrd(jpmld_dmp,2) = "_dmp"
+      ctrd(jpmld_npc,1) = " Non penetrative convec. adjust."  ;   ctrd(jpmld_npc,2) = "_npc"
+      ctrd(jpmld_atf,1) = " Asselin time filter"              ;   ctrd(jpmld_atf,2) = "_atf"
+                                                                  
+      !-- Create a NetCDF file and enter the define mode 
+      CALL dia_nam( clhstnam, nn_trd, 'trends' )
+      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
+      CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
+      &             1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_t, nidtrd, domain_id=nidom, snc4chunks=snc4set )
+
+      !-- Define the ML depth variable
+      CALL histdef(nidtrd, "mxl_depth", clmxl//"  Mixed Layer Depth"              , "m",         &
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )
+
+      !-- 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
+
+
+      !-- Define miscellaneous T and S mixed-layer variables 
+
+      IF( jpltrd /= jpmld_atf ) CALL ctl_stop( 'Error : jpltrd /= jpmld_atf' ) ! see below
+
+      !................................. ( ML temperature ) ...................................
+
+      CALL histdef(nidtrd, "tml"      , clmxl//" T Mixed Layer Temperature"       ,  "C",        &
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )           
+      CALL histdef(nidtrd, "tml_tot",   clmxl//" T Total trend"                   , cltu,        & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )              
+      CALL histdef(nidtrd, "tml_res",   clmxl//" T dh/dt Entrainment (Resid.)"    , cltu,        & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )                   
+      
+      DO jl = 1, jpltrd - 1      ! <== only true if jpltrd == jpmld_atf
+         CALL histdef(nidtrd, trim("tml"//ctrd(jl,2)), clmxl//" T"//ctrd(jl,1), cltu,            & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean
+      END DO                                                                 ! if zsto=rdt above
+      
+      CALL histdef(nidtrd, trim("tml"//ctrd(jpmld_atf,2)), clmxl//" T"//ctrd(jpmld_atf,1), cltu, & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean
+      
+      !.................................. ( ML salinity ) .....................................
+     
+      CALL histdef(nidtrd, "sml"      , clmxl//" S Mixed Layer Salinity"          , "p.s.u.",       &
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout )           
+      CALL histdef(nidtrd, "sml_tot",   clmxl//" S Total trend"                   , clsu,        & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )              
+      CALL histdef(nidtrd, "sml_res",   clmxl//" S dh/dt Entrainment (Resid.)"    , clsu,        & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout )                   
+      
+      DO jl = 1, jpltrd - 1      ! <== only true if jpltrd == jpmld_atf
+         CALL histdef(nidtrd, trim("sml"//ctrd(jl,2)), clmxl//" S"//ctrd(jl,1), clsu,            & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean
+      END DO                                                                 ! if zsto=rdt above
+      
+      CALL histdef(nidtrd, trim("sml"//ctrd(jpmld_atf,2)), clmxl//" S"//ctrd(jpmld_atf,1), clsu, & 
+                   jpi, jpj, nh_t, 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean
+
+      !-- Leave IOIPSL/NetCDF define mode
+      CALL histend( nidtrd, snc4set )
+
+#endif        /* key_dimgout */
+   END SUBROUTINE trd_mld_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trd_mld( kt )             ! Empty routine
+      INTEGER, INTENT( in) ::   kt
+      WRITE(*,*) 'trd_mld: You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mld
+   SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype )
+      REAL, DIMENSION(:,:,:), INTENT( in ) ::   &
+         pttrdmld, pstrdmld                   ! Temperature and Salinity trends
+      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
+      CHARACTER(len=2), INTENT( in ) ::   &  
+         ctype                                ! surface/bottom (2D arrays) or
+         !                                    ! interior (3D arrays) physics
+      WRITE(*,*) 'trd_mld_zint: You should not have seen this print! error?', pttrdmld(1,1,1)
+      WRITE(*,*) '  "      "  : You should not have seen this print! error?', pstrdmld(1,1,1)
+      WRITE(*,*) '  "      "  : You should not have seen this print! error?', ctype
+      WRITE(*,*) '  "      "  : You should not have seen this print! error?', ktrd
+   END SUBROUTINE trd_mld_zint
+   SUBROUTINE trd_mld_init              ! Empty routine
+      WRITE(*,*) 'trd_mld_init: You should not have seen this print! error?'
+   END SUBROUTINE trd_mld_init
+#endif
+
+   !!======================================================================
+END MODULE trdmld
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90	(revision 3437)
@@ -0,0 +1,136 @@
+MODULE trdmld_oce
+   !!======================================================================
+   !!                   ***  MODULE trdmld_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+   !! History :  1.0  ! 2004-08  (C. Talandier)  New trends organization
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trdmld_oce_alloc    ! Called in trdmld.F90
+
+#if defined key_trdmld
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .TRUE.    !: ML trend flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdmld = .FALSE.   !: ML trend flag
+#endif
+   !!* mixed layer trends indices
+   INTEGER, PARAMETER, PUBLIC ::   jpltrd = 11      !: number of mixed-layer trends arrays
+   INTEGER, PUBLIC            ::   jpktrd           !: max level for mixed-layer trends diag.
+   !
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_xad =  1   !:  zonal      
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_yad =  2   !:  meridonal   > advection
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_zad =  3   !:  vertical   
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_ldf =  4   !:  lateral diffusion (geopot. or iso-neutral)
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_for =  5   !:  forcing 
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_zdf =  6   !:  vertical diffusion (TKE)
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_bbc =  7   !:  geothermal flux
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_bbl =  8   !:  bottom boundary layer (advective/diffusive)
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_dmp =  9   !:  internal restoring trend
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_npc = 10   !:  non penetrative convective adjustment
+!! INTEGER, PUBLIC, PARAMETER ::   jpmld_xxx = xx   !:  add here any additional trend (add change jpltrd)
+   INTEGER, PUBLIC, PARAMETER ::   jpmld_atf = 11   !:  asselin trend (**MUST BE THE LAST ONE**)
+
+#if   defined  key_trdmld   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld'                         mixed layer trends diagnostics
+   !!----------------------------------------------------------------------
+
+   !! Arrays used for diagnosing mixed-layer trends 
+   !!---------------------------------------------------------------------
+   CHARACTER(LEN=80) , PUBLIC :: clname, ctrd(jpltrd+1,2)
+
+   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   nmld   !: 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(:,:)   ::  &
+      rmld   ,                      & !: mld 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,              & !: 
+      rmld_sum, rmldbn                !: 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                  !: 
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+  INTEGER FUNCTION trdmld_oce_alloc()
+     !!----------------------------------------------------------------------
+     !!                 ***  FUNCTION trdmld_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
+
+#if   defined  key_trdmld   ||   defined key_esopa
+     ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj),       &
+        &      wkx(jpi,jpj,jpk), rmld(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),            &
+        &      rmld_sum(jpi,jpj), rmldbn(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) )
+#endif
+      !
+      trdmld_oce_alloc = MAXVAL( ierr )
+      IF( lk_mpp                )   CALL mpp_sum ( trdmld_oce_alloc )
+      IF( trdmld_oce_alloc /= 0 )   CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trdmld_oce_alloc
+
+   !!======================================================================
+END MODULE trdmld_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_rst.F90	(revision 3437)
@@ -0,0 +1,208 @@
+MODULE trdmld_rst
+   !!=================================================================================
+   !!                       ***  MODULE  trdmld_rst  ***
+   !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+   !!=================================================================================
+   !! History :  9.0  ! 05-05 (C. Deltel) Original code
+   !!---------------------------------------------------------------------------------
+#if defined key_trdmld
+   !!---------------------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain
+   USE trdmod_oce      ! ocean variables for trend diagnostics (i.e. icp/mixed-layer/vorticity)
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE restart         ! only for lrst_oce
+
+   IMPLICIT NONE
+   PRIVATE
+  
+   PUBLIC   trd_mld_rst_read    ! routine called by trd_mld_init
+   PUBLIC   trd_mld_rst_write   ! routine called by step.F90
+  
+   INTEGER ::   nummldw         ! logical unit for mld restart
+
+   !!---------------------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+  
+CONTAINS
+  
+   SUBROUTINE trd_mld_rst_write( kt )
+      !!--------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE trd_mld_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   ! ice output restart file name
+      !!--------------------------------------------------------------------------------
+
+      ! to get better performances with NetCDF format:
+      ! we open and define the ocean restart_mld file one time step before writing the data (-> at nitrst - 1)
+      ! except if we write ocean restart_mld files every time step or if an ocean restart_mld 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)
+         IF(lwp) THEN
+            WRITE(numout,*)
+            SELECT CASE ( jprstlib )
+            CASE ( jprstdimg )   ;   WRITE(numout,*) '             open ocean restart_mld binary file: '//clname
+            CASE DEFAULT         ;   WRITE(numout,*) '             open ocean restart_mld 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( clname, nummldw, ldwrt = .TRUE., kiolib = jprstlib )
+      ENDIF
+
+      IF( kt == nitrst .AND. lwp ) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trdmld_rst: output for ML diags. restart, with trd_mld_rst_write routine kt =', kt
+         WRITE(numout,*) '~~~~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+
+      IF( ln_trdmld_instant ) THEN 
+         !-- Temperature
+         CALL iom_rstput( kt, nitrst, nummldw, 'tmlbb'           , tmlbb           )
+         CALL iom_rstput( kt, nitrst, nummldw, 'tmlbn'           , tmlbn           )
+         CALL iom_rstput( kt, nitrst, nummldw, 'tmlatfb'         , tmlatfb         )
+
+         !-- Salinity
+         CALL iom_rstput( kt, nitrst, nummldw, 'smlbb'           , smlbb           )
+         CALL iom_rstput( kt, nitrst, nummldw, 'smlbn'           , smlbn           )
+         CALL iom_rstput( kt, nitrst, nummldw, 'smlatfb'         , smlatfb         )
+      ELSE
+         CALL iom_rstput( kt, nitrst, nummldw, 'rmldbn'          , rmldbn          )
+
+         !-- Temperature
+         CALL iom_rstput( kt, nitrst, nummldw, 'tmlbn'           , tmlbn           )
+         CALL iom_rstput( kt, nitrst, nummldw, '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, nummldw, charout,  tmltrd_csum_ub(:,:,jk) )
+         ENDDO
+         CALL iom_rstput( kt, nitrst, nummldw, 'tmltrd_atf_sumb' , tmltrd_atf_sumb )
+
+         !-- Salinity
+         CALL iom_rstput( kt, nitrst, nummldw, 'smlbn'           , smlbn           )
+         CALL iom_rstput( kt, nitrst, nummldw, '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, nummldw, charout , smltrd_csum_ub(:,:,jk) )
+         ENDDO
+         CALL iom_rstput( kt, nitrst, nummldw, 'smltrd_atf_sumb' , smltrd_atf_sumb )
+      ENDIF
+      !
+      IF( kt == nitrst ) THEN
+         CALL iom_close( nummldw )     ! close the restart file (only at last time step)
+         lrst_oce = .FALSE.
+      ENDIF
+      ! 
+      !    
+   END SUBROUTINE trd_mld_rst_write
+
+
+   SUBROUTINE trd_mld_rst_read
+    !!----------------------------------------------------------------------------
+    !!                   ***  SUBROUTINE trd_mld_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
+    !!-----------------------------------------------------------------------------
+
+    IF(lwp)  THEN
+       WRITE(numout,*)
+       WRITE(numout,*) ' trd_mld_rst_read : read the NetCDF MLD restart file'
+       WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+    ENDIF
+    IF ( jprstlib == jprstdimg ) THEN
+       ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+       ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90
+       INQUIRE( FILE = TRIM(cn_trdrst_in)//'.nc', EXIST = llok )
+       IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+    ENDIF
+
+    CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt ) 
+
+    IF( ln_trdmld_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, 'rmldbn'          , rmldbn         ) ! needed for rmld_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) )
+       ENDDO
+       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) )
+       ENDDO
+       CALL iom_get( inum, jpdom_autoglo, 'smltrd_atf_sumb' , smltrd_atf_sumb)
+
+       CALL iom_close( inum )
+    ENDIF
+
+  END SUBROUTINE trd_mld_rst_read
+  
+#else
+  !!=================================================================================
+  !!                       ***  MODULE  trdmld_rst  ***
+  !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+  !!=================================================================================
+CONTAINS
+  SUBROUTINE trd_mld_rst_write( kt )           !  No ML diags ==> empty routine
+    WRITE(*,*) 'trd_mld_rst_wri: You should not have seen this print! error?', kt
+  END SUBROUTINE trd_mld_rst_write
+  SUBROUTINE trd_mld_rst_read                  !  No ML Diags ==> empty routine
+  END SUBROUTINE trd_mld_rst_read
+#endif
+
+  !!=================================================================================
+END MODULE trdmld_rst
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90	(revision 3437)
@@ -0,0 +1,281 @@
+MODULE trdmod
+   !!======================================================================
+   !!                       ***  MODULE  trdmod  ***
+   !! Ocean diagnostics:  ocean tracers and dynamic trends
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!             -   !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
+   !!----------------------------------------------------------------------
+#if  defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   trd_mod          : Call the trend to be computed
+   !!   trd_mod_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 trdmod_oce              ! ocean variables trends
+   USE ldftra_oce              ! ocean active tracers lateral physics
+   USE sbc_oce                 ! surface boundary condition: ocean
+   USE phycst                  ! physical constants
+   USE trdvor                  ! ocean vorticity trends 
+   USE trdicp                  ! ocean bassin integral constraints properties
+   USE trdmld                  ! ocean active mixed layer tracers trends 
+   USE in_out_manager          ! I/O manager
+   USE lib_mpp                 ! MPP library
+   USE wrk_nemo                ! Memory allocation
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   REAL(wp) ::   r2dt          ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0
+
+   PUBLIC trd_mod              ! called by all dynXX or traXX modules
+   PUBLIC trd_mod_init         ! called by opa.F90 module
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt )
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod  ***
+      !! 
+      !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 
+      !!              integral constraints
+      !!----------------------------------------------------------------------
+      !
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdx   ! Temperature or U trend 
+      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   ptrdy   ! Salinity    or V trend
+      CHARACTER(len=3)          , INTENT(in   ) ::   ctype   ! momentum or tracers trends type 'DYN'/'TRA'
+      INTEGER                   , INTENT(in   ) ::   kt      ! time step
+      INTEGER                   , INTENT(in   ) ::   ktrd    ! tracer trend index
+      !!
+      INTEGER ::   ji, jj   ! dummy loop indices
+      REAL(wp), POINTER, DIMENSION(:,:)  :: ztswu, ztswv, ztbfu, ztbfv, z2dx, z2dy 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, ztswu, ztswv, ztbfu, ztbfv, z2dx, z2dy )
+
+      z2dx(:,:) = 0._wp   ;   z2dy(:,:) = 0._wp                            ! initialization of workspace arrays
+
+      IF( neuler == 0 .AND. kt == nit000    ) THEN   ;   r2dt =      rdt   ! = rdtra (restart with Euler time stepping)
+      ELSEIF(               kt <= nit000 + 1) THEN   ;   r2dt = 2. * rdt   ! = 2 rdttra (leapfrog)
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! I. Integral Constraints Properties for momentum and/or tracers trends
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      IF( ( mod(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN
+         !
+         IF( lk_trdtra .AND. ctype == 'TRA' )   THEN       ! active tracer trends
+            SELECT CASE ( ktrd )
+            CASE ( jptra_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype )   ! lateral diff
+            CASE ( jptra_trd_zdf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype )   ! vertical diff (Kz)
+            CASE ( jptra_trd_bbc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype )   ! bottom boundary cond
+            CASE ( jptra_trd_bbl )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype )   ! bottom boundary layer
+            CASE ( jptra_trd_npc )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype )   ! static instability mixing
+            CASE ( jptra_trd_dmp )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype )   ! damping
+            CASE ( jptra_trd_qsr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype )   ! penetrative solar radiat.
+            CASE ( jptra_trd_nsr )   ;   z2dx(:,:) = ptrdx(:,:,1)   
+                                         z2dy(:,:) = ptrdy(:,:,1)
+                                         CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype )   ! non solar radiation
+            CASE ( jptra_trd_xad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype )   ! x- horiz adv
+            CASE ( jptra_trd_yad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype )   ! y- horiz adv
+            CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv 
+                                         CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   
+                                         ! compute the surface flux condition wn(:,:,1)*tsn(:,:,1,jp_tem)
+                                         z2dx(:,:) = wn(:,:,1)*tsn(:,:,1,jp_tem)/fse3t(:,:,1)
+                                         z2dy(:,:) = wn(:,:,1)*tsn(:,:,1,jp_sal)/fse3t(:,:,1)
+                                         CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )   ! 1st z- vertical adv 
+            END SELECT
+         END IF
+
+         IF( lk_trddyn .AND. ctype == 'DYN' )   THEN       ! momentum trends 
+            !
+            SELECT CASE ( ktrd )
+            CASE ( jpdyn_trd_hpg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_hpg, ctype )   ! hydrost. pressure grad
+            CASE ( jpdyn_trd_keg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_keg, ctype )   ! KE gradient 
+            CASE ( jpdyn_trd_rvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_rvo, ctype )   ! relative vorticity 
+            CASE ( jpdyn_trd_pvo )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_pvo, ctype )   ! planetary vorticity
+            CASE ( jpdyn_trd_ldf )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_ldf, ctype )   ! lateral diffusion 
+            CASE ( jpdyn_trd_had )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_had, ctype )   ! horizontal advection 
+            CASE ( jpdyn_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_zad, ctype )   ! vertical advection 
+            CASE ( jpdyn_trd_spg )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_spg, ctype )   ! surface pressure grad.
+            CASE ( jpdyn_trd_dat )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_dat, ctype )   ! damping term
+            CASE ( jpdyn_trd_zdf )                                                         ! vertical diffusion 
+               ! subtract surface forcing/bottom friction trends 
+               ! from vertical diffusive momentum trends
+               ztswu(:,:) = 0._wp   ;   ztswv(:,:) = 0._wp
+               ztbfu(:,:) = 0._wp   ;   ztbfv(:,:) = 0._wp 
+               DO jj = 2, jpjm1   
+                  DO ji = fs_2, fs_jpim1   ! vector opt.
+                     ! save the surface forcing momentum fluxes
+                     ztswu(ji,jj) = utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
+                     ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
+                     ! bottom friction contribution now handled explicitly
+                     ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj)
+                     ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj)
+                  END DO
+               END DO
+               !
+               CALL trd_icp( ptrdx, ptrdy, jpicpd_zdf, ctype )   
+               CALL trd_icp( ztswu, ztswv, jpicpd_swf, ctype )                               ! wind stress forcing term
+               ! bottom friction contribution now handled explicitly
+            CASE ( jpdyn_trd_bfr )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpd_bfr, ctype )     ! bottom friction term
+            END SELECT
+            !
+         END IF
+         !
+      END IF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! II. Vorticity trends
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      IF( lk_trdvor .AND. ctype == 'DYN' )   THEN
+         !
+         SELECT CASE ( ktrd ) 
+         CASE ( jpdyn_trd_hpg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg )   ! Hydrostatique Pressure Gradient 
+         CASE ( jpdyn_trd_keg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg )   ! KE Gradient 
+         CASE ( jpdyn_trd_rvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo )   ! Relative Vorticity 
+         CASE ( jpdyn_trd_pvo )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo )   ! Planetary Vorticity Term 
+         CASE ( jpdyn_trd_ldf )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf )   ! Horizontal Diffusion 
+         CASE ( jpdyn_trd_had )   ;   CALL ctl_warn('Vorticity for horizontal advection trend never checked')   
+         CASE ( jpdyn_trd_zad )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad )   ! Vertical Advection 
+         CASE ( jpdyn_trd_spg )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg )   ! Surface Pressure Grad. 
+         CASE ( jpdyn_trd_dat )   ;   CALL trd_vor_zint( ptrdx, ptrdy, jpvor_bev )   ! Beta V  
+         CASE ( jpdyn_trd_zdf )                                                      ! Vertical Diffusion 
+            ! subtract surface forcing/bottom friction trends 
+            ! from vertical diffusive momentum trends
+            ztswu(:,:) = 0.e0   ;   ztswv(:,:) = 0.e0
+            ztbfu(:,:) = 0.e0   ;   ztbfv(:,:) = 0.e0  
+            DO jj = 2, jpjm1   
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! save the surface forcing momentum fluxes
+                  ztswu(ji,jj) = utau(ji,jj) / ( fse3u(ji,jj,1)*rau0 )
+                  ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 )
+                  !
+                  ptrdx(ji,jj,1     ) = ptrdx(ji,jj,1     ) - ztswu(ji,jj)
+                  ptrdy(ji,jj,1     ) = ptrdy(ji,jj,1     ) - ztswv(ji,jj)
+               END DO
+            END DO
+            !
+            CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zdf )   
+            CALL trd_vor_zint( ztswu, ztswv, jpvor_swf )                               ! Wind stress forcing term
+         CASE ( jpdyn_trd_bfr )
+            CALL trd_vor_zint( ptrdx, ptrdy, jpvor_bfr )                               ! Bottom friction term
+         END SELECT
+         !
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! III. Mixed layer trends for active tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+      IF( lk_trdmld .AND. ctype == 'TRA' )   THEN
+         
+         !-----------------------------------------------------------------------------------------------
+         ! W.A.R.N.I.N.G :
+         ! jptra_trd_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_trd_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_mld)
+         !-----------------------------------------------------------------------------------------------
+
+         SELECT CASE ( ktrd )
+         CASE ( jptra_trd_xad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' )   ! merid. advection
+         CASE ( jptra_trd_yad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' )   ! zonal  advection
+         CASE ( jptra_trd_zad )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' )   ! vertical advection
+         CASE ( jptra_trd_ldf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! lateral diffusive
+         CASE ( jptra_trd_bbl )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' )   ! bottom boundary layer
+         CASE ( jptra_trd_zdf )
+            IF( ln_traldf_iso )   THEN
+               CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' )   ! vertical diffusion (K_z)
+            ELSE
+               CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' )   ! vertical diffusion (K_z)
+            ENDIF
+         CASE ( jptra_trd_dmp )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' )   ! internal 3D restoring (tradmp)
+         CASE ( jptra_trd_qsr )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' )   ! air-sea : penetrative sol radiat
+         CASE ( jptra_trd_nsr )
+            ptrdx(:,:,2:jpk) = 0.e0   ;   ptrdy(:,:,2:jpk) = 0.e0
+            CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' )                             ! air-sea : non penetr sol radiat
+         CASE ( jptra_trd_bbc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' )   ! bottom bound cond (geoth flux)
+         CASE ( jptra_trd_atf )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' )   ! asselin numerical
+         CASE ( jptra_trd_npc )   ;   CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' )   ! non penetr convect adjustment
+         END SELECT
+
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, ztswu, ztswv, ztbfu, ztbfv, z2dx, z2dy )
+      !
+   END SUBROUTINE trd_mod
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default case :                                         Empty module
+   !!----------------------------------------------------------------------
+   USE trdmod_oce      ! ocean variables trends
+   USE trdvor          ! ocean vorticity trends 
+   USE trdicp          ! ocean bassin integral constraints properties
+   USE trdmld          ! ocean active mixed layer tracers trends 
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt )   ! Empty routine
+      REAL(wp) ::   ptrd3dx(:,:,:), ptrd3dy(:,:,:)
+      INTEGER  ::   ktrd, kt                            
+      CHARACTER(len=3) ::  ctype                  
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1)
+      WRITE(*,*) ' "   ": You should not have seen this print! error ?', ktrd, ctype, kt
+   END SUBROUTINE trd_mod
+#endif
+
+   SUBROUTINE trd_mod_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod_init  ***
+      !! 
+      !! ** Purpose :   Initialization of activated trends
+      !!----------------------------------------------------------------------
+      USE in_out_manager          ! I/O manager
+      !!    
+      NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant
+      !!----------------------------------------------------------------------
+
+      IF( l_trdtra .OR. l_trddyn )   THEN
+         REWIND( numnam )
+         READ  ( numnam, namtrd )      ! namelist namtrd : trends diagnostic
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' trd_mod_init : Momentum/Tracers trends'
+            WRITE(numout,*) ' ~~~~~~~~~~~~~'
+            WRITE(numout,*) '   Namelist namtrd : set trends parameters'
+            WRITE(numout,*) '      frequency of trends diagnostics   nn_trd             = ', nn_trd
+            WRITE(numout,*) '      control surface type              nn_ctls            = ', nn_ctls
+            WRITE(numout,*) '      restart for ML diagnostics        ln_trdmld_restart  = ', ln_trdmld_restart
+            WRITE(numout,*) '      instantaneous or mean ML T/S      ln_trdmld_instant  = ', ln_trdmld_instant
+            WRITE(numout,*) '      unit conversion factor            rn_ucf             = ', rn_ucf
+        ENDIF
+      ENDIF
+      !
+      IF( lk_trddyn .OR. lk_trdtra )    CALL trd_icp_init       ! integral constraints trends
+      IF( lk_trdmld                )    CALL trd_mld_init       ! mixed-layer trends (active  tracers)  
+      IF( lk_trdvor                )    CALL trd_vor_init       ! vorticity trends        
+      !
+   END SUBROUTINE trd_mod_init
+
+   !!======================================================================
+END MODULE trdmod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_oce.F90	(revision 3437)
@@ -0,0 +1,79 @@
+MODULE trdmod_oce
+   !!======================================================================
+   !!                   ***  MODULE trdmod_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!----------------------------------------------------------------------
+   USE trdicp_oce              ! ocean momentum/tracers bassin properties trends variables
+   USE trdmld_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 *
+   INTEGER , PUBLIC  ::   nn_trd  = 10                    !: time step frequency dynamics and tracers trends
+   INTEGER , PUBLIC  ::   nn_ctls =  0                    !: control surface type for trends vertical integration
+   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) ::   cn_trdrst_in  = "restart_mld"   !: suffix of ocean restart name (input)
+   CHARACTER(len=32) ::   cn_trdrst_out = "restart_mld"   !: suffix of ocean restart name (output)
+   LOGICAL , PUBLIC  ::   ln_trdmld_instant = .FALSE.     !: flag to diagnose inst./mean ML T/S trends
+   LOGICAL , PUBLIC  ::   ln_trdmld_restart = .FALSE.     !: flag to restart mixed-layer diagnostics
+
+# if defined key_trdtra   ||   defined key_trdmld
+   LOGICAL , PUBLIC ::   l_trdtra = .TRUE.                !: tracers  trend flag
+# else
+   LOGICAL , PUBLIC ::   l_trdtra = .FALSE.               !: tracers  trend flag
+# endif
+# if defined key_trddyn   ||   defined key_trdvor
+   LOGICAL , PUBLIC ::   l_trddyn = .TRUE.                !: momentum trend flag
+# else
+   LOGICAL , PUBLIC ::   l_trddyn = .FALSE.               !: momentum trend flag
+# endif
+# if ( defined key_trdtrc && defined key_iomput )  ||  defined key_trdmld_trc
+   LOGICAL , PUBLIC ::   l_trdtrc = .TRUE.                !: tracers  trend flag
+# else
+   LOGICAL , PUBLIC ::   l_trdtrc = .FALSE.               !: tracers  trend flag
+# endif
+   !                                                     !!!* Active tracers trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1     !: x- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2     !: y- horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zad =  3     !: z- vertical   advection
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_ldf =  4     !: lateral       diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_zdf =  5     !: vertical diffusion (Kz)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbc =  6     !: Bottom Boundary Condition (geoth. flux) 
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_bbl =  7     !: Bottom Boundary Layer (diffusive/convective)
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_npc =  8     !: static instability mixing
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_dmp =  9     !: damping
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_qsr = 10     !: penetrative solar radiation
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_nsr = 11     !: non solar radiation
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12     !: Asselin correction
+#if defined key_top
+   !                                                     !!!* Passive tracers trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_sms  = 13    !: sources m. sinks
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radn = 14    !: corr. trn<0 in trcrad
+   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_radb = 15    !: corr. trb<0 in trcrad (like atf)
+#endif
+   
+   !                                                     !!!* Momentum trends indexes
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1     !: hydrostatic pressure gradient 
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2     !: kinetic energy gradient
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_rvo =  3     !: relative vorticity
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_pvo =  4     !: planetary vorticity
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_ldf =  5     !: lateral diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_had =  6     !: horizontal advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zad =  7     !: vertical advection
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_zdf =  8     !: vertical diffusion
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_spg =  9     !: surface pressure gradient
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_dat = 10     !: damping term
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_swf = 11     !: surface wind forcing
+   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_bfr = 12     !: bottom friction 
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdmod_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod_trc.F90	(revision 3437)
@@ -0,0 +1,23 @@
+MODULE trdmod_trc
+   !!======================================================================
+   !!                       ***  MODULE trdmod_trc  ***
+   !!  Dummy module
+   !!======================================================================
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                             NO TOP use
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt )
+      INTEGER ::   kt, kjn, ktrd   
+      REAL    ::   ptrtrd(:,:,:)  
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn, ktrd, kt
+   END SUBROUTINE trd_mod_trc
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE trdmod_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90	(revision 3437)
@@ -0,0 +1,210 @@
+MODULE trdtra
+   !!======================================================================
+   !!                       ***  MODULE  trdtra  ***
+   !! Ocean diagnostics:  ocean tracers trends
+   !!=====================================================================
+   !! History :  1.0  !  2004-08  (C. Talandier) Original code
+   !!            2.0  !  2005-04  (C. Deltel)    Add Asselin trend in the ML budget
+   !!            3.3  !  2010-06  (C. Ethe) merge TRA-TRC 
+   !!----------------------------------------------------------------------
+#if  defined key_trdtra || defined key_trdtrc || defined key_trdmld || defined key_trdmld_trc 
+   !!----------------------------------------------------------------------
+   !!   trd_tra      : Call the trend to be computed
+   !!----------------------------------------------------------------------
+   USE dom_oce          ! ocean domain 
+   USE trdmod_oce       ! ocean active mixed layer tracers trends 
+   USE trdmod           ! ocean active mixed layer tracers trends 
+   USE trdmod_trc       ! ocean passive mixed layer tracers trends 
+   USE in_out_manager   ! I/O manager
+   USE lib_mpp          ! MPP library
+   USE wrk_nemo        ! Memory allocation
+
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trd_tra          ! called by all  traXX modules
+ 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: trdtx, trdty, trdt  !:
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  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 trd_tra_alloc()
+      !!----------------------------------------------------------------------------
+      !!                  ***  FUNCTION trd_tra_alloc  ***
+      !!----------------------------------------------------------------------------
+      ALLOCATE( trdtx(jpi,jpj,jpk) , trdty(jpi,jpj,jpk) , trdt(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 : Dispatch all trends computation, e.g. vorticity, mld or 
+      !!              integral constraints
+      !!
+      !! ** Method/usage : For the mixed-layer trend, the control surface can be either
+      !!       a mixed layer depth (time varying) or a fixed surface (jk level or bowl). 
+      !!      Choose control surface with nn_ctls in namelist NAMTRD :
+      !!        nn_ctls = 0  : use mixed layer with density criterion 
+      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx'
+      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls
+      !!----------------------------------------------------------------------
+      !
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend  or flux
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pun     ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variablea
+      !
+      REAL(wp), POINTER, DIMENSION(:,:,:)  ::  ztrds
+      !!----------------------------------------------------------------------
+
+      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
+      
+      ! Control of optional arguments
+      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx ) 
+            CASE( jptra_trd_yad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty ) 
+            CASE( jptra_trd_zad )  ;  CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  ) 
+            END SELECT
+         ELSE
+            trdt(:,:,:) = ptrd(:,:,:)
+            IF( ktrd == jptra_trd_bbc .OR. ktrd == jptra_trd_qsr ) THEN
+               ztrds(:,:,:) = 0.
+               CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )
+            END IF
+         END IF
+      END IF
+
+      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN 
+         IF( PRESENT( ptra ) ) THEN    
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod( trdtx, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod( trdty, ztrds, ktrd, ctype, kt   )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod( trdt , ztrds, ktrd, ctype, kt   )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod( trdt, ztrds, ktrd, ctype, kt )  
+         END IF
+      END IF
+
+      IF( ctype == 'TRC' ) THEN
+         !
+         IF( PRESENT( ptra ) ) THEN  
+            SELECT CASE( ktrd )            ! shift depending on the direction
+            CASE( jptra_trd_xad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'X', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_yad )  
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Y', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            CASE( jptra_trd_zad )    
+                                CALL trd_tra_adv( ptrd, pun, ptra, 'Z', ztrds ) 
+                                CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )
+            END SELECT
+         ELSE
+            ztrds(:,:,:) = ptrd(:,:,:)
+            CALL trd_mod_trc( ztrds, ktra, ktrd, kt       )  
+         END IF
+         !
+      ENDIF
+      !
+      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 the i-, j- or k-advective flux into thes
+      !!              i-, j- or k-advective trends, resp.
+      !! ** Method  :   i-advective trends = -un. di-1[T] = -( di-1[fi] - tn di-1[un] )
+      !!                k-advective trends = -un. di-1[T] = -( dj-1[fi] - tn dj-1[un] )
+      !!                k-advective trends = -un. di+1[T] = -( dk+1[fi] - tn dk+1[un] )
+      !!----------------------------------------------------------------------
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pf      ! advective flux in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   pun     ! now velocity  in one direction
+      REAL(wp)        , INTENT(in ), DIMENSION(jpi,jpj,jpk) ::   ptn     ! now or before tracer 
+      CHARACTER(len=1), INTENT(in )                         ::   cdir    ! X/Y/Z direction
+      REAL(wp)        , INTENT(out), DIMENSION(jpi,jpj,jpk) ::   ptrd    ! advective trend in one direction
+      !
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   ii, ij, ik   ! index shift function of the direction
+      REAL(wp) ::   zbtr         ! local scalar
+      !!----------------------------------------------------------------------
+
+      SELECT CASE( cdir )            ! shift depending on the direction
+      CASE( 'X' )   ;   ii = 1   ; ij = 0   ;   ik = 0      ! i-advective trend
+      CASE( 'Y' )   ;   ii = 0   ; ij = 1   ;   ik = 0      ! j-advective trend
+      CASE( 'Z' )   ;   ii = 0   ; ij = 0   ;   ik =-1      ! k-advective trend
+      END SELECT
+
+      !                              ! set to zero uncomputed values
+      ptrd(jpi,:,:) = 0.e0   ;   ptrd(1,:,:) = 0.e0
+      ptrd(:,jpj,:) = 0.e0   ;   ptrd(:,1,:) = 0.e0
+      ptrd(:,:,jpk) = 0.e0
+      !
+      !
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zbtr    = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               ptrd(ji,jj,jk) = - zbtr * (      pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik)                    &
+                 &                          - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO
+      !
+   END SUBROUTINE trd_tra_adv
+
+#   else
+   !!----------------------------------------------------------------------
+   !!   Default case :          Dummy module           No trend diagnostics
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean variables trends
+CONTAINS
+   SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pu, ptra )
+      !!----------------------------------------------------------------------
+      INTEGER                         , INTENT(in)           ::  kt      ! time step
+      CHARACTER(len=3)                , INTENT(in)           ::  ctype   ! tracers trends type 'TRA'/'TRC'
+      INTEGER                         , INTENT(in)           ::  ktra    ! tracer index
+      INTEGER                         , INTENT(in)           ::  ktrd    ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)           ::  ptrd    ! tracer trend 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  pu      ! velocity 
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL ::  ptra    ! Tracer variable 
+      WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd(1,1,1), ptra(1,1,1), pu(1,1,1),   &
+         &                                                               ktrd, ktra, ctype, kt
+   END SUBROUTINE trd_tra
+#   endif
+   !!======================================================================
+END MODULE trdtra
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90	(revision 3437)
@@ -0,0 +1,615 @@
+MODULE trdvor
+   !!======================================================================
+   !!                       ***  MODULE  trdvor  ***
+   !! Ocean diagnostics:  momentum trends
+   !!=====================================================================
+   !! History :  1.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code 
+   !!            2.0  !  04-2008  (C. Talandier) New trends organization
+   !!----------------------------------------------------------------------
+#if defined key_trdvor   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdvor'   : momentum trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   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 trdmod_oce      ! ocean variables trends
+   USE zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE phycst          ! Define parameters for the routines
+   USE ldfdyn_oce      ! ocean active tracers: lateral physics
+   USE dianam          ! build the name of file (routine)
+   USE zdfmxl          ! mixed layer depth
+   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 step.F90
+   PUBLIC   trd_vor_zint   ! routine called by dynamics routines
+   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 "domzgr_substitute.h90"
+#  include "ldfdyn_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_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_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) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
+               zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
+            END DO
+         END DO
+         !
+      CASE (jpvor_swf)        ! wind stress
+         zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
+         zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
+         !
+      END SELECT
+
+      ! Average except for Beta.V
+      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
+   
+      ! 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) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)
+        zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
+      END DO
+
+      ! Save Beta.V term to avoid average before Curl
+      ! Beta.V : intergration, no average
+      IF( ktrd == jpvor_bev ) THEN 
+         zubet(:,:) = zudpvor(:,:)
+         zvbet(:,:) = zvdpvor(:,:)
+      ENDIF
+
+      ! Average except for Beta.V
+      zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
+      zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
+   
+      ! 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)
+
+      ! Special treatement for the Beta.V term
+      ! Compute the Curl of the Beta.V term which is not averaged
+      IF( ktrd == jpvor_bev ) THEN
+         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 on the Curl
+         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:)
+
+         ! Surface mask
+         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * fmask(:,:,1)
+      ENDIF
+   
+      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( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_vor  ***
+      !! 
+      !! ** Purpose :  computation of cumulated trends over analysis period
+      !!               and make outputs (NetCDF or DIMG format)
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices
+      INTEGER  ::   it, itmod        ! local integers
+      REAL(wp) ::   zmean            ! local scalars
+      REAL(wp), 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(:,:)
+
+      IF( ndebug /= 0 ) THEN
+          WRITE(numout,*) ' debuging trd_vor: I.1 done '
+          CALL FLUSH(numout)
+      ENDIF
+
+      ! 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) * fse3u(:,:,jk)
+         zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
+      END DO
+ 
+      zun(:,:) = zun(:,:) * hur(:,:)
+      zvn(:,:) = zvn(:,:) * hvr(:,:)
+
+      ! Curl
+      DO ji=1,jpim1
+         DO jj=1,jpjm1
+            vor_avr(ji,jj) = (  ( zvn(ji+1,jj) - zvn(ji,jj) )    &
+               &              - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
+         END DO
+      END DO
+      
+      IF( ndebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_vor: I.2 done'
+         CALL FLUSH(numout)
+      ENDIF
+
+      !  =================================
+      !   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
+
+      IF( ndebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_vor: I1.1 done'
+         CALL FLUSH(numout)
+      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
+
+      IF( ndebug /= 0 ) THEN
+         WRITE(numout,*) ' debuging trd_vor: II.2 done'
+         CALL FLUSH(numout)
+      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
+
+         IF( ndebug /= 0 ) THEN
+             WRITE(numout,*) ' zmean = ',zmean
+             WRITE(numout,*) ' debuging trd_vor: III.1 done'
+             CALL FLUSH(numout)
+         ENDIF
+
+         ! 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. )
+
+         IF( ndebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_vor: III.2 done'
+            CALL FLUSH(numout)
+         ENDIF
+
+         ! III.3 time evolution array swap
+         ! ------------------------------
+         vor_avrbb(:,:) = vor_avrb(:,:)
+         vor_avrbn(:,:) = vor_avr (:,:)
+
+         IF( ndebug /= 0 ) THEN
+            WRITE(numout,*) ' debuging trd_vor: III.3 done'
+            CALL FLUSH(numout)
+         ENDIF
+         !
+         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
+
+
+   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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+   INTERFACE trd_vor_zint
+      MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
+   END INTERFACE
+CONTAINS
+   SUBROUTINE trd_vor( kt )        ! Empty routine
+      WRITE(*,*) 'trd_vor: You should not have seen this print! error?', kt
+   END SUBROUTINE trd_vor
+   SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
+      REAL, DIMENSION(:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
+      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
+      WRITE(*,*) 'trd_vor_zint_2d: You should not have seen this print! error?', putrdvor(1,1), pvtrdvor(1,1), ktrd
+   END SUBROUTINE trd_vor_zint_2d
+   SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
+      REAL, DIMENSION(:,:,:), INTENT( inout ) ::   putrdvor, pvtrdvor
+      INTEGER, INTENT( in ) ::   ktrd         ! ocean trend index
+      WRITE(*,*) 'trd_vor_zint_3d: You should not have seen this print! error?', putrdvor(1,1,1), pvtrdvor(1,1,1), ktrd
+   END SUBROUTINE trd_vor_zint_3d
+   SUBROUTINE trd_vor_init              ! Empty routine
+      WRITE(*,*) 'trd_vor_init: You should not have seen this print! error?'
+   END SUBROUTINE trd_vor_init
+#endif
+   !!======================================================================
+END MODULE trdvor
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor_oce.F90	(revision 3437)
@@ -0,0 +1,40 @@
+MODULE trdvor_oce
+   !!======================================================================
+   !!                   ***  MODULE trdvor_oce  ***
+   !! Ocean trends :   set vorticity trend variables
+   !!======================================================================
+   !! History :  9.0  !  04-2006  (L. Brunier, A-M. Treguier) Original code 
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce      ! ocean parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+#if defined key_trdvor
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .TRUE.    !: momentum trend flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trdvor = .FALSE.   !: momentum trend flag
+#endif
+   !                                               !!* 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90	(revision 3437)
@@ -0,0 +1,67 @@
+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   ||   defined key_esopa
+   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   = 1.e-4_wp   !: vertical eddy viscosity (m2/s)
+   REAL(wp), PUBLIC ::   rn_avt0   = 1.e-5_wp   !: vertical eddy diffusivity (m2/s)
+   INTEGER , PUBLIC ::   nn_avb    =  0         !: constant or profile background on avt (=0/1)
+   INTEGER , PUBLIC ::   nn_havtb  = 1          !: horizontal shape or not for avtb (=0/1)
+   LOGICAL , PUBLIC ::   ln_zdfexp = .FALSE.    !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_zdfexp = 3          !: number of sub-time step (explicit time stepping)
+   LOGICAL , PUBLIC ::   ln_zdfevd = .TRUE.     !: convection: enhanced vertical diffusion flag
+   INTEGER , PUBLIC ::   nn_evdm   = 1          !: =0/1 flag to apply enhanced avm or not
+   REAL(wp), PUBLIC ::   rn_avevd  = 1._wp      !: vertical eddy coeff. for enhanced vert. diff. (m2/s)
+   LOGICAL , PUBLIC ::   ln_zdfnpc = .FALSE.    !: convection: non-penetrative convection flag
+   INTEGER , PUBLIC ::   nn_npc    =   1        !: non penetrative convective scheme call  frequency
+   INTEGER , PUBLIC ::   nn_npcp   =  15        !: non penetrative convective scheme print frequency
+
+
+   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(:,:,:) ::   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]
+ 
+   !!----------------------------------------------------------------------
+   !! 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) ,      &
+         &     avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk)           ,      &
+         &     avmv(jpi,jpj,jpk), avt(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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90	(revision 3437)
@@ -0,0 +1,289 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the type of bottom friction chosen
+   !!   zdf_bfr_init : read in namelist and control the bottom friction parameters.
+   !!   zdf_bfr_2d   : read in namelist and control the bottom friction parameters.
+   !!----------------------------------------------------------------------
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_bfr         ! called by step.F90
+   PUBLIC   zdf_bfr_init    ! called by opa.F90
+
+   !                                    !!* Namelist nambfr: bottom friction namelist *
+   INTEGER  ::   nn_bfr    = 0           ! = 0/1/2/3 type of bottom friction 
+   REAL(wp) ::   rn_bfri1  = 4.0e-4_wp   ! bottom drag coefficient (linear case) 
+   REAL(wp) ::   rn_bfri2  = 1.0e-3_wp   ! bottom drag coefficient (non linear case)
+   REAL(wp) ::   rn_bfeb2  = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2]
+   REAL(wp) ::   rn_bfrien = 30._wp      ! local factor to enhance coefficient bfri
+   LOGICAL  ::   ln_bfr2d  = .false.     ! logical switch for 2D enhancement
+   LOGICAL , PUBLIC                            ::  ln_bfrimp = .false.  ! logical switch for implicit bottom friction
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  bfrcoef2d            ! 2D bottom drag coefficient
+
+   !! * Substitutions
+#  include "vectopt_loop_substitute.h90"
+#  include "domzgr_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), 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  ::   ikbu, ikbv   ! local integers
+      REAL(wp) ::   zvu, zuv, zecu, zecv   ! temporary scalars
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_bfr')
+      !
+      IF( nn_bfr == 2 ) THEN                 ! quadratic botton friction
+         ! Calculate and store the quadratic bottom friction coefficient bfrua and bfrva
+         ! where bfrUa = C_d*SQRT(u_bot^2 + v_bot^2 + e_b) {U=[u,v]}
+         ! from these the trend due to bottom friction:  -F_h/e3U  can be calculated
+         ! where -F_h/e3U_bot = bfrUa*Ub/e3U_bot {U=[u,v]}
+         !
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+!CDIR NOVERRCHK
+            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+# else
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = 2, jpim1
+# endif
+               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 * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji+1,jj  ) ) * zecu 
+               bfrva(ji,jj) = - 0.5_wp * ( bfrcoef2d(ji,jj) + bfrcoef2d(ji  ,jj+1) ) * zecv
+            END DO
+         END DO
+         !
+         CALL lbc_lnk( bfrua, 'U', 1. )   ;   CALL lbc_lnk( bfrva, 'V', 1. )      ! Lateral boundary condition
+         !
+         IF(ln_ctl)   CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr  - u: ', mask1=umask,        &
+            &                       tab2d_2=bfrva, clinfo2=       ' v: ', mask2=vmask,ovlap=1 )
+      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 nammbf 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 ::   ikbu, ikbv   ! temporary integers
+      INTEGER ::   ictu, ictv   !    -          -
+      REAL(wp) ::  zminbfr, zmaxbfr   ! temporary scalars
+      REAL(wp) ::  zfru, zfrv         !    -         -
+      !!
+      NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2, ln_bfr2d, rn_bfrien, ln_bfrimp
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_bfr_init')
+      !
+      REWIND ( numnam )               !* Read Namelist nam_bfr : bottom momentum boundary condition
+      READ   ( numnam, nambfr )
+
+      !                               !* Parameter control and print
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+      IF(lwp) WRITE(numout,*) '   Namelist nam_bfr : set bottom friction parameters'
+
+      !                              ! allocate zdfbfr arrays
+      IF( zdf_bfr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_bfr_init : unable to allocate arrays' )
+
+      !                              ! 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
+
+      SELECT CASE (nn_bfr)
+      !
+      CASE( 0 )
+         IF(lwp) WRITE(numout,*) '      free-slip '
+         bfrua(:,:) = 0.e0
+         bfrva(:,:) = 0.e0
+         !
+      CASE( 1 )
+         IF(lwp) WRITE(numout,*) '      linear botton friction'
+         IF(lwp) WRITE(numout,*) '      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
+         !
+         bfrcoef2d(:,:) = rn_bfri1  ! initialize bfrcoef2d to the namelist variable
+         !
+         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(:,:) )
+         ENDIF
+         bfrua(:,:) = - bfrcoef2d(:,:)
+         bfrva(:,:) = - bfrcoef2d(:,:)
+         !
+      CASE( 2 )
+         IF(lwp) WRITE(numout,*) '      quadratic botton friction'
+         IF(lwp) WRITE(numout,*) '      friction coef.   rn_bfri2  = ', rn_bfri2
+         IF(lwp) WRITE(numout,*) '      background tke   rn_bfeb2  = ', rn_bfeb2
+         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
+         bfrcoef2d(:,:) = rn_bfri2  ! initialize bfrcoef2d to the namelist variable
+         !
+         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(:,:) )
+         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
+      !
+      ! 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
+      !
+#  if defined key_vectopt_loop
+      DO jj = 1, 1
+!CDIR NOVERRCHK
+         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
+#  else
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = 2, jpim1
+#  endif
+             ikbu = mbku(ji,jj)       ! deepest ocean level at u- and v-points
+             ikbv = mbkv(ji,jj)
+             zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt
+             zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt
+             IF( ABS( bfrcoef2d(ji,jj) ) > zfru ) THEN
+                IF( ln_ctl ) THEN
+                   WRITE(numout,*) 'BFR ', narea, nimpp+ji, njmpp+jj, ikbu
+                   WRITE(numout,*) 'BFR ', ABS( bfrcoef2d(ji,jj) ), zfru
+                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) ) )  )
+         END DO
+      END DO
+      IF( lk_mpp ) THEN
+         CALL mpp_sum( ictu )
+         CALL mpp_sum( ictv )
+         CALL mpp_min( zminbfr )
+         CALL mpp_max( zmaxbfr )
+      ENDIF
+      IF( .NOT.ln_bfrimp) THEN
+      IF( lwp .AND. ictu + ictv > 0 ) THEN
+         WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '
+         WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '
+         WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr
+         WRITE(numout,*) ' Bottom 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90	(revision 3437)
@@ -0,0 +1,250 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_zdfddm   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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 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
+   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   rrau   !: heat/salt buoyancy flux ratio
+
+   !                                  !!* Namelist namzdf_ddm : double diffusive mixing *
+   REAL(wp) ::   rn_avts  = 1.e-4_wp   ! maximum value of avs for salt fingering
+   REAL(wp) ::   rn_hsbfr = 1.6_wp     ! heat/salt buoyancy flux ratio
+
+   !! * 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_ddm_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE zdf_ddm_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( avs(jpi,jpj,jpk), rrau(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: Rrau=alpha/beta dk[T]/dk[S]
+      !!      which is computed in rn2.F
+      !!         * salt fingering (Schmitt 1981):
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (Rrau/rn_hsbfr)^6 )
+      !!      for Rrau > 1 and rn2 > 0 : zavfs = O
+      !!      otherwise                : zavft = 0.7 zavs / Rrau
+      !!         * diffusive layering (Federov 1988):
+      !!      for 0< Rrau < 1 and rn2 > 0 : zavdt = 1.3635e-6  
+      !!                                 * exp( 4.6 exp(-0.54 (1/Rrau-1) ) )
+      !!      otherwise                   : zavdt = 0 
+      !!      for .5 < Rrau < 1 and rn2 > 0 : zavds = zavdt (1.885 Rrau -0.85)
+      !!      for  0 < Rrau <.5 and rn2 > 0 : zavds = zavdt 0.15 Rrau      
+      !!      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) ::   zinr, zrr       ! temporary scalars
+      REAL(wp) ::   zavft, zavfs    !    -         -
+      REAL(wp) ::   zavdt, zavds    !    -         -
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmsks, zmskf, zmskd1, zmskd2, zmskd3
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm')
+      !
+      CALL wrk_alloc( jpi,jpj, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
+
+      !                                                ! ===============
+      DO jk = 2, jpkm1                                 ! Horizontal slab
+         !                                             ! ===============
+         ! Define the mask 
+         ! ---------------
+         rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) )         ! only retains positive value of rrau
+
+         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 rrau>1; 0 elsewhere            
+               IF( rrau(ji,jj,jk) <= 1.          ) THEN   ;   zmskf(ji,jj) = 0._wp
+               ELSE                                       ;   zmskf(ji,jj) = 1._wp
+               ENDIF
+               ! diffusive layering indicators: 
+               !     ! mskdl1=1 if 0<rrau<1; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 1.          ) THEN   ;   zmskd1(ji,jj) = 0._wp
+               ELSE                                       ;   zmskd1(ji,jj) = 1._wp
+               ENDIF
+               !     ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere
+               IF( rrau(ji,jj,jk) >= 0.5         ) THEN   ;   zmskd2(ji,jj) = 0._wp
+               ELSE                                       ;   zmskd2(ji,jj) = 1._wp
+               ENDIF
+               !   mskdl3=1 if 0.5<rrau<1; 0 elsewhere
+               IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp
+               ELSE                                                         ;   zmskd3(ji,jj) = 1._wp
+               ENDIF
+            END DO
+         END DO
+         ! mask zmsk in order to have avt and avs masked
+         zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk)
+
+
+         ! Update avt and avs
+         ! ------------------
+         ! Constant eddy coefficient: reset to the background value
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zinr = 1./rrau(ji,jj,jk)
+               ! salt fingering
+               zrr = rrau(ji,jj,jk)/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 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   &
+                  &                            +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  )
+               ! add to the eddy viscosity coef. previously computed
+               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
+               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) )  * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
+                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   &
+                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * vmask(ji,jj,jk)
+            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, 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)
+      !!----------------------------------------------------------------------
+      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )                ! Read Namelist namzdf_ddm : double diffusion mixing scheme
+      READ  ( numnam, 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 * tmask(:,:,:) 
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm_substitute.h90	(revision 3437)
@@ -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
+!   '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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90	(revision 3437)
@@ -0,0 +1,140 @@
+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
+   !!             -   !  2005-06  (C. Ethe) KPP parameterization
+   !!            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 zdfkpp          ! KPP vertical mixing
+   USE in_out_manager  ! I/O manager
+   USE iom             ! for iom_put
+   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_evd    ! called by step.F90
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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
+      !!----------------------------------------------------------------------
+      USE oce,   zavt_evd => ua , zavm_evd => va  ! (ua,va) used ua workspace
+      !
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step indexocean time step
+      !
+      INTEGER ::   ji, jj, jk   ! dummy loop indices
+      !!----------------------------------------------------------------------
+      !
+      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
+
+      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 
+#if defined key_vectopt_loop
+            DO jj = 1, 1                     ! big loop forced
+               DO ji = jpi+2, jpij   
+#else
+            DO jj = 2, jpj             ! no vector opt.
+               DO ji = 2, jpi
+#endif
+#if defined key_zdfkpp
+                  ! no evd mixing in the boundary layer with KPP
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  ) THEN
+#else
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN
+#endif
+                     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! 
+#if defined key_vectopt_loop
+            DO jj = 1, 1                     ! big loop forced
+               DO ji = 1, jpij   
+#else
+            DO jj = 1, jpj             ! loop over the whole domain (no lbc_lnk call)
+               DO ji = 1, jpi
+#endif
+#if defined key_zdfkpp
+                  ! no evd mixing in the boundary layer with KPP
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12  .AND.  fsdepw(ji,jj,jk) > hkpp(ji,jj)  )   &          
+#else
+                  IF(  MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 )   &
+#endif
+                     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( nn_timing == 1 )  CALL timing_stop('zdf_evd')
+      !
+   END SUBROUTINE zdf_evd
+
+   !!======================================================================
+END MODULE zdfevd
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90	(revision 3437)
@@ -0,0 +1,1278 @@
+MODULE zdfgls
+   !!======================================================================
+   !!                       ***  MODULE  zdfgls  ***
+   !! Ocean physics:  vertical mixing coefficient computed from the gls 
+   !!                 turbulent closure parameterization
+   !!======================================================================
+   !! History :   3.0  !  2009-09  (G. Reffray)  Original code
+   !!             3.3  !  2010-10  (C. Bricaud)  Add in the reference
+   !!----------------------------------------------------------------------
+#if defined key_zdfgls   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfgls'                 Generic Length Scale vertical physics
+   !!----------------------------------------------------------------------
+   !!   zdf_gls      : update momentum and tracer Kz from a gls scheme
+   !!   zdf_gls_init : initialization, namelist read, and parameters control
+   !!   gls_rst      : read/write gls restart in ocean restart file
+   !!----------------------------------------------------------------------
+   USE oce            ! ocean dynamics and active tracers 
+   USE dom_oce        ! ocean space and time domain
+   USE domvvl         ! ocean space and time domain : variable volume layer
+   USE zdf_oce        ! ocean vertical physics
+   USE sbc_oce        ! surface boundary condition: ocean
+   USE phycst         ! physical constants
+   USE zdfmxl         ! mixed layer
+   USE restart        ! only for lrst_oce
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE 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
+
+   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(:,:,:) ::   en      !: now turbulent kinetic energy
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mxln    !: now mixing length
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zwall   !: wall function
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustars2 !: Squared surface velocity scale at T-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ustarb2 !: Squared bottom  velocity scale at T-points
+
+   !                                         !!! ** Namelist  namzdf_gls  **
+   LOGICAL  ::   ln_crban      = .FALSE.      ! =T use Craig and Banner scheme
+   LOGICAL  ::   ln_length_lim = .FALSE.      ! use limit on the dissipation rate under stable stratification (Galperin et al. 1988)
+   LOGICAL  ::   ln_sigpsi     = .FALSE.      ! Activate Burchard (2003) modification for k-eps closure & wave breaking mixing
+   INTEGER  ::   nn_tkebc_surf = 0            ! TKE surface boundary condition (=0/1)
+   INTEGER  ::   nn_tkebc_bot  = 0            ! TKE bottom boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_surf = 0            ! PSI surface boundary condition (=0/1)
+   INTEGER  ::   nn_psibc_bot  = 0            ! PSI bottom boundary condition (=0/1)
+   INTEGER  ::   nn_stab_func  = 0            ! stability functions G88, KC or Canuto (=0/1/2)
+   INTEGER  ::   nn_clos       = 0            ! closure 0/1/2/3 MY82/k-eps/k-w/gen
+   REAL(wp) ::   rn_clim_galp  = 0.53_wp      ! Holt 2008 value for k-eps: 0.267
+   REAL(wp) ::   rn_epsmin     = 1.e-12_wp    ! minimum value of dissipation (m2/s3)
+   REAL(wp) ::   rn_emin       = 1.e-6_wp     ! minimum value of TKE (m2/s2)
+   REAL(wp) ::   rn_charn      = 2.e+5_wp     ! Charnock constant for surface breaking waves mixing : 1400. (standard) or 2.e5 (Stacey value)
+   REAL(wp) ::   rn_crban      = 100._wp      ! Craig and Banner constant for surface breaking waves mixing
+
+   REAL(wp) ::   hsro          =  0.003_wp    ! Minimum surface roughness
+   REAL(wp) ::   hbro          =  0.003_wp    ! Bottom roughness (m)
+   REAL(wp) ::   rcm_sf        =  0.73_wp     ! Shear free turbulence parameters
+   REAL(wp) ::   ra_sf         = -2.0_wp      ! Must be negative -2 < ra_sf < -1 
+   REAL(wp) ::   rl_sf         =  0.2_wp      ! 0 <rl_sf<vkarmn    
+   REAL(wp) ::   rghmin        = -0.28_wp
+   REAL(wp) ::   rgh0          =  0.0329_wp
+   REAL(wp) ::   rghcri        =  0.03_wp
+   REAL(wp) ::   ra1           =  0.92_wp
+   REAL(wp) ::   ra2           =  0.74_wp
+   REAL(wp) ::   rb1           = 16.60_wp
+   REAL(wp) ::   rb2           = 10.10_wp         
+   REAL(wp) ::   re2           =  1.33_wp         
+   REAL(wp) ::   rl1           =  0.107_wp
+   REAL(wp) ::   rl2           =  0.0032_wp
+   REAL(wp) ::   rl3           =  0.0864_wp
+   REAL(wp) ::   rl4           =  0.12_wp
+   REAL(wp) ::   rl5           = 11.9_wp
+   REAL(wp) ::   rl6           =  0.4_wp
+   REAL(wp) ::   rl7           =  0.0_wp
+   REAL(wp) ::   rl8           =  0.48_wp
+   REAL(wp) ::   rm1           =  0.127_wp
+   REAL(wp) ::   rm2           =  0.00336_wp
+   REAL(wp) ::   rm3           =  0.0906_wp
+   REAL(wp) ::   rm4           =  0.101_wp
+   REAL(wp) ::   rm5           = 11.2_wp
+   REAL(wp) ::   rm6           =  0.4_wp
+   REAL(wp) ::   rm7           =  0.0_wp
+   REAL(wp) ::   rm8           =  0.318_wp
+   
+   REAL(wp) ::   rc02, rc02r, rc03, rc04                          ! coefficients deduced from above parameters
+   REAL(wp) ::   rc03_sqrt2_galp                                  !     -           -           -        -
+   REAL(wp) ::   rsbc_tke1, rsbc_tke2, rsbc_tke3, rfact_tke       !     -           -           -        -
+   REAL(wp) ::   rsbc_psi1, rsbc_psi2, rsbc_psi3, rfact_psi       !     -           -           -        -
+   REAL(wp) ::   rsbc_mb  , rsbc_std , rsbc_zs                    !     -           -           -        -
+   REAL(wp) ::   rc0, rc2, rc3, rf6, rcff, rc_diff                !     -           -           -        -
+   REAL(wp) ::   rs0, rs1, rs2, rs4, rs5, rs6                     !     -           -           -        -
+   REAL(wp) ::   rd0, rd1, rd2, rd3, rd4, rd5                     !     -           -           -        -
+   REAL(wp) ::   rsc_tke, rsc_psi, rpsi1, rpsi2, rpsi3, rsc_psi0  !     -           -           -        -
+   REAL(wp) ::   rpsi3m, rpsi3p, rpp, rmm, rnn                    !     -           -           -        -
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_gls_alloc()
+      !!----------------------------------------------------------------------
+      !!                ***  FUNCTION zdf_gls_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( en(jpi,jpj,jpk),  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(:,:  ) ::   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.AND.ln_crban=T)
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   z_elem_a, z_elem_b, z_elem_c, psi
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_gls')
+      !
+      CALL wrk_alloc( jpi,jpj, zdep, zflxs, zhsro )
+      CALL wrk_alloc( jpi,jpj,jpk, eb, mxlb, shear, eps, zwall_psi, z_elem_a, z_elem_b, z_elem_c, psi )
+
+      ! Preliminary computing
+
+      ustars2 = 0._wp   ;   ustarb2 = 0._wp   ;   psi  = 0._wp   ;   zwall_psi = 0._wp
+
+      ! Compute surface and bottom friction at T-points
+!CDIR NOVERRCHK
+      DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            ! 
+            ! surface friction 
+            ustars2(ji,jj) = rau0r * taum(ji,jj) * tmask(ji,jj,1)
+            !
+            ! bottom friction (explicit before friction)
+            ! Note that we chose here not to bound the friction as in dynbfr)
+            ztx2 = (  bfrua(ji,jj)  * ub(ji,jj,mbku(ji,jj)) + bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj))  )   &
+               & * ( 1._wp - 0.5_wp * umask(ji,jj,1) * umask(ji-1,jj,1)  )
+            zty2 = (  bfrva(ji,jj)  * vb(ji,jj,mbkv(ji,jj)) + bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1))  )   &
+               & * ( 1._wp - 0.5_wp * vmask(ji,jj,1) * vmask(ji,jj-1,1)  )
+            ustarb2(ji,jj) = SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1)
+         END DO
+      END DO  
+
+      ! In case of breaking surface waves mixing,
+      ! Compute surface roughness length according to Charnock formula:
+      IF( ln_crban ) THEN   ;   zhsro(:,:) = MAX(rsbc_zs * ustars2(:,:), hsro)
+      ELSE                  ;   zhsro(:,:) = hsro
+      ENDIF
+
+      ! Compute shear and dissipation rate
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
+                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   &
+                  &                            / (  fse3uw_n(ji,jj,jk)               &
+                  &                            *    fse3uw_b(ji,jj,jk) )
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
+                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
+                  &                            / (  fse3vw_n(ji,jj,jk)               &
+                  &                            *    fse3vw_b(ji,jj,jk) )
+               eps(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      ! Lateral boundary conditions (avmu,avmv) (sign unchanged)
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )
+
+      ! Save tke at before time step
+      eb  (:,:,:) = en  (:,:,:)
+      mxlb(:,:,:) = mxln(:,:,:)
+
+      IF( nn_clos == 0 ) THEN    ! Mellor-Yamada
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zup   = mxln(ji,jj,jk) * fsdepw(ji,jj,mbkt(ji,jj)+1)
+                  zdown = vkarmn * fsdepw(ji,jj,jk) * ( -fsdepw(ji,jj,jk) + fsdepw(ji,jj,mbkt(ji,jj)+1) )
+                  zcoef = ( zup / MAX( zdown, rsmall ) )
+                  zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !!---------------------------------!!
+      !!   Equation to prognostic k      !!
+      !!---------------------------------!!
+      !
+      ! Now Turbulent kinetic energy (output in en)
+      ! -------------------------------
+      ! Resolution of a tridiagonal linear system by a "methode de chasse"
+      ! computation from level 2 to jpkm1  (e(1) computed after and e(jpk)=0 ).
+      ! The surface boundary condition are set after
+      ! The bottom boundary condition are also set after. In standard e(bottom)=0.
+      ! z_elem_b : diagonal z_elem_c : upper diagonal z_elem_a : lower diagonal
+      ! Warning : after this step, en : right hand side of the matrix
+
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               !
+               ! shear prod. at w-point weightened by mask
+               shear(ji,jj,jk) =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1.e0 , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &             + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1.e0 , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )
+               !
+               ! stratif. destruction
+               buoy = - avt(ji,jj,jk) * rn2(ji,jj,jk)
+               !
+               ! shear prod. - stratif. destruction
+               diss = eps(ji,jj,jk)
+               !
+               dir = 0.5_wp + SIGN( 0.5_wp, shear(ji,jj,jk) + buoy )   ! dir =1(=0) if shear(ji,jj,jk)+buoy >0(<0)
+               !
+               zesh2 = dir*(shear(ji,jj,jk)+buoy)+(1._wp-dir)*shear(ji,jj,jk)          ! production term
+               zdiss = dir*(diss/en(ji,jj,jk))   +(1._wp-dir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term
+               !
+               ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0
+               ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style)
+               ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries.
+               ! Otherwise, this should be rsc_psi/rsc_psi0
+               IF( ln_sigpsi ) THEN
+                  zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) )     ! 0. <= zsigpsi <= 1.
+                  zwall_psi(ji,jj,jk) = rsc_psi /   & 
+                     &     (  zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp )  )
+               ELSE
+                  zwall_psi(ji,jj,jk) = 1._wp
+               ENDIF
+               !
+               ! building the matrix
+               zcof = rfact_tke * tmask(ji,jj,jk)
+               !
+               ! lower diagonal
+               z_elem_a(ji,jj,jk) = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               !
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               !
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk) 
+               !
+               ! right hand side in en
+               en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1._wp
+      !
+      ! Set surface condition on zwall_psi (1 at the bottom)
+      IF( ln_sigpsi ) THEN
+         zcoef = rsc_psi / rsc_psi0
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zwall_psi(ji,jj,1) = zcoef
+            END DO
+         END DO
+      ENDIF
+
+      ! Surface boundary condition on tke
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_tkebc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet case
+         !
+         IF (ln_crban) THEN     ! Wave induced mixing case
+            !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
+            !                      ! balance between the production and the dissipation terms including the wave effect
+            en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
+            z_elem_a(:,:,1) = en(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            ! 
+            ! one level below
+            en(:,:,2) = MAX( rsbc_tke1 * ustars2(:,:) * ( (zhsro(:,:)+fsdepw(:,:,2))/zhsro(:,:) )**ra_sf, rn_emin )
+            z_elem_a(:,:,2) = 0._wp
+            z_elem_c(:,:,2) = 0._wp
+            z_elem_b(:,:,2) = 1._wp
+            !
+         ELSE                   ! No wave induced mixing case
+            !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
+            !                      ! balance between the production and the dissipation terms
+            en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
+            z_elem_a(:,:,1) = en(:,:,1) 
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            !
+            ! one level below
+            en(:,:,2) = MAX( rc02r * ustars2(:,:), rn_emin )
+            z_elem_a(:,:,2) = 0._wp
+            z_elem_c(:,:,2) = 0._wp
+            z_elem_b(:,:,2) = 1._wp
+            !
+         ENDIF
+         !
+      CASE ( 1 )             ! Neumann boundary condition on d(e)/dz
+         !
+         IF (ln_crban) THEN ! Shear free case: d(e)/dz= Fw
+            !
+            ! Dirichlet conditions at k=1 (Cosmetic)
+            en(:,:,1) = MAX( rsbc_tke1 * ustars2(:,:), rn_emin )
+            z_elem_a(:,:,1) = en(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            ! at k=2, set de/dz=Fw
+            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+            z_elem_a(:,:,2) = 0._wp        
+            zflxs(:,:) = rsbc_tke3 * ustars2(:,:)**1.5_wp * ( (zhsro(:,:)+fsdept(:,:,1) ) / zhsro(:,:) )**(1.5*ra_sf)
+            en(:,:,2) = en(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+            !
+         ELSE                   ! No wave induced mixing case: d(e)/dz=0.
+            !
+            ! Dirichlet conditions at k=1 (Cosmetic)
+            en(:,:,1) = MAX( rc02r * ustars2(:,:), rn_emin )
+            z_elem_a(:,:,1) = en(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            ! at k=2 set de/dz=0.:
+            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2)  ! Remove z_elem_a from z_elem_b
+            z_elem_a(:,:,2) = 0._wp
+            !
+         ENDIF
+         !
+      END SELECT
+
+      ! Bottom boundary condition on tke
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_tkebc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = rn_lmin
+         !                      ! Balance between the production and the dissipation terms
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot  ) = 0._wp
+               z_elem_c(ji,jj,ibot  ) = 0._wp
+               z_elem_b(ji,jj,ibot  ) = 1._wp
+               en(ji,jj,ibot  ) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level, Dirichlet condition again
+               z_elem_a(ji,jj,ibotm1) = 0._wp
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+               z_elem_b(ji,jj,ibotm1) = 1._wp
+               en(ji,jj,ibotm1) = MAX( rc02r * ustarb2(ji,jj), rn_emin ) 
+            END DO
+         END DO
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !                      
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               en(ji,jj,ibot) = MAX( rc02r * ustarb2(ji,jj), rn_emin )
+               !
+               ! Just above last level: Neumann condition
+               z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1)   ! Remove z_elem_c from z_elem_b
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Matrix inversion (en prescribed at surface and the bottom)
+      ! ----------------------------------------------------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = en(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               en(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * en(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !                                            ! set the minimum value of tke 
+      en(:,:,:) = MAX( en(:,:,:), rn_emin )
+      
+      !!----------------------------------------!!
+      !!   Solve prognostic equation for psi    !!
+      !!----------------------------------------!!
+
+      ! Set psi to previous time step value
+      !
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  psi(ji,jj,jk)  = 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) )   &
+                  &                      / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+               ! upper diagonal
+               z_elem_c(ji,jj,jk) = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &
+                  &                      / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk) )
+               ! diagonal
+               z_elem_b(ji,jj,jk) = 1._wp - z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk)  &
+                  &                       + rdt * zdiss * tmask(ji,jj,jk)
+               !
+               ! right hand side in psi
+               psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      !
+      z_elem_b(:,:,jpk) = 1._wp
+
+      ! Surface boundary condition on psi
+      ! ---------------------------------
+      !
+      SELECT CASE ( nn_psibc_surf )
+      !
+      CASE ( 0 )             ! Dirichlet boundary conditions
+         !
+         IF( ln_crban ) THEN       ! Wave induced mixing case
+            !                      ! en(1) = q2(1) = 0.5 * (15.8 * Ccb)^(2/3) * u*^2
+            !                      ! balance between the production and the dissipation terms including the wave effect
+            zdep(:,:) = rl_sf * zhsro(:,:)
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+            z_elem_a(:,:,1) = psi(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            !
+            ! one level below
+            zex1 = (rmm*ra_sf+rnn)
+            zex2 = (rmm*ra_sf)
+            zdep(:,:) = ( (zhsro(:,:) + fsdepw(:,:,2))**zex1 ) / zhsro(:,:)**zex2
+            psi (:,:,2) = rsbc_psi1 * ustars2(:,:)**rmm * zdep(:,:) * tmask(:,:,1)
+            z_elem_a(:,:,2) = 0._wp
+            z_elem_c(:,:,2) = 0._wp
+            z_elem_b(:,:,2) = 1._wp
+            ! 
+         ELSE                   ! No wave induced mixing case
+            !                      ! en(1) = u*^2/C0^2  &  l(1)  = K*zs
+            !                      ! balance between the production and the dissipation terms
+            !
+            zdep(:,:) = vkarmn * zhsro(:,:)
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+            z_elem_a(:,:,1) = psi(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            !
+            ! one level below
+            zdep(:,:) = vkarmn * ( zhsro(:,:) + fsdepw(:,:,2) )
+            psi (:,:,2) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+            z_elem_a(:,:,2) = 0._wp
+            z_elem_c(:,:,2) = 0._wp
+            z_elem_b(:,:,2) = 1.
+            !
+         ENDIF
+         !
+      CASE ( 1 )             ! Neumann boundary condition on d(psi)/dz
+         !
+         IF( ln_crban ) THEN     ! Wave induced mixing case
+            !
+            zdep(:,:) = rl_sf * zhsro(:,:)
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+            z_elem_a(:,:,1) = psi(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            !
+            ! Neumann condition at k=2
+            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+            z_elem_a(:,:,2) = 0._wp
+            !
+            ! Set psi vertical flux at the surface:
+            zdep(:,:) = (zhsro(:,:) + fsdept(:,:,1))**(rmm*ra_sf+rnn-1._wp) / zhsro(:,:)**(rmm*ra_sf)
+            zflxs(:,:) = rsbc_psi3 * ( zwall_psi(:,:,1)*avm(:,:,1) + zwall_psi(:,:,2)*avm(:,:,2) ) & 
+               &                   * en(:,:,1)**rmm * zdep         
+            psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+            !
+      ELSE                   ! No wave induced mixing
+            !
+            zdep(:,:) = vkarmn * zhsro(:,:)
+            psi (:,:,1) = rc0**rpp * en(:,:,1)**rmm * zdep(:,:)**rnn * tmask(:,:,1)
+            z_elem_a(:,:,1) = psi(:,:,1)
+            z_elem_c(:,:,1) = 0._wp
+            z_elem_b(:,:,1) = 1._wp
+            !
+            ! Neumann condition at k=2
+            z_elem_b(:,:,2) = z_elem_b(:,:,2) +  z_elem_a(:,:,2) ! Remove z_elem_a from z_elem_b
+            z_elem_a(ji,jj,2) = 0._wp
+            !
+            ! Set psi vertical flux at the surface:
+            zdep(:,:)  = zhsro(:,:) + fsdept(:,:,1)
+            zflxs(:,:) = rsbc_psi2 * ( avm(:,:,1) + avm(:,:,2) ) * en(:,:,1)**rmm * zdep**(rnn-1._wp)
+            psi(:,:,2) = psi(:,:,2) + zflxs(:,:) / fse3w(:,:,2)
+            !     
+         ENDIF
+         !
+      END SELECT
+
+      ! Bottom boundary condition on psi
+      ! --------------------------------
+      !
+      SELECT CASE ( nn_psibc_bot )
+      !
+      CASE ( 0 )             ! Dirichlet 
+         !                      ! en(ibot) = u*^2 / Co2 and mxln(ibot) = vkarmn * hbro
+         !                      ! Balance between the production and the dissipation terms
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               zdep(ji,jj) = vkarmn * hbro
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               !
+               ! Just above last level, Dirichlet condition again (GOTM like)
+               zdep(ji,jj) = vkarmn * ( hbro + fse3t(ji,jj,ibotm1) )
+               psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot  )**rmm * zdep(ji,jj)**rnn
+               z_elem_a(ji,jj,ibotm1) = 0._wp
+               z_elem_c(ji,jj,ibotm1) = 0._wp
+               z_elem_b(ji,jj,ibotm1) = 1._wp
+            END DO
+         END DO
+         !
+      CASE ( 1 )             ! Neumman boundary condition
+         !                      
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               ibot   = mbkt(ji,jj) + 1      ! k   bottom level of w-point
+               ibotm1 = mbkt(ji,jj)          ! k-1 bottom level of w-point but >=1
+               !
+               ! Bottom level Dirichlet condition:
+               zdep(ji,jj) = vkarmn * hbro
+               psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn
+               !
+               z_elem_a(ji,jj,ibot) = 0._wp
+               z_elem_c(ji,jj,ibot) = 0._wp
+               z_elem_b(ji,jj,ibot) = 1._wp
+               !
+               ! Just above last level: Neumann condition with flux injection
+               z_elem_b(ji,jj,ibotm1) = z_elem_b(ji,jj,ibotm1) + z_elem_c(ji,jj,ibotm1) ! Remove z_elem_c from z_elem_b
+               z_elem_c(ji,jj,ibotm1) = 0.
+               !
+               ! Set psi vertical flux at the bottom:
+               zdep(ji,jj) = hbro + 0.5_wp*fse3t(ji,jj,ibotm1)
+               zflxb = rsbc_psi2 * ( avm(ji,jj,ibot) + avm(ji,jj,ibotm1) )   &
+                  &  * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp)
+               psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / fse3w(ji,jj,ibotm1)
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Matrix inversion
+      ! ----------------
+      !
+      DO jk = 2, jpkm1                             ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_b(ji,jj,jk) = z_elem_b(ji,jj,jk) - z_elem_a(ji,jj,jk) * z_elem_c(ji,jj,jk-1) / z_elem_b(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = 2, jpk                               ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               z_elem_a(ji,jj,jk) = psi(ji,jj,jk) - z_elem_a(ji,jj,jk) / z_elem_b(ji,jj,jk-1) * z_elem_a(ji,jj,jk-1)
+            END DO
+         END DO
+      END DO
+      DO jk = jpk-1, 2, -1                         ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               psi(ji,jj,jk) = ( z_elem_a(ji,jj,jk) - z_elem_c(ji,jj,jk) * psi(ji,jj,jk+1) ) / z_elem_b(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! Set dissipation
+      !----------------
+
+      SELECT CASE ( nn_clos )
+      !
+      CASE( 0 )               ! k-kl  (Mellor-Yamada)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / psi(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 1 )               ! k-eps
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = psi(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 2 )               ! k-w
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 
+               END DO
+            END DO
+         END DO
+         !
+      CASE( 3 )               ! generic
+         zcoef = rc0**( 3._wp  + rpp/rnn )
+         zex1  =      ( 1.5_wp + rmm/rnn )
+         zex2  = -1._wp / rnn
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Limit dissipation rate under stable stratification
+      ! --------------------------------------------------
+      DO jk = 1, jpkm1 ! Note that this set boundary conditions on mxln at the same time
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1    ! vector opt.
+               ! limitation
+               eps(ji,jj,jk)  = MAX( eps(ji,jj,jk), rn_epsmin )
+               mxln(ji,jj,jk)  = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk)
+               ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               mxln(ji,jj,jk) = MIN(  rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), mxln(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO 
+
+      !
+      ! Stability function and vertical viscosity and diffusivity
+      ! ---------------------------------------------------------
+      !
+      SELECT CASE ( nn_stab_func )
+      !
+      CASE ( 0 , 1 )             ! Galperin or Kantha-Clayson stability functions
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zcof =  l²/q²
+                  zcof = mxlb(ji,jj,jk) * mxlb(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) )
+                  ! Gh = -N²l²/q²
+                  gh = - rn2(ji,jj,jk) * zcof
+                  gh = MIN( gh, rgh0   )
+                  gh = MAX( gh, rghmin )
+                  ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin)
+                  sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) )
+                  sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh)
+                  !
+                  ! Store stability function in avmu and avmv
+                  avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 2, 3 )               ! Canuto stability functions
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ! zcof =  l²/q²
+                  zcof = mxlb(ji,jj,jk)*mxlb(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) )
+                  ! Gh = -N²l²/q²
+                  gh = - rn2(ji,jj,jk) * zcof
+                  gh = MIN( gh, rgh0   )
+                  gh = MAX( gh, rghmin )
+                  gh = gh * rf6
+                  ! Gm =  M²l²/q² Shear number
+                  shr = shear(ji,jj,jk) / MAX( avm(ji,jj,jk), rsmall )
+                  gm = MAX( shr * zcof , 1.e-10 )
+                  gm = gm * rf6
+                  gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm )
+                  ! Stability functions from Canuto
+                  rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm
+                  sm = (rs0 - rs1*gh + rs2*gm) / rcff
+                  sh = (rs4 - rs5*gh + rs6*gm) / rcff
+                  !
+                  ! Store stability function in avmu and avmv
+                  avmu(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk)
+                  avmv(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+
+      ! Boundary conditions on stability functions for momentum (Neumann):
+      ! Lines below are useless if GOTM style Dirichlet conditions are used
+      zcoef = rcm_sf / SQRT( 2._wp )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            avmv(ji,jj,1) = zcoef
+         END DO
+      END DO
+      zcoef = rc0 / SQRT( 2._wp )
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1   ! vector opt.
+            avmv(ji,jj,mbkt(ji,jj)+1) = zcoef
+         END DO
+      END DO
+
+      ! Compute diffusivities/viscosities
+      ! The computation below could be restrained to jk=2 to jpkm1 if GOTM style Dirichlet conditions are used
+      DO jk = 1, jpk
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen         = SQRT( 2._wp * en(ji,jj,jk) ) * mxln(ji,jj,jk)
+               zav           = zsqen * avmu(ji,jj,jk)
+               avt(ji,jj,jk) = MAX( zav, avtb(jk) )*tmask(ji,jj,jk) ! apply mask for zdfmxl routine
+               zav           = zsqen * avmv(ji,jj,jk)
+               avm(ji,jj,jk) = MAX( zav, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom
+            END DO
+         END DO
+      END DO
+      !
+      ! Lateral boundary conditions (sign unchanged)
+      avt(:,:,1)  = 0._wp
+      CALL lbc_lnk( avm, 'W', 1. )   ;   CALL lbc_lnk( avt, 'W', 1. )
+
+      DO jk = 2, jpkm1            !* vertical eddy viscosity at u- and v-points
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj  ,jk) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+      avmu(:,:,1) = 0._wp             ;   avmv(:,:,1) = 0._wp                 ! set surface to zero
+      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. )       ! Lateral boundary conditions
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=en  , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
+         CALL prt_ctl( tab3d_1=avmu, clinfo1=' gls  - u: ', mask1=umask,                   &
+            &          tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk )
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zdep, 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
+      REAL(wp)::   zcr   ! local scalar
+      !!
+      NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &
+         &            rn_clim_galp, ln_crban, ln_sigpsi,     &
+         &            rn_crban, rn_charn,                    &
+         &            nn_tkebc_surf, nn_tkebc_bot,           &
+         &            nn_psibc_surf, nn_psibc_bot,           &
+         &            nn_stab_func, nn_clos
+      !!----------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_gls_init')
+      !
+      REWIND( numnam )                 !* Read Namelist namzdf_gls
+      READ  ( numnam, namzdf_gls )
+
+      IF(lwp) THEN                     !* Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_gls_init : gls turbulent closure scheme'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_gls : set gls mixing parameters'
+         WRITE(numout,*) '      minimum value of en                           rn_emin       = ', rn_emin
+         WRITE(numout,*) '      minimum value of eps                          rn_epsmin     = ', rn_epsmin
+         WRITE(numout,*) '      Limit dissipation rate under stable stratif.  ln_length_lim = ', ln_length_lim
+         WRITE(numout,*) '      Galperin limit (Standard: 0.53, Holt: 0.26)   rn_clim_galp  = ', rn_clim_galp
+         WRITE(numout,*) '      TKE Surface boundary condition                nn_tkebc_surf = ', nn_tkebc_surf
+         WRITE(numout,*) '      TKE Bottom boundary condition                 nn_tkebc_bot  = ', nn_tkebc_bot
+         WRITE(numout,*) '      PSI Surface boundary condition                nn_psibc_surf = ', nn_psibc_surf
+         WRITE(numout,*) '      PSI Bottom boundary condition                 nn_psibc_bot  = ', nn_psibc_bot
+         WRITE(numout,*) '      Craig and Banner scheme                       ln_crban      = ', ln_crban
+         WRITE(numout,*) '      Modify psi Schmidt number (wb case)           ln_sigpsi     = ', ln_sigpsi
+         WRITE(numout,*) '      Craig and Banner coefficient                  rn_crban       = ', rn_crban
+         WRITE(numout,*) '      Charnock coefficient                          rn_charn       = ', rn_charn
+         WRITE(numout,*) '      Stability functions                           nn_stab_func   = ', nn_stab_func
+         WRITE(numout,*) '      Type of closure                               nn_clos        = ', nn_clos
+         WRITE(numout,*) '   Hard coded parameters'
+         WRITE(numout,*) '      Surface roughness (m)                         hsro          = ', hsro
+         WRITE(numout,*) '      Bottom roughness (m)                          hbro          = ', hbro
+      ENDIF
+
+      !                                !* 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_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' )
+      IF( nn_psibc_surf < 0 .OR. nn_psibc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_surf is 0 or 1' )
+      IF( nn_tkebc_bot  < 0 .OR. nn_tkebc_bot  > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_bot is 0 or 1' )
+      IF( nn_psibc_bot  < 0 .OR. nn_psibc_bot  > 1 ) CALL ctl_stop( 'bad flag: nn_psibc_bot is 0 or 1' )
+      IF( nn_stab_func  < 0 .OR. nn_stab_func  > 3 ) CALL ctl_stop( 'bad flag: nn_stab_func is 0, 1, 2 and 3' )
+      IF( nn_clos       < 0 .OR. nn_clos       > 3 ) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' )
+
+      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.38_wp       ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = 2.38          ! Canuto B stability functions (caution : constant not identified)
+         END SELECT
+         !
+      CASE( 1 )                              ! k-eps
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps'
+         rpp     =  3._wp
+         rmm     =  1.5_wp
+         rnn     = -1._wp
+         rsc_tke =  1._wp
+         rsc_psi =  1.3_wp  ! Schmidt number for psi
+         rpsi1   =  1.44_wp
+         rpsi3p  =  1._wp
+         rpsi2   =  1.92_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = -0.52_wp      ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = -0.629_wp     ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = -0.566        ! Canuto B stability functions
+         END SELECT
+         !
+      CASE( 2 )                              ! k-omega
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega'
+         rpp     = -1._wp
+         rmm     =  0.5_wp
+         rnn     = -1._wp
+         rsc_tke =  2._wp
+         rsc_psi =  2._wp
+         rpsi1   =  0.555_wp
+         rpsi3p  =  1._wp
+         rpsi2   =  0.833_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = -0.58_wp       ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = -0.64_wp       ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = -0.64_wp       ! Canuto B stability functions caution : constant not identified)
+         END SELECT
+         !
+      CASE( 3 )                              ! generic
+         !
+         IF(lwp) WRITE(numout,*) 'The choosen closure is generic'
+         rpp     = 2._wp
+         rmm     = 1._wp
+         rnn     = -0.67_wp
+         rsc_tke = 0.8_wp
+         rsc_psi = 1.07_wp
+         rpsi1   = 1._wp
+         rpsi3p  = 1._wp
+         rpsi2   = 1.22_wp
+         !
+         SELECT CASE ( nn_stab_func )
+         CASE( 0, 1 )   ;   rpsi3m = 0.1_wp         ! G88 or KC stability functions
+         CASE( 2 )      ;   rpsi3m = 0.05_wp        ! Canuto A stability functions
+         CASE( 3 )      ;   rpsi3m = 0.05_wp        ! Canuto B stability functions caution : constant not identified)
+         END SELECT
+         !
+      END SELECT
+
+      !
+      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 .AND. ln_crban ) THEN
+         zcr = SQRT( 1.5_wp*rsc_tke ) * rcm_sf / vkarmn
+         rsc_psi0 = vkarmn*vkarmn / ( rpsi2 * rcm_sf*rcm_sf )                       & 
+        &         * ( rnn*rnn - 4._wp/3._wp * zcr*rnn*rmm - 1._wp/3._wp * zcr*rnn   &
+        &           + 2._wp/9._wp * rmm * zcr*zcr + 4._wp/9._wp * zcr*zcr * rmm*rmm )                                 
+      ELSE
+         rsc_psi0 = rsc_psi
+      ENDIF
+ 
+      !                                !* Shear free turbulence parameters
+      !
+      ra_sf  = -4._wp * rnn * SQRT( rsc_tke ) / ( (1._wp+4._wp*rmm) * SQRT( rsc_tke )   &
+         &                                      - SQRT(rsc_tke + 24._wp*rsc_psi0*rpsi2 ) )
+      rl_sf  = rc0 * SQRT( rc0 / rcm_sf )                                                                   &
+         &         * SQRT(  (  (1._wp + 4._wp*rmm + 8._wp*rmm*rmm) * rsc_tke                                &
+         &                   + 12._wp * rsc_psi0 * rpsi2                                                    &
+         &                   - (1._wp + 4._wp*rmm) * SQRT( rsc_tke*(rsc_tke+ 24._wp*rsc_psi0*rpsi2) )  )    &
+         &                / ( 12._wp*rnn*rnn )                                                              )
+
+      !
+      IF(lwp) THEN                     !* Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'Limit values'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) 'Parameter  m = ',rmm
+         WRITE(numout,*) 'Parameter  n = ',rnn
+         WRITE(numout,*) 'Parameter  p = ',rpp
+         WRITE(numout,*) 'rpsi1   = ',rpsi1
+         WRITE(numout,*) 'rpsi2   = ',rpsi2
+         WRITE(numout,*) 'rpsi3m  = ',rpsi3m
+         WRITE(numout,*) 'rpsi3p  = ',rpsi3p
+         WRITE(numout,*) 'rsc_tke = ',rsc_tke
+         WRITE(numout,*) 'rsc_psi = ',rsc_psi
+         WRITE(numout,*) 'rsc_psi0 = ',rsc_psi0
+         WRITE(numout,*) 'rc0     = ',rc0
+         WRITE(numout,*)
+         WRITE(numout,*) 'Shear free turbulence parameters:'
+         WRITE(numout,*) 'rcm_sf  = ',rcm_sf
+         WRITE(numout,*) 'ra_sf   = ',ra_sf
+         WRITE(numout,*) 'rl_sf   = ',rl_sf
+         WRITE(numout,*)
+      ENDIF
+
+      !                                !* Constants initialization
+      rc02  = rc0  * rc0   ;   rc02r = 1. / rc02
+      rc03  = rc02 * rc0
+      rc04  = rc03 * rc0
+      rc03_sqrt2_galp = rc03 / SQRT(2._wp) / rn_clim_galp
+      rsbc_mb   = 0.5_wp * (15.8_wp*rn_crban)**(2._wp/3._wp)               ! Surf. bound. cond. from Mellor and Blumberg
+      rsbc_std  = 3.75_wp                                                  ! Surf. bound. cond. standard (prod=diss)
+      rsbc_tke1 = (-rsc_tke*rn_crban/(rcm_sf*ra_sf*rl_sf))**(2._wp/3._wp)  ! k_eps = 53.  Dirichlet + Wave breaking 
+      rsbc_tke2 = 0.5_wp / rau0
+      rsbc_tke3 = rdt * rn_crban                                                         ! Neumann + Wave breaking
+      rsbc_zs   = rn_charn / grav                                                        ! Charnock formula
+      rsbc_psi1 = rc0**rpp * rsbc_tke1**rmm * rl_sf**rnn                           ! Dirichlet + Wave breaking
+      rsbc_psi2 = -0.5_wp * rdt * rc0**rpp * rnn * vkarmn**rnn / rsc_psi                   ! Neumann + NO Wave breaking 
+      rsbc_psi3 = -0.5_wp * rdt * rc0**rpp * rl_sf**rnn / rsc_psi  * (rnn + rmm*ra_sf) ! Neumann + Wave breaking
+      rfact_tke = -0.5_wp / rsc_tke * rdt               ! Cst used for the Diffusion term of tke
+      rfact_psi = -0.5_wp / rsc_psi * rdt               ! Cst used for the Diffusion term of tke
+
+      !                                !* Wall proximity function
+      zwall (:,:,:) = 1._wp * tmask(:,:,:)
+
+      !                                !* set vertical eddy coef. to the background value
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+      !                              
+      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.001        
+               DO jit = nit000 + 1, nit000 + 10   ;   CALL zdf_gls( jit )   ;   END DO
+            ENDIF
+         ELSE                                   !* Start from rest
+            IF(lwp) WRITE(numout,*) ' ===>>>> : Initialisation of en and mxln by background values'
+            en  (:,:,:) = rn_emin
+            mxln(:,:,:) = 0.001       
+         ENDIF
+         !
+      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN   ! Create restart file
+         !                                   ! -------------------
+         IF(lwp) WRITE(numout,*) '---- gls-rst ----'
+         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    )
+         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt   )
+         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm   )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu  )
+         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv  )
+         CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln  )
+         !
+      ENDIF
+      !
+   END SUBROUTINE gls_rst
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO TKE scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfgls = .FALSE.   !: TKE flag
+CONTAINS
+   SUBROUTINE zdf_gls_init           ! Empty routine
+      WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?'
+   END SUBROUTINE zdf_gls_init
+   SUBROUTINE zdf_gls( kt )          ! Empty routine
+      WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt
+   END SUBROUTINE zdf_gls
+   SUBROUTINE gls_rst( kt, cdrw )          ! Empty routine
+      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
+      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
+      WRITE(*,*) 'gls_rst: You should not have seen this print! error?', kt, cdrw
+   END SUBROUTINE gls_rst
+#endif
+
+   !!======================================================================
+END MODULE zdfgls
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90	(revision 3437)
@@ -0,0 +1,178 @@
+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 parameterization
+   !!             -   ! 2009-07  (G. Madec) add avmb, avtb in restart for cen2 advection
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   zdf_init    : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE par_oce         ! mesh and scale factors
+   USE ldftra_oce      ! ocean active tracers: lateral physics
+   USE ldfdyn_oce      ! ocean dynamics lateral physics
+   USE zdf_oce         ! TKE vertical mixing          
+   USE lib_mpp         ! distribued memory computing
+   USE zdftke          ! TKE vertical mixing
+   USE zdfgls          ! GLS vertical mixing
+   USE zdfkpp          ! KPP vertical mixing          
+   USE zdfddm          ! double diffusion mixing      
+   USE zdfevd          ! enhanced vertical diffusion  
+   USE zdfric          ! Richardson vertical mixing   
+   USE tranpc          ! convection: non penetrative adjustment
+   USE ldfslp          ! iso-neutral slopes
+   USE restart         ! ocean restart
+
+   USE in_out_manager  ! I/O manager
+   USE iom             ! IOM library
+
+   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       ! temporary scalar
+      !!
+      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
+      !!----------------------------------------------------------------------
+
+      REWIND( numnam )           !* Read namzdf namelist : vertical mixing parameters
+      READ  ( numnam, 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( lk_zdfkpp ) THEN
+         IF(lwp) WRITE(numout,*) '      KPP dependent eddy coefficients'
+         ioptio = ioptio+1
+      ENDIF
+      IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa )   &
+         &   CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' )
+      !
+      !                               ! ... Convection
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) '   convection :'
+      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( lk_zdfkpp ) THEN
+         IF(lwp) WRITE(numout,*) '      use the KPP closure scheme'
+         IF(lk_mpp) THEN
+            IF(lwp) WRITE(numout,cform_err)
+            IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI'
+         ENDIF
+      ENDIF
+      IF ( ioptio > 1 .AND. .NOT. lk_esopa )   CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' )
+      IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) )           &
+         CALL ctl_stop( ' except for TKE, GLS or KPP physics, a convection scheme is',   &
+         &              ' required: ln_zdfevd or ln_zdfnpc logicals' )
+
+      !                               !* 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_0(:)   ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90	(revision 3437)
@@ -0,0 +1,1609 @@
+MODULE zdfkpp
+   !!======================================================================
+   !!                       ***  MODULE  zdfkpp  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the KPP 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+   !! History :  OPA  ! 2000-03 (W.G. Large, J. Chanut) Original code
+   !!            8.1  ! 2002-06 (J.M. Molines) for real case CLIPPER  
+   !!            8.2  ! 2003-10 (Chanut J.) re-writting
+   !!   NEMO     1.0  ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine
+   !!            3.3  ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA
+   !!----------------------------------------------------------------------
+#if defined key_zdfkpp   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_zdfkpp'                                             KPP scheme
+   !!----------------------------------------------------------------------
+   !!   zdf_kpp      : update momentum and tracer Kz from a kpp scheme
+   !!   zdf_kpp_init : initialization, namelist read, and parameters control
+   !!   tra_kpp      : compute and add to the T & S trend the non-local flux
+   !!   trc_kpp      : compute and add to the passive tracer trend the non-local flux (lk_top=T)
+   !!----------------------------------------------------------------------
+   USE oce             ! ocean dynamics and active tracers 
+   USE dom_oce         ! ocean space and time domain
+   USE zdf_oce         ! ocean vertical physics
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE phycst          ! physical constants
+   USE eosbn2          ! equation of state
+   USE zdfddm          ! double diffusion mixing
+   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 prtctl          ! Print control
+   USE trdmod_oce      ! ocean trends definition
+   USE trdtra          ! tracers trends
+   USE timing          ! Timing
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   zdf_kpp       ! routine called by step.F90
+   PUBLIC   zdf_kpp_init  ! routine called by opa.F90
+   PUBLIC   tra_kpp       ! routine called by step.F90
+   PUBLIC   trc_kpp       ! routine called by trcstp.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   wt0      !: surface temperature flux for non local flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ws0      !: surface salinity flux for non local flux
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   hkpp     !: boundary layer depth
+
+   !                                        !!* Namelist namzdf_kpp *
+   REAL(wp) ::   rn_difmiw  =  1.2e-04_wp    ! constant internal wave viscosity (m2/s)
+   REAL(wp) ::   rn_difsiw  =  1.2e-05_wp    ! constant internal wave diffusivity (m2/s)
+   REAL(wp) ::   rn_riinfty =  0.8_wp        ! local Richardson Number limit for shear instability
+   REAL(wp) ::   rn_difri   =  5.e-03_wp     ! maximum shear mixing at Rig = 0    (m2/s)
+   REAL(wp) ::   rn_bvsqcon = -1.e-09_wp     ! Brunt-Vaisala squared (1/s**2) for maximum convection
+   REAL(wp) ::   rn_difcon  =  1._wp         ! maximum mixing in interior convection (m2/s)
+   INTEGER  ::   nn_ave     =  1             ! = 0/1 flag for horizontal average on avt, avmu, avmv
+
+#if defined key_zdfddm
+   !                                        !!! ** Double diffusion Mixing
+   REAL(wp) ::   difssf  = 1.e-03_wp         ! maximum salt fingering mixing 
+   REAL(wp) ::   Rrho0   = 1.9_wp            ! limit for salt  fingering mixing 
+   REAL(wp) ::   difsdc  = 1.5e-06_wp        ! maximum diffusive convection mixing
+#endif
+   LOGICAL  ::   ln_kpprimix  = .TRUE.       ! Shear instability mixing 
+
+   !                                        !!! ** General constants  **
+   REAL(wp) ::   epsln   = 1.0e-20_wp        ! a small positive number    
+   REAL(wp) ::   pthird  = 1._wp/3._wp       ! 1/3
+   REAL(wp) ::   pfourth = 1._wp/4._wp       ! 1/4
+
+   !                                        !!! ** Boundary Layer Turbulence Parameters  **
+   REAL(wp) ::   vonk     = 0.4_wp           ! von Karman's constant
+   REAL(wp) ::   epsilon  = 0.1_wp           ! nondimensional extent of the surface layer
+   REAL(wp) ::   rconc1   = 5.0_wp           ! standard flux profile function parmaeters
+   REAL(wp) ::   rconc2   = 16.0_wp          !         "        "
+   REAL(wp) ::   rconcm   = 8.38_wp          ! momentum flux profile fit
+   REAL(wp) ::   rconam   = 1.26_wp          !         "       "
+   REAL(wp) ::   rzetam   = -.20_wp          !         "       "       
+   REAL(wp) ::   rconcs   = 98.96_wp         !  scalar  flux profile fit
+   REAL(wp) ::   rconas   = -28.86_wp        !         "       "
+   REAL(wp) ::   rzetas   = -1.0_wp          !         "       "  
+   
+   !                                        !!! ** Boundary Layer Depth Diagnostic  **
+   REAL(wp) ::   Ricr     = 0.3_wp           ! critical bulk Richardson Number
+   REAL(wp) ::   rcekman  = 0.7_wp           ! coefficient for ekman depth  
+   REAL(wp) ::   rcmonob  = 1.0_wp           ! coefficient for Monin-Obukhov depth 
+   REAL(wp) ::   rconcv   = 1.7_wp           ! ratio of interior buoyancy frequency to its value at entrainment depth
+   REAL(wp) ::   hbf      = 1.0_wp           ! fraction of bound. layer depth to which absorbed solar 
+      !                                      ! rad. and contributes to surf. buo. forcing
+   REAL(wp) ::   Vtc                         ! function of rconcv,rconcs,epsilon,vonk,Ricr
+   
+   !                                        !!! ** Nonlocal Boundary Layer Mixing **
+   REAL(wp) ::   rcstar   = 5.0_wp           ! coefficient for convective nonlocal transport
+   REAL(wp) ::   rcs      = 1.0e-3_wp        ! conversion: mm/s ==> m/s   
+   REAL(wp) ::   rcg                         ! non-dimensional coefficient for nonlocal transport
+
+#if ! defined key_kppcustom
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   del     ! array for reference mean values of vertical integration 
+#endif
+
+#if defined key_kpplktb
+   !                                         !!! ** Parameters for lookup table for turbulent velocity scales ** 
+   INTEGER, PARAMETER ::   nilktb   = 892     ! number of values for zehat in KPP lookup table
+   INTEGER, PARAMETER ::   njlktb   = 482     ! number of values for ustar in KPP lookup table
+   INTEGER, PARAMETER ::   nilktbm1 = nilktb-1   !
+   INTEGER, PARAMETER ::   njlktbm1 = njlktb-1   !
+
+   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale (momentum)
+   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale (tracers)
+
+   REAL(wp) ::   dehatmin = -4.e-7_wp    ! minimum limit for zhat in lookup table (m3/s3) 
+   REAL(wp) ::   dehatmax = 0._wp        ! maximum limit for zhat in lookup table (m3/s3)
+   REAL(wp) ::   ustmin   = 0._wp        ! minimum limit for ustar in lookup table (m/s)
+   REAL(wp) ::   ustmax   = 0.04_wp      ! maximum limit for ustar in lookup table (m/s)    
+   REAL(wp) ::   dezehat                 ! delta zhat in lookup table
+   REAL(wp) ::   deustar                 ! delta ustar in lookup table
+#endif
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   ratt   ! attenuation coef  (already defines in module traqsr, 
+   !                                    ! but only if the solar radiation penetration is considered)
+   
+   !                                    !!! * penetrative solar radiation coefficient *
+   REAL(wp) ::   rabs = 0.58_wp          ! fraction associated with xsi1
+   REAL(wp) ::   xsi1 = 0.35_wp          ! first depth of extinction 
+   REAL(wp) ::   xsi2 = 23.0_wp          ! second depth of extinction 
+      !                           ! (default values: water type Ib) 
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   etmean, eumean, evmean   ! coeff. used for hor. smoothing at t-, u- & v-points
+        
+#if defined key_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rig    !: gradient Richardson number
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rib    !: bulk Richardson number
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   buof   !: buoyancy forcing
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   mols   !: moning-Obukhov length scale 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ekdp   !: Ekman depth
+#endif
+
+   INTEGER  ::   jip = 62 , jjp = 111
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+#  include  "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION zdf_kpp_alloc()
+      !!----------------------------------------------------------------------
+      !!                 ***  FUNCTION zdf_kpp_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ghats(jpi,jpj,jpk), wt0(jpi,jpj), ws0(jpi,jpj), hkpp(jpi,jpj), &
+#if ! defined key_kpplktb
+         &      del(jpk,jpk),                                                  &
+#endif
+         &      ratt(jpk),                                                     &
+         &      etmean(jpi,jpj,jpk), eumean(jpi,jpj,jpk), evmean(jpi,jpj,jpk), &
+#if defined key_c1d
+         &      rig (jpi,jpj,jpk), rib(jpi,jpj,jpk), buof(jpi,jpj,jpk),        &
+         &      mols(jpi,jpj,jpk), ekdp(jpi,jpj),                              &
+#endif
+         &      STAT= zdf_kpp_alloc )
+         !
+      IF( lk_mpp             )   CALL mpp_sum ( zdf_kpp_alloc )
+      IF( zdf_kpp_alloc /= 0 )   CALL ctl_warn('zdf_kpp_alloc: failed to allocate arrays')
+   END FUNCTION zdf_kpp_alloc
+
+
+   SUBROUTINE zdf_kpp( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE zdf_kpp  ***
+      !!
+      !! ** Purpose :   Compute the vertical eddy viscosity and diffusivity
+      !!      coefficients and non local mixing using K-profile parameterization
+      !!
+      !! ** Method :   The boundary layer depth hkpp is diagnosed at tracer points
+      !!      from profiles of buoyancy, and shear, and the surface forcing.
+      !!      Above hbl (sigma=-z/hbl <1) the mixing coefficients are computed from 
+      !!
+      !!                      Kx =  hkpp  Wx(sigma) G(sigma)  
+      !!
+      !!             and the non local term ghat = Cs / Ws(sigma) / hkpp
+      !!      Below hkpp  the coefficients are the sum of mixing due to internal waves
+      !!      shear instability and double diffusion.
+      !!
+      !!      -1- Compute the now interior vertical mixing coefficients at all depths. 
+      !!      -2- Diagnose the boundary layer depth. 
+      !!      -3- Compute the now boundary layer vertical mixing coefficients. 
+      !!      -4- Compute the now vertical eddy vicosity and diffusivity.
+      !!      -5- Smoothing
+      !!
+      !!        N.B. The computation is done from jk=2 to jpkm1 
+      !!             Surface value of avt avmu avmv are set once a time to zero
+      !!             in routine zdf_kpp_init.
+      !!
+      !! ** Action  :   update the non-local terms ghats
+      !!                update avt, avmu, avmv (before vertical eddy coef.)
+      !!
+      !! References : Large W.G., Mc Williams J.C. and Doney S.C.              
+      !!         Reviews of Geophysics, 32, 4, November 1994
+      !!         Comments in the code refer to this paper, particularly 
+      !!         the equation number. (LMD94, here after)
+      !!----------------------------------------------------------------------
+      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace
+      USE oce     , zdiffut => va   ! temp. array for diffusivities use sa as workspace
+      !!
+      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
+      !!
+      INTEGER ::   ji, jj, jk              ! dummy loop indices
+      INTEGER ::   ikbot, jkmax, jkm1, jkp2   !
+
+      REAL(wp) ::   ztx, zty, zflageos, zstabl, zbuofdep,zucube     !
+      REAL(wp) ::   zrhos, zalbet, zbeta, zthermal, zhalin, zatt1   !
+      REAL(wp) ::   zref, zt, zs, zh, zu, zv, zrh                   ! Bulk richardson number
+      REAL(wp) ::   zrib, zrinum, zdVsq, zVtsq                      !
+      REAL(wp) ::   zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm   ! Velocity scales
+#if defined key_kpplktb
+      INTEGER ::    il, jl                                          ! Lookup table or Analytical functions 
+      REAL(wp) ::   ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs        !
+#else
+      REAL(wp) ::   zwsun, zwmun, zcons, zconm, zwcons, zwconm      !
+#endif
+      REAL(wp) ::   zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed   ! In situ density
+#if ! defined key_kppcustom     
+      INTEGER  ::   jm                          ! dummy loop indices
+      REAL(wp) ::   zr1, zr2, zr3, zr4, zrhop   ! Compression terms
+#endif
+      REAL(wp) ::   zflag, ztemp, zrn2, zdep21, zdep32, zdep43
+      REAL(wp) ::   zdku2, zdkv2, ze3sqr, zsh2, zri, zfri          ! Interior richardson mixing
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmoek                 ! Moning-Obukov limitation
+      REAL(wp), POINTER, DIMENSION(:)   ::   zmoa, zekman                
+      REAL(wp)                          ::   zmob, zek
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdepw, zdift, zvisc   ! The pipe 
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zdept
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zriblk
+      REAL(wp), POINTER, DIMENSION(:)   ::   zhmax, zria, zhbl 
+      REAL(wp) ::   zflagri, zflagek, zflagmo, zflagh, zflagkb   !
+      REAL(wp), POINTER, DIMENSION(:)   ::   za2m, za3m, zkmpm, za2t, za3t, zkmpt   ! Shape function (G)
+      REAL(wp) ::   zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t
+#if defined key_zdfddm
+      REAL(wp) ::   zrrau, zds, zavdds, zavddt,zinr   ! double diffusion mixing
+      REAL(wp), POINTER, DIMENSION(:,:) ::     zdifs
+      REAL(wp), POINTER, DIMENSION(:)   ::   za2s, za3s, zkmps
+      REAL(wp) ::                            zkm1s
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zblcs
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdiffus
+#endif
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zBo, zBosol, zustar         ! Surface buoyancy forcing, friction velocity
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zmask, zblcm, zblct
+      !!--------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp')
+      !
+      CALL wrk_alloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
+      CALL wrk_alloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
+      CALL wrk_alloc( jpi,2, zriblk )
+      CALL wrk_alloc( jpi,3, zmoek, kjstart = 0 )
+      CALL wrk_alloc( jpi,3, zdept )
+      CALL wrk_alloc( jpi,4, zdepw, zdift, zvisc )
+      CALL wrk_alloc( jpi,jpj, zBo, zBosol, zustar )
+      CALL wrk_alloc( jpi,jpk, zmask, zblcm, zblct, zblcs )
+#if defined key_zdfddm
+      CALL wrk_alloc( jpi,4, zdifs )
+      CALL wrk_alloc( jpi, zmoa, za2s, za3s, zkmps )
+      CALL wrk_alloc( jpi,jpk, zblcs )
+      CALL wrk_alloc( jpi,jpi,jpk, zdiffus )
+#endif
+
+      zviscos(:,:,:) = 0.
+      zblcm  (:,:  ) = 0. 
+      zdiffut(:,:,:) = 0.
+      zblct  (:,:  ) = 0. 
+#if defined key_zdfddm
+      zdiffus(:,:,:) = 0.
+      zblcs  (:,:  ) = 0. 
+#endif
+      ghats(:,:,:) = 0.
+     
+      zBo   (:,:) = 0.
+      zBosol(:,:) = 0.
+      zustar(:,:) = 0.
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! I. Interior diffusivity and viscosity at w points ( T interfaces)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  
+      DO jk = 2, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1 
+               ! Mixing due to internal waves breaking
+               ! -------------------------------------
+               avmu(ji,jj,jk)  = rn_difmiw 
+               avt (ji,jj,jk)  = rn_difsiw             
+               ! Mixing due to vertical shear instability
+               ! -------------------------------------               
+               IF( ln_kpprimix ) THEN          
+                  ! Compute the gradient Richardson  number at interfaces (zri):
+                  ! LMD94, eq. 27 (is vertical smoothing needed : Rig=N^2 / (dz(u))^2 + (dz(v))^2
+                  zdku2 =   ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
+                     &    * ( un(ji - 1,jj,jk - 1) - un(ji - 1,jj,jk) ) &
+                     &    + ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) ) &
+                     &    * ( un(ji    ,jj,jk - 1) - un(ji    ,jj,jk) )  
+                  
+                  zdkv2 =   ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
+                     &    * ( vn(ji,jj - 1,jk - 1) - vn(ji,jj - 1,jk) ) &
+                     &    + ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) ) &
+                     &    * ( vn(ji,    jj,jk - 1) - vn(ji,    jj,jk) )  
+
+                  ze3sqr = 1. / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) )
+                  ! Square of vertical shear  at interfaces
+                  zsh2   = 0.5 * ( zdku2 + zdkv2 ) * ze3sqr
+                  zri    = MAX( rn2(ji,jj,jk), 0. ) / ( zsh2 + epsln ) 
+#if defined key_c1d
+                  ! save the gradient richardson number
+                  rig(ji,jj,jk) = zri * tmask(ji,jj,jk)
+#endif                  
+                  ! Evaluate f of Ri (zri) for shear instability store in zfri
+                  ! LMD94, eq. 28a,b,c, figure 3 ; Rem: p1 is 3, hard coded
+                  zfri  = MAX( zri , 0. )
+                  zfri  = MIN( zfri / rn_riinfty , 1.0 )
+                  zfri  = ( 1.0 - zfri * zfri )
+                  zfri  = zfri * zfri  * zfri
+                  ! add shear contribution to mixing coef. 
+                  avmu(ji,jj,jk) =  avmu(ji,jj,jk) + rn_difri * zfri   
+                  avt (ji,jj,jk) =  avt (ji,jj,jk) + rn_difri * zfri    
+               ENDIF
+#if defined key_zdfddm 
+               avs (ji,jj,jk) =  avt (ji,jj,jk)              
+               !  Double diffusion mixing ; NOT IN ROUTINE ZDFDDM.F90
+               ! ------------------------------------------------------------------
+               ! only retains positive value of rrau
+               zrrau = MAX( rrau(ji,jj,jk), epsln )
+               zds   = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal)
+               IF( zrrau > 1. .AND. zds > 0.) THEN
+                  !
+                  ! Salt fingering case.
+                  !---------------------
+                  ! Compute interior diffusivity for double diffusive mixing of
+                  ! salinity. Upper bound "zrrau" by "Rrho0"; (Rrho0=1.9, difcoefnuf=0.001).
+                  ! After that set interior diffusivity for double diffusive mixing
+                  ! of temperature
+                  zavdds = MIN( zrrau, Rrho0 )
+                  zavdds = ( zavdds - 1.0 ) / ( Rrho0 - 1.0 )
+                  zavdds = 1.0 - zavdds * zavdds 
+                  zavdds = zavdds * zavdds * zavdds 
+                  zavdds = difssf * zavdds 
+                  zavddt = 0.7 * zavdds
+               ELSEIF( zrrau < 1. .AND. zrrau > 0. .AND. zds < 0.) THEN
+                  !
+                  ! Diffusive convection case.
+                  !---------------------------
+                  ! Compute interior diffusivity for double diffusive mixing of
+                  ! temperature (Marmorino and Caldwell, 1976); 
+                  ! Compute interior diffusivity for double diffusive mixing of salinity 
+                  zinr   = 1. / zrrau
+                  zavddt = 0.909 * EXP( 4.6 * EXP( -0.54* ( zinr - 1. ) ) ) 
+                  zavddt = difsdc * zavddt
+                  IF( zrrau < 0.5) THEN
+                     zavdds = zavddt * 0.15 * zrrau
+                  ELSE
+                     zavdds = zavddt * (1.85 * zrrau - 0.85 ) 
+                  ENDIF
+               ELSE
+                  zavddt = 0.
+                  zavdds = 0.
+               ENDIF 
+               ! Add double diffusion contribution to temperature and salinity  mixing coefficients.
+               avt (ji,jj,jk) =  avt (ji,jj,jk) +  zavddt 
+               avs (ji,jj,jk) =  avs (ji,jj,jk) +  zavdds         
+#endif                      
+            END DO
+         END DO
+      END DO
+
+
+      ! Radiative (zBosol) and non radiative (zBo) surface buoyancy
+      !JMM at the time zdfkpp is called, q still holds the sum q + qsr
+      !---------------------------------------------------------------------
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1     
+            IF( nn_eos < 1) THEN   
+               zt     = tsn(ji,jj,1,jp_tem)
+               zs     = tsn(ji,jj,1,jp_sal) - 35.0
+               zh     = fsdept(ji,jj,1)
+               !  potential volumic mass
+               zrhos  = rhop(ji,jj,1)
+               zalbet = ( ( ( - 0.255019e-07 * zt + 0.298357e-05 ) * zt   &   ! ratio alpha/beta
+                  &                               - 0.203814e-03 ) * zt   &
+                  &                               + 0.170907e-01 ) * zt   &
+                  &   + 0.665157e-01                                      &
+                  &   +     ( - 0.678662e-05 * zs                         &
+                  &           - 0.846960e-04 * zt + 0.378110e-02 ) * zs   &
+                  &   +   ( ( - 0.302285e-13 * zh                         &
+                  &           - 0.251520e-11 * zs                         &
+                  &           + 0.512857e-12 * zt * zt           ) * zh   &
+                  &           - 0.164759e-06 * zs                         &
+                  &        +(   0.791325e-08 * zt - 0.933746e-06 ) * zt   &
+                  &                               + 0.380374e-04 ) * zh
+
+               zbeta  = ( ( -0.415613e-09 * zt + 0.555579e-07 ) * zt      &   ! beta
+                  &                            - 0.301985e-05 ) * zt      &
+                  &   + 0.785567e-03                                      &
+                  &   + (     0.515032e-08 * zs                           &
+                  &         + 0.788212e-08 * zt - 0.356603e-06 ) * zs     &
+                  &   +(  (   0.121551e-17 * zh                           &
+                  &         - 0.602281e-15 * zs                           &
+                  &         - 0.175379e-14 * zt + 0.176621e-12 ) * zh     &
+                  &                             + 0.408195e-10   * zs     &
+                  &     + ( - 0.213127e-11 * zt + 0.192867e-09 ) * zt     &
+                  &                             - 0.121555e-07 ) * zh
+
+               zthermal = zbeta * zalbet / ( rcp * zrhos + epsln )
+               zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs
+            ELSE
+               zrhos    = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) )
+               zthermal = rn_alpha / ( rcp * zrhos + epsln )
+               zhalin   = rn_beta * tsn(ji,jj,1,jp_sal) * rcs
+            ENDIF
+            ! Radiative surface buoyancy force
+            zBosol(ji,jj) = grav * zthermal * qsr(ji,jj)
+            ! Non radiative surface buoyancy force
+            zBo   (ji,jj) = grav * zthermal * qns(ji,jj) -  grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) ) 
+            ! Surface Temperature flux for non-local term
+            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1)
+            ! Surface salinity flux for non-local term
+            ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1) 
+         ENDDO
+      ENDDO
+
+      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. ) 
+      !  Compute surface buoyancy forcing, Monin Obukhov and Ekman depths  
+      !------------------------------------------------------------------    
+      DO jj = 2, jpjm1
+         DO ji = fs_2, fs_jpim1
+            !  Reference surface density = density at first T point level   
+            zrhos         = rhop(ji,jj,1) + zflageos * rau0 * ( 1. - tmask(ji,jj,1) )  
+            ! Friction velocity (zustar), at T-point : LMD94 eq. 2
+            zustar(ji,jj) = SQRT( taum(ji,jj) / ( zrhos +  epsln ) )
+         ENDDO
+      ENDDO
+
+!CDIR NOVERRCHK  
+      !                                               ! ===============
+      DO jj = 2, jpjm1                                 !  Vertical slab
+         !                                             ! ===============
+         
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+         ! II Compute Boundary layer mixing coef. and diagnose the new boundary layer depth
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+         
+         ! Initialization
+         jkmax       = 0
+         zdept (:,:) = 0.
+         zdepw (:,:) = 0.
+         zriblk(:,:) = 0.
+         zmoek (:,:) = 0.
+         zvisc (:,:) = 0.
+         zdift (:,:) = 0.
+#if defined key_zdfddm
+         zdifs (:,:) = 0.
+#endif
+         zmask (:,:) = 0.
+         DO ji = fs_2, fs_jpim1
+            zria(ji ) = 0.
+            ! Maximum boundary layer depth
+            ikbot     = mbkt(ji,jj)    ! ikbot is the last T point in the water
+            zhmax(ji) = fsdept(ji,jj,ikbot) - 0.001      
+            ! Compute Monin obukhov length scale at the surface and Ekman depth:
+            zbuofdep   = zBo(ji,jj) + zBosol(ji,jj) * ratt(1)
+            zekman(ji) = rcekman * zustar(ji,jj) / ( ABS( ff(ji,jj) ) + epsln )
+            zucube     = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) 
+            zmoa(ji)   = zucube / ( vonk * ( zbuofdep + epsln ) )   
+#if defined key_c1d
+            ! store the surface buoyancy forcing
+            zstabl        = 0.5 + SIGN( 0.5, zbuofdep )
+            buof(ji,jj,1) = zbuofdep * tmask(ji,jj,1)
+            ! store the moning-oboukov length scale at surface
+            zmob          = zstabl * zmoa(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)
+            mols(ji,jj,1) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,1)
+            ! store Ekman depth
+            zek           = zstabl * zekman(ji) + ( 1.0 - zstabl ) * fsdept(ji,jj,1)  
+            ekdp(ji,jj )  = MIN( zek , zhmax(ji) ) * tmask(ji,jj,1)  
+#endif 
+         END DO     
+         ! Compute the pipe
+         ! ---------------------
+         DO jk = 2, jpkm1
+            DO ji = fs_2, fs_jpim1
+               ! Compute bfsfc = Bo + radiative contribution down to hbf*depht
+               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * ratt(jk)
+               ! Flag (zstabl  = 1) if positive forcing
+               zstabl   =  0.5 + SIGN(  0.5, zbuofdep)
+
+               !   Compute bulk richardson number zrib at depht 
+               !-------------------------------------------------------
+               !                           [Br - B(d)] * d         zrinum
+               !             Rib(z) = ----------------------- = -------------
+               !                       |Vr - V(d)|^2 + Vt(d)^2   zdVsq + zVtsq
+               !
+               ! First compute zt,zs,zu,zv = means in the surface layer < epsilon*depht  
+               ! Else surface values are taken at the first T level.
+               ! For stability, resolved vertical shear is computed with "before velocities".
+               zref = epsilon * fsdept(ji,jj,jk)
+#if defined key_kppcustom
+               ! zref = gdept(1)
+               zref = fsdept(ji,jj,1)
+               zt   = tsn(ji,jj,1,jp_tem)
+               zs   = tsn(ji,jj,1,jp_sal)
+               zrh  = rhop(ji,jj,1)
+               zu   = ( ub(ji,jj,1) + ub(ji - 1,jj    ,1) ) / MAX( 1. , umask(ji,jj,1) + umask(ji - 1,jj   ,1) )
+               zv   = ( vb(ji,jj,1) + vb(ji    ,jj - 1,1) ) / MAX( 1. , vmask(ji,jj,1) + vmask(ji   ,jj - 1,1) )
+#else
+               zt   = 0.
+               zs   = 0.
+               zu   = 0.
+               zv   = 0.
+               zrh  = 0.
+               ! vertically integration over the upper epsilon*gdept(jk) ; del () array is computed once in zdf_kpp_init
+               DO jm = 1, jpkm1
+                  zt   = zt  + del(jk,jm) * tsn(ji,jj,jm,jp_tem)
+                  zs   = zs  + del(jk,jm) * tsn(ji,jj,jm,jp_sal)
+                  zu   = zu  + 0.5 * del(jk,jm) &
+                     &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) &
+                     &            / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) )
+                  zv   = zv  + 0.5 * del(jk,jm) &
+                     &            * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) &
+                     &            / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) )
+                  zrh  = zrh + del(jk,jm) * rhop(ji,jj,jm)
+               END DO
+#endif
+               zsr = SQRT( ABS( tsn(ji,jj,jk,jp_sal) ) )
+               ! depth
+               zh = fsdept(ji,jj,jk)
+               ! compute compression terms on density
+               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
+               zcomp =   1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )
+               
+#if defined key_kppcustom
+               ! potential density of water(zrh = zt,zs at level jk):
+               zrhdr = zrh / zcomp
+#else
+               ! potential density of water(ztref,zsref at level jk):
+               ! compute volumic mass pure water at atm pressure
+               IF ( nn_eos < 1 ) THEN
+                  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                 
+                  zrhdr = zrhop / zcomp
+               ELSE
+                  zrhdr = zrh / zcomp
+               ENDIF
+#endif
+               
+               ! potential density of ambiant water at level jk :
+               zrhd   = ( rhd(ji,jj,jk) * rau0 + rau0 )  
+               
+               ! And now the Rib number numerator .
+               zrinum = grav * ( zrhd - zrhdr ) / rau0
+               zrinum = zrinum * ( fsdept(ji,jj,jk) - zref ) * tmask(ji,jj,jk)
+           
+               ! Resolved shear contribution to Rib at depth T-point (zdVsq)
+               ztx    =   ( ub( ji , jj ,jk)   +  ub(ji - 1, jj ,jk) ) &
+                  &     / MAX( 1. , umask( ji , jj ,jk) + umask(ji - 1, jj ,jk) )   
+               zty    =   ( vb( ji , jj ,jk)   +  vb(ji  ,jj - 1,jk) ) &
+                  &     / MAX( 1., vmask( ji , jj ,jk) + vmask(ji  ,jj - 1,jk) ) 
+               
+               zdVsq  = ( zu - ztx ) * ( zu - ztx ) + ( zv - zty ) * ( zv - zty )
+               
+               ! Scalar turbulent velocity scale zws for hbl=gdept
+               zscale = zstabl + ( 1.0 - zstabl ) * epsilon
+               zehat  = vonk * zscale * fsdept(ji,jj,jk) * zbuofdep
+               zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
+               zeta   = zehat / ( zucube + epsln )
+               
+               IF( zehat > 0. ) THEN
+                  ! Stable case
+                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
+               ELSE
+                  ! Unstable case
+#if defined key_kpplktb
+                  ! use lookup table
+                  zd     = zehat - dehatmin
+                  il     = INT( zd / dezehat )
+                  il     = MIN( il, nilktbm1 )
+                  il     = MAX( il, 1 )
+                  
+                  ud     = zustar(ji,jj) - ustmin
+                  jl     = INT( ud / deustar )
+                  jl     = MIN( jl, njlktbm1 )
+                  jl     = MAX( jl, 1 )
+                  
+                  zfrac  = zd / dezehat - FLOAT( il )  
+                  ufrac  = ud / deustar - FLOAT( jl )
+                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
+                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
+                  !
+                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
+#else
+                  ! use analytical functions:
+                  zcons  = 0.5 + SIGN( 0.5 , ( rzetas - zeta ) )
+                  zwcons = vonk * zustar(ji,jj) * ( ( ABS( rconas - rconcs * zeta ) )**pthird ) 
+                  zwsun  = vonk * zustar(ji,jj) * SQRT( ABS ( 1.0 - rconc2 * zeta ) )
+                  !
+                  zws    = zcons * zwcons +  ( 1.0 - zcons) * zwsun
+#endif
+               ENDIF
+               
+               ! Turbulent shear contribution to Rib (zVtsq) bv frequency at levels  ( ie T-point jk)
+               zrn2   = 0.5 * ( rn2(ji,jj,jk) + rn2(ji,jj,jk+1) )   
+               zbvzed = SQRT( ABS( zrn2 ) ) 
+               zVtsq  = fsdept(ji,jj,jk) * zws * zbvzed  * Vtc
+               
+               ! Finally, the bulk Richardson number at depth fsdept(i,j,k) 
+               zrib  = zrinum   / ( zdVsq + zVtsq + epsln )
+ 
+               ! Find subscripts around the boundary layer depth, build the pipe
+               ! ----------------------------------------------------------------
+
+               ! Flag (zflagri = 1) if zrib < Ricr  
+               zflagri = 0.5 + SIGN( 0.5, ( Ricr - zrib ) )
+               !  Flag (zflagh  = 1) if still within overall boundary layer
+               zflagh  = 0.5 + SIGN( 0.5, ( fsdept(ji,jj,1) - zdept(ji,2) ) )
+               
+               ! Ekman layer depth
+               zek     = zstabl * zekman(ji) + ( 1.0 - zstabl ) * zhmax(ji)
+               zflag   = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk-1) ) )
+               zek     = zflag * zek + ( 1.0 - zflag ) * zhmax(ji)
+               zflagek = 0.5 + SIGN( 0.5, ( zek - fsdept(ji,jj,jk) ) )
+               ! Flag (zflagmo = 1) if still within stable Monin-Obukhov and in water
+               zmob    = zucube / ( vonk * ( zbuofdep + epsln ) )  
+               ztemp   = zstabl * zmob + ( 1.0 - zstabl) * zhmax(ji)
+               ztemp   = MIN( ztemp , zhmax(ji) ) 
+               zflagmo = 0.5 + SIGN( 0.5, ( ztemp - fsdept(ji,jj,jk) ) )             
+
+               ! No limitation by Monin Obukhov or Ekman depths:
+!               zflagek = 1.0
+!               zflagmo = 0.5 + SIGN( 0.5, ( zhmax(ji) - fsdept(ji,jj,jk) ) )
+
+               ! Load  pipe via zflagkb  for later calculations
+               ! Flag (zflagkb = 1) if zflagh = 1 and (zflagri = 0 or zflagek = 0 or zflagmo = 0)
+               zflagkb = zflagh * ( 1.0 - ( zflagri * zflagek * zflagmo ) )
+
+               zmask(ji,jk) = zflagh
+               jkp2         = MIN( jk+2 , ikbot )
+               jkm1         = MAX( jk-1 , 2 )
+               jkmax        = MAX( jkmax, jk * INT( REAL( zflagh+epsln ) ) ) 
+
+               zdept(ji,1)  = zdept(ji,1) + zflagkb * fsdept(ji,jj,jk-1) 
+               zdept(ji,2)  = zdept(ji,2) + zflagkb * fsdept(ji,jj,jk  ) 
+               zdept(ji,3)  = zdept(ji,3) + zflagkb * fsdept(ji,jj,jk+1) 
+
+               zdepw(ji,1)  = zdepw(ji,1) + zflagkb * fsdepw(ji,jj,jk-1) 
+               zdepw(ji,2)  = zdepw(ji,2) + zflagkb * fsdepw(ji,jj,jk  ) 
+               zdepw(ji,3)  = zdepw(ji,3) + zflagkb * fsdepw(ji,jj,jk+1)
+               zdepw(ji,4)  = zdepw(ji,4) + zflagkb * fsdepw(ji,jj,jkp2)  
+
+               zriblk(ji,1) = zriblk(ji,1) + zflagkb * zria(ji)
+               zriblk(ji,2) = zriblk(ji,2) + zflagkb * zrib
+
+               zmoek (ji,0) = zmoek (ji,0) + zflagkb * zek
+               zmoek (ji,1) = zmoek (ji,1) + zflagkb * zmoa(ji)
+               zmoek (ji,2) = zmoek (ji,2) + zflagkb * ztemp  
+               ! Save Monin Obukhov depth
+               zmoa  (ji)   = zmob
+           
+               zvisc(ji,1) = zvisc(ji,1) + zflagkb * avmu(ji,jj,jkm1)
+               zvisc(ji,2) = zvisc(ji,2) + zflagkb * avmu(ji,jj,jk  )
+               zvisc(ji,3) = zvisc(ji,3) + zflagkb * avmu(ji,jj,jk+1)
+               zvisc(ji,4) = zvisc(ji,4) + zflagkb * avmu(ji,jj,jkp2)
+               
+               zdift(ji,1) = zdift(ji,1) + zflagkb * avt (ji,jj,jkm1)
+               zdift(ji,2) = zdift(ji,2) + zflagkb * avt (ji,jj,jk  )
+               zdift(ji,3) = zdift(ji,3) + zflagkb * avt (ji,jj,jk+1)
+               zdift(ji,4) = zdift(ji,4) + zflagkb * avt (ji,jj,jkp2)
+
+#if defined key_zdfddm
+               zdifs(ji,1) = zdifs(ji,1) + zflagkb * avs (ji,jj,jkm1)
+               zdifs(ji,2) = zdifs(ji,2) + zflagkb * avs (ji,jj,jk  )
+               zdifs(ji,3) = zdifs(ji,3) + zflagkb * avs (ji,jj,jk+1)
+               zdifs(ji,4) = zdifs(ji,4) + zflagkb * avs (ji,jj,jkp2)
+#endif               
+               ! Save the Richardson number 
+               zria  (ji)   = zrib  
+#if defined key_c1d
+               ! store buoyancy length scale
+               buof(ji,jj,jk) = zbuofdep * tmask(ji,jj,jk) 
+               ! store Monin Obukhov
+               zmob           = zstabl * zmob + ( 1.0 - zstabl) * fsdept(ji,jj,1)
+               mols(ji,jj,jk) = MIN( zmob , zhmax(ji) ) * tmask(ji,jj,jk) 
+               ! Bulk Richardson number
+               rib(ji,jj,jk)  = zrib * tmask(ji,jj,jk)             
+#endif               
+            END DO
+         END DO
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+         ! III PROCESS THE PIPE
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+         
+         DO ji = fs_2, fs_jpim1 
+            
+            ! Find the boundary layer depth zhbl
+            ! ----------------------------------------
+            
+            ! Interpolate monin Obukhov and critical Ri mumber depths   
+            ztemp = zdept(ji,2) - zdept(ji,1)
+            zflag = ( Ricr - zriblk(ji,1) ) / ( zriblk(ji,2) - zriblk(ji,1)  + epsln )
+            zhrib = zdept(ji,1) + zflag * ztemp      
+
+            IF( zriblk(ji,2) < Ricr ) zhrib = zhmax(ji) 
+         
+            IF( zmoek(ji,2) < zdept(ji,2) ) THEN
+               IF ( zmoek(ji,1) < 0. ) THEN
+                  zmob = zdept(ji,2) - epsln
+               ELSE
+                  zmob = ztemp + zmoek(ji,1) - zmoek(ji,2)
+                  zmob = ( zmoek(ji,1) * zdept(ji,2) - zmoek(ji,2) * zdept(ji,1) ) / zmob
+                  zmob = MAX( zmob , zdept(ji,1) + epsln )                
+               ENDIF
+            ELSE           
+               zmob = zhmax(ji) 
+            ENDIF
+            ztemp   = MIN( zmob , zmoek(ji,0) )
+                         
+            ! Finally, the boundary layer depth, zhbl 
+            zhbl(ji) = MAX( fsdept(ji,jj,1) + epsln, MIN( zhrib , ztemp ) )
+            
+            ! Save hkpp for further diagnostics (optional)
+            hkpp(ji,jj) = zhbl(ji) * tmask(ji,jj,1) 
+          
+            ! Correct mask if zhbl < fsdepw(ji,jj,2) for no viscosity/diffusivity enhancement at fsdepw(ji,jj,2)
+            !     zflag = 1 if zhbl(ji) > fsdepw(ji,jj,2)
+            IF( zhbl(ji) < fsdepw(ji,jj,2) ) zmask(ji,2) = 0.
+          
+            
+            !  Velocity scales at depth zhbl
+            ! -----------------------------------
+            
+            !  Compute bouyancy forcing down to zhbl
+            ztemp    = -hbf * zhbl(ji)
+            zatt1    = 1.0 - ( rabs * EXP( ztemp / xsi1 ) + ( 1.0 - rabs ) * EXP( ztemp / xsi2 ) )
+            zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
+            zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
+
+            zbuofdep = zbuofdep + zstabl * epsln
+
+            zscale = zstabl + ( 1.0 - zstabl ) * epsilon          
+            zehat  = vonk * zscale * zhbl(ji) * zbuofdep
+            zucube = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)              
+            zeta   = zehat / ( zucube + epsln )
+            
+            IF( zehat > 0. ) THEN
+               ! Stable case
+               zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
+               zwm  = zws
+            ELSE
+               ! Unstable case
+#if defined key_kpplktb
+               ! use lookup table
+               zd     = zehat - dehatmin
+               il     = INT( zd / dezehat )
+               il     = MIN( il, nilktbm1 )
+               il     = MAX( il, 1 )
+               
+               ud     = zustar(ji,jj) - ustmin
+               jl     = INT( ud / deustar )
+               jl     = MIN( jl, njlktbm1 )
+               jl     = MAX( jl, 1 )
+               
+               zfrac  = zd / dezehat - FLOAT( il )  
+               ufrac  = ud / deustar - FLOAT( jl )
+               zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
+               zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
+               zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
+               zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
+               !
+               zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
+               zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
+#else
+               ! use analytical functions
+               zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
+               zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
+               
+               ! Momentum : zeta < rzetam (zconm = 1)
+               ! Scalars  : zeta < rzetas (zcons = 1) 
+               zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
+               zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
+               
+               ! Momentum : rzetam <= zeta < 0 (zconm = 0)
+               ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
+               zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
+               zwsun  = vonk * zustar(ji,jj) * zwmun
+               zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
+               !
+               zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
+               zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
+               
+#endif
+            ENDIF
+            
+            
+            ! Viscosity, diffusivity values and derivatives at h
+            ! --------------------------------------------------------
+            
+            ! check between at which interfaces is located zhbl(ji)
+            ! ztemp = 1, zdepw(ji,2) < zhbl <  zdepw(ji,3)
+            ! ztemp = 0, zdepw(ji,1) < zhbl <  zdepw(ji,2)
+            ztemp  =  0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )  
+            zdep21 =   zdepw(ji,2) - zdepw(ji,1) + epsln
+            zdep32 =   zdepw(ji,3) - zdepw(ji,2) + epsln
+            zdep43 =   zdepw(ji,4) - zdepw(ji,3) + epsln  
+            
+            ! Compute R as in LMD94, eq D5b
+            zdelta =  ( zhbl(ji) - zdepw(ji,2) ) *         ztemp   / zdep32   &
+               &    + ( zhbl(ji) - zdepw(ji,1) ) * ( 1.0 - ztemp ) / zdep21 
+            
+            ! Compute the vertical derivative of viscosities (zdzh) at z=zhbl(ji)
+            zdzup  =  ( zvisc(ji,2) - zvisc(ji,3) ) *         ztemp   / zdep32 &
+               &    + ( zvisc(ji,1) - zvisc(ji,2) ) * ( 1.0 - ztemp ) / zdep21
+            
+            zdzdn  =  ( zvisc(ji,3) - zvisc(ji,4) ) *         ztemp   / zdep43 &
+               &    + ( zvisc(ji,2) - zvisc(ji,3) ) * ( 1.0 - ztemp ) / zdep32
+            
+            ! LMD94, eq D5b :          
+            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
+            zdzh   = MAX( zdzh , 0. )
+            
+            ! Compute viscosities (zvath) at z=zhbl(ji), LMD94 eq D5a
+            zvath  =          ztemp   * ( zvisc(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
+               &    + ( 1.0 - ztemp ) * ( zvisc(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
+            
+            ! Compute G (zgat1) and its derivative (zdat1) at z=hbl(ji), LMD94 eq 18
+            
+            ! Vertical derivative of velocity scale divided by velocity scale squared at z=hbl(ji) 
+            ! (non zero only in stable conditions)
+            zflag  =  -zstabl * rconc1 * zbuofdep / ( zucube * zustar(ji,jj) + epsln )
+            
+            ! G at its derivative at z=hbl:
+            zgat1  = zvath  / ( zhbl(ji) * ( zwm + epsln )  )
+            zdat1  = -zdzh  / ( zwm + epsln ) -  zflag * zvath / zhbl(ji)
+            
+            ! G coefficients, LMD94 eq 17
+            za2m(ji) = -2.0 + 3.0 * zgat1 - zdat1
+            za3m(ji) =  1.0 - 2.0 * zgat1 + zdat1
+
+            
+            ! Compute the vertical derivative of temperature diffusivities (zdzh) at z=zhbl(ji)
+            zdzup  =  ( zdift(ji,2) - zdift(ji,3) ) *         ztemp   / zdep32 &
+               &    + ( zdift(ji,1) - zdift(ji,2) ) * ( 1.0 - ztemp ) / zdep21
+            
+            zdzdn  =  ( zdift(ji,3) - zdift(ji,4) ) *         ztemp   / zdep43 &
+               &    + ( zdift(ji,2) - zdift(ji,3) ) * ( 1.0 - ztemp ) / zdep32
+            
+            ! LMD94, eq D5b :          
+            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
+            zdzh   = MAX( zdzh , 0. )
+            
+            
+            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
+            zvath  =          ztemp   * ( zdift(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
+               &    + ( 1.0 - ztemp ) * ( zdift(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
+                        
+            ! G at its derivative at z=hbl:
+            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
+            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
+            
+            ! G coefficients, LMD94 eq 17
+            za2t(ji) = -2.0 + 3.0 * zgat1 - zdat1
+            za3t(ji) =  1.0 - 2.0 * zgat1 + zdat1
+
+#if defined key_zdfddm
+            ! Compute the vertical derivative of salinities diffusivities (zdzh) at z=zhbl(ji)
+            zdzup  =  ( zdifs(ji,2) - zdifs(ji,3) ) *         ztemp   / zdep32 &
+               &    + ( zdifs(ji,1) - zdifs(ji,2) ) * ( 1.0 - ztemp ) / zdep21
+            
+            zdzdn  =  ( zdifs(ji,3) - zdifs(ji,4) ) *         ztemp   / zdep43 &
+               &    + ( zdifs(ji,2) - zdifs(ji,3) ) * ( 1.0 - ztemp ) / zdep32
+            
+            ! LMD94, eq D5b :          
+            zdzh   = ( 1.0 - zdelta ) * zdzup + zdelta * zdzdn
+            zdzh   = MAX( zdzh , 0. )           
+            
+            ! Compute diffusivities (zvath) at z=zhbl(ji), LMD94 eq D5a
+            zvath  =          ztemp   * ( zdifs(ji,3) + zdzh * ( zdepw(ji,3) - zhbl(ji) ) ) &
+               &    + ( 1.0 - ztemp ) * ( zdifs(ji,2) + zdzh * ( zdepw(ji,2) - zhbl(ji) ) )
+                        
+            ! G at its derivative at z=hbl:
+            zgat1  = zvath  / ( zhbl(ji) * ( zws + epsln )  )
+            zdat1  = -zdzh  / ( zws + epsln ) -  zflag * zvath / zhbl(ji)
+            
+            ! G coefficients, LMD94 eq 17
+            za2s(ji) = -2.0 + 3.0 * zgat1 - zdat1
+            za3s(ji) =  1.0 - 2.0 * zgat1 + zdat1
+#endif
+
+            !-------------------turn off interior matching here------
+            !          za2(ji,1) = -2.0
+            !          za3(ji,1) =  1.0
+            !          za2(ji,2) = -2.0
+            !          za3(ji,2) =  1.0
+            !--------------------------------------------------------
+            
+            !  Compute Enhanced Mixing Coefficients (LMD94,eq D6)
+            ! ---------------------------------------------------------------
+            
+            ! Delta 
+            zdelta  = ( zhbl(ji)  - zdept(ji,1) ) / ( zdept(ji,2) - zdept(ji,1) + epsln )
+            zdelta2 = zdelta * zdelta
+            
+            !  Mixing coefficients at first level above h (zdept(ji,1)) 
+            ! and at first interface in the pipe (zdepw(ji,2))
+            
+            ! At first T level above h (zdept(ji,1)) (always in the boundary layer)
+            zsig    = zdept(ji,1) / zhbl(ji)
+            ztemp   = zstabl * zsig  + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
+            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
+            zeta    = zehat / ( zucube + epsln)
+            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
+            zwm     = zstabl * zwst + ( 1.0 - zstabl ) * zwm
+            zws     = zstabl * zwst + ( 1.0 - zstabl ) * zws
+
+            zkm1m  = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
+            zkm1t  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
+#if defined key_zdfddm
+            zkm1s  = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
+#endif                        
+            ! At first W level in the pipe (zdepw(ji,2)) (not always in the boundary layer ):
+            zsig    = MIN( zdepw(ji,2) / zhbl(ji) , 1.0 )
+            ztemp   = zstabl * zsig + ( 1.0 - zstabl ) * MIN( zsig , epsilon )
+            zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
+            zeta    = zehat / ( zucube + epsln )
+            zwst    = vonk * zustar(ji,jj) / ( ABS( 1.0 + rconc1 * zeta ) + epsln)
+            zws     = zstabl * zws + ( 1.0 - zstabl ) * zws
+            zwm     = zstabl * zws + ( 1.0 - zstabl ) * zwm
+
+            zkmpm(ji) = zhbl(ji) * zwm * zsig * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
+            zkmpt(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
+#if defined key_zdfddm
+            zkmps(ji) = zhbl(ji) * zws * zsig * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
+#endif  
+      
+            ! check if this point is in the boundary layer,else take interior viscosity/diffusivity:
+            zflag       = 0.5 + SIGN( 0.5, ( zhbl(ji) - zdepw(ji,2) ) )
+            zkmpm(ji) = zkmpm(ji) * zflag + ( 1.0 - zflag ) * zvisc(ji,2)
+            zkmpt(ji) = zkmpt(ji) * zflag + ( 1.0 - zflag ) * zdift(ji,2)
+#if defined key_zdfddm
+            zkmps(ji) = zkmps(ji) * zflag + ( 1.0 - zflag ) * zdifs(ji,2)
+#endif
+
+            ! Enhanced viscosity/diffusivity at zdepw(ji,2)
+            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1m + zdelta2 * zkmpm(ji)
+            zkmpm(ji) = ( 1.0 - zdelta ) * zvisc(ji,2) + zdelta * ztemp
+            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1t + zdelta2 * zkmpt(ji)
+            zkmpt(ji) = ( 1.0 - zdelta ) * zdift(ji,2) + zdelta * ztemp
+#if defined key_zdfddm
+            ztemp     = ( 1.0 - 2.0 * zdelta + zdelta2 ) * zkm1s + zdelta2 * zkmps(ji)
+            zkmps(ji) = ( 1.0 - zdelta ) * zdifs(ji,2) + zdelta * ztemp
+#endif            
+
+         END DO
+         !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+         ! IV. Compute vertical eddy viscosity and diffusivity coefficients
+         !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+         
+         DO jk  = 2, jkmax
+            
+            ! Compute turbulent velocity scales on the interfaces
+            ! --------------------------------------------------------
+            DO  ji = fs_2, fs_jpim1
+               zbuofdep = zBo(ji,jj) + zBosol(ji,jj) * zatt1
+               zstabl   = 0.5 + SIGN( 0.5 , zbuofdep ) 
+               zbuofdep = zbuofdep + zstabl * epsln          
+               zsig    = fsdepw(ji,jj,jk) / zhbl(ji)
+               ztemp   = zstabl * zsig + ( 1. - zstabl ) * MIN( zsig , epsilon )
+               zehat   = vonk * ztemp * zhbl(ji) * zbuofdep
+               zucube  = zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj)
+               zeta    = zehat / ( zucube + epsln )
+
+               IF( zehat > 0. ) THEN
+                  ! Stable case
+                  zws  = vonk * zustar(ji,jj) / ( 1.0 + rconc1 * zeta )
+                  zwm  = zws
+               ELSE
+                  ! Unstable case
+#if defined key_kpplktb
+                  ! use lookup table
+                  zd     = zehat - dehatmin
+                  il     = INT( zd / dezehat )
+                  il     = MIN( il, nilktbm1 )
+                  il     = MAX( il, 1 )
+                  
+                  ud     = zustar(ji,jj) - ustmin
+                  jl     = INT( ud / deustar )
+                  jl     = MIN( jl, njlktbm1 )
+                  jl     = MAX( jl, 1 )
+                  
+                  zfrac  = zd / dezehat - FLOAT( il )  
+                  ufrac  = ud / deustar - FLOAT( jl )
+                  zwas   = ( 1. - zfrac ) * wslktb(il,jl+1) + zfrac * wslktb(il+1,jl+1)
+                  zwbs   = ( 1. - zfrac ) * wslktb(il,jl  ) + zfrac * wslktb(il+1,jl  )
+                  zwam   = ( 1. - zfrac ) * wmlktb(il,jl+1) + zfrac * wmlktb(il+1,jl+1)
+                  zwbm   = ( 1. - zfrac ) * wmlktb(il,jl  ) + zfrac * wmlktb(il+1,jl  )
+                  !
+                  zws    = ( 1. - ufrac ) * zwbs + ufrac * zwas
+                  zwm    = ( 1. - ufrac ) * zwbm + ufrac * zwam
+#else
+                  ! use analytical functions
+                  zconm  = 0.5 + SIGN( 0.5, ( rzetam - zeta) )
+                  zcons  = 0.5 + SIGN( 0.5, ( rzetas - zeta) )
+                  
+                  ! Momentum : zeta < rzetam (zconm = 1)
+                  ! Scalars  : zeta < rzetas (zcons = 1) 
+                  zwconm = zustar(ji,jj) * vonk * ( ( ABS( rconam - rconcm * zeta) )**pthird )
+                  zwcons = zustar(ji,jj) * vonk * ( ( ABS( rconas - rconcs * zeta) )**pthird )
+                  
+                  ! Momentum : rzetam <= zeta < 0 (zconm = 0)
+                  ! Scalars  : rzetas <= zeta < 0 (zcons = 0)	
+                  zwmun  = SQRT( ABS( 1.0 - rconc2 * zeta ) )
+                  zwsun  = vonk * zustar(ji,jj) * zwmun
+                  zwmun  = vonk * zustar(ji,jj) * SQRT(zwmun)
+                  !
+                  zwm    = zconm * zwconm + ( 1.0 - zconm ) * zwmun
+                  zws    = zcons * zwcons + ( 1.0 - zcons ) * zwsun
+                  
+#endif
+               ENDIF
+               
+               zblcm(ji,jk) = zhbl(ji) * zwm * zsig  * ( 1.0 + zsig * ( za2m(ji) + zsig * za3m(ji) ) )
+               zblct(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2t(ji) + zsig * za3t(ji) ) )
+#if defined key_zdfddm
+               zblcs(ji,jk) = zhbl(ji) * zws * zsig  * ( 1.0 + zsig * ( za2s(ji) + zsig * za3s(ji) ) )
+#endif              
+               !  Compute Nonlocal transport term = ghats * <ws>o
+               ! ----------------------------------------------------
+               ghats(ji,jj,jk-1) = ( 1. - zstabl ) * rcg / ( zws * zhbl(ji) + epsln ) * tmask(ji,jj,jk)
+
+            END DO
+         END DO     
+         !  Combine interior and boundary layer coefficients and nonlocal term
+         ! -----------------------------------------------------------------------
+         DO jk = 2, jpkm1   
+            DO ji = fs_2, fs_jpim1
+               zflag = zmask(ji,jk) * zmask(ji,jk+1)
+               zviscos(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )         * avmu (ji,jj,jk) & ! interior viscosities
+                  &              +                        zflag   * zblcm(ji,jk    ) & ! boundary layer viscosities
+                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpm(ji       )   ! viscosity enhancement at W_level near zhbl
+               
+               zviscos(ji,jj,jk) = zviscos(ji,jj,jk) * tmask(ji,jj,jk)   
+
+            
+               zdiffut(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )          * avt (ji,jj,jk) & ! interior diffusivities 
+                  &              +                        zflag   * zblct(ji,jk   ) & ! boundary layer diffusivities
+                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmpt(ji      )   ! diffusivity enhancement at W_level near zhbl
+                       
+               zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) * tmask(ji,jj,jk) 
+#if defined key_zdfddm
+               zdiffus(ji,jj,jk) = ( 1.0 - zmask(ji,jk) )          * avs (ji,jj,jk) & ! interior diffusivities 
+                  &              +                        zflag   * zblcs(ji,jk   ) & ! boundary layer diffusivities
+                  &              + zmask(ji,jk) * ( 1.0 - zflag ) * zkmps(ji      )   ! diffusivity enhancement at W_level near zhbl
+                       
+               zdiffus(ji,jj,jk) = zdiffus(ji,jj,jk) * tmask(ji,jj,jk) 
+#endif               
+               ! Non local flux in the boundary layer only
+               ghats(ji,jj,jk-1) = zmask(ji,jk) * ghats(ji,jj,jk-1)
+
+            ENDDO
+         END DO
+         !                                             ! ===============
+      END DO                                           !   End of slab
+      !                                                ! ===============
+
+      ! Lateral boundary conditions on zvicos and zdiffus  (sign unchanged)
+      CALL lbc_lnk( zviscos(:,:,:), 'U', 1. )  ; CALL lbc_lnk( zdiffut(:,:,:), 'W', 1. )  
+#if defined key_zdfddm  
+      CALL lbc_lnk( zdiffus(:,:,:), 'W', 1. ) 
+#endif
+
+      SELECT CASE ( nn_ave )
+         !
+         CASE ( 0 )             ! no viscosity and diffusivity smoothing
+
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+                     avmu(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji+1,jj,jk) ) &
+                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk)
+                     
+                     avmv(ji,jj,jk) = ( zviscos(ji,jj,jk) + zviscos(ji,jj+1,jk) ) &
+                        &  / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk)
+                     
+                     avt (ji,jj,jk) =  zdiffut(ji,jj,jk) * tmask(ji,jj,jk)  
+#if defined key_zdfddm     
+                     avs (ji,jj,jk) =  zdiffus(ji,jj,jk) * tmask(ji,jj,jk)  
+#endif
+                  END DO
+               END DO
+            END DO
+            
+         CASE ( 1 )                ! viscosity and diffusivity smoothing
+            !                      
+            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
+            ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
+            !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
+  
+            DO jk = 2, jpkm1
+               DO jj = 2, jpjm1
+                  DO ji = fs_2, fs_jpim1
+
+                     avmu(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji+1,jj  ,jk)   &
+                        &              +.5*( zviscos(ji  ,jj-1,jk) + zviscos(ji+1,jj-1,jk)   &
+                        &                   +zviscos(ji  ,jj+1,jk) + zviscos(ji+1,jj+1,jk) ) ) * eumean(ji,jj,jk)
+                     
+                     avmv(ji,jj,jk) = (      zviscos(ji  ,jj  ,jk) + zviscos(ji  ,jj+1,jk)   &
+                        &              +.5*( zviscos(ji-1,jj  ,jk) + zviscos(ji-1,jj+1,jk)   &
+                        &                   +zviscos(ji+1,jj  ,jk) + zviscos(ji+1,jj+1,jk) ) ) * evmean(ji,jj,jk)
+ 
+                     avt (ji,jj,jk) = ( .5*( zdiffut(ji-1,jj+1,jk) + zdiffut(ji-1,jj-1,jk)    &
+                        &                   +zdiffut(ji+1,jj+1,jk) + zdiffut(ji+1,jj-1,jk) )  &
+                        &              +1.*( zdiffut(ji-1,jj  ,jk) + zdiffut(ji  ,jj+1,jk)    &
+                        &                   +zdiffut(ji  ,jj-1,jk) + zdiffut(ji+1,jj  ,jk) )  &
+                        &              +2.*  zdiffut(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)
+#if defined key_zdfddm   
+                     avs (ji,jj,jk) = ( .5*( zdiffus(ji-1,jj+1,jk) + zdiffus(ji-1,jj-1,jk)    &
+                        &                   +zdiffus(ji+1,jj+1,jk) + zdiffus(ji+1,jj-1,jk) )  &
+                        &              +1.*( zdiffus(ji-1,jj  ,jk) + zdiffus(ji  ,jj+1,jk)    &
+                        &                   +zdiffus(ji  ,jj-1,jk) + zdiffus(ji+1,jj  ,jk) )  &
+                        &              +2.*  zdiffus(ji  ,jj  ,jk)                          ) * etmean(ji,jj,jk)  
+#endif                
+                  END DO
+               END DO
+            END DO
+         
+         END SELECT
+
+         DO jk = 2, jpkm1                       ! vertical slab
+            !
+            !  Minimum value on the eddy diffusivity
+            ! ----------------------------------------
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  avt(ji,jj,jk) = MAX( avt(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+#if defined key_zdfddm  
+                  avs(ji,jj,jk) = MAX( avs(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk)
+#endif
+               END DO
+            END DO
+
+            !
+            ! Minimum value on the eddy viscosity
+            ! ----------------------------------------
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), avmb(jk) ) * umask(ji,jj,jk)
+                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), avmb(jk) ) * vmask(ji,jj,jk)
+               END DO
+            END DO
+            !
+         END DO
+
+         ! Lateral boundary conditions on avt  (sign unchanged)
+         CALL lbc_lnk( hkpp(:,:), 'T', 1. )
+
+         ! Lateral boundary conditions on avt  (sign unchanged)
+         CALL lbc_lnk( avt(:,:,:), 'W', 1. )
+#if defined key_zdfddm  
+         CALL lbc_lnk( avs(:,:,:), 'W', 1. )  
+#endif
+         ! Lateral boundary conditions (avmu,avmv) (U- and V- points, sign unchanged)
+         CALL lbc_lnk( avmu(:,:,:), 'U', 1. )   ;    CALL lbc_lnk( avmv(:,:,:), 'V', 1. )  
+ 
+         IF(ln_ctl) THEN
+#if defined key_zdfddm
+            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
+#else
+            CALL prt_ctl(tab3d_1=avt , clinfo1=' kpp - t: ', ovlap=1, kdim=jpk)
+#endif
+            CALL prt_ctl(tab3d_1=avmu, clinfo1=' kpp - u: ', mask1=umask,  &
+               &         tab3d_2=avmv, clinfo2=      ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
+         ENDIF
+
+      CALL wrk_dealloc( jpi, zmoa, zekman, zhmax, zria, zhbl )
+      CALL wrk_dealloc( jpi, za2m, za3m, zkmpm, za2t, za3t, zkmpt )
+      CALL wrk_dealloc( jpi,2, zriblk )
+      CALL wrk_dealloc( jpi,3, zmoek, kjstart = 0 )
+      CALL wrk_dealloc( jpi,3, zdept )
+      CALL wrk_dealloc( jpi,4, zdepw, zdift, zvisc )
+      CALL wrk_dealloc( jpi,jpj, zBo, zBosol, zustar )
+      CALL wrk_dealloc( jpi,jpk, zmask, zblcm, zblct, zblcs )
+#if defined key_zdfddm
+      CALL wrk_dealloc( jpi,4, zdifs )
+      CALL wrk_dealloc( jpi, zmoa, za2s, za3s, zkmps )
+      CALL wrk_dealloc( jpi,jpk, zblcs )
+      CALL wrk_dealloc( jpi,jpi,jpk, zdiffus )
+#endif
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp')
+      !
+   END SUBROUTINE zdf_kpp
+
+
+   SUBROUTINE tra_kpp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_kpp  ***
+      !!
+      !! ** Purpose :   compute and add to the tracer trend the non-local tracer flux
+      !!
+      !! ** Method  :   ???
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds   ! 3D workspace
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt
+      INTEGER :: ji, jj, jk
+      !
+      IF( nn_timing == 1 )  CALL timing_start('tra_kpp')
+      !
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) 'tra_kpp : KPP non-local tracer fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+
+      IF( l_trdtra )   THEN                    !* Save ta and sa trends
+         ALLOCATE( ztrdt(jpi,jpj,jpk) )   ;    ztrdt(:,:,:) = tsa(:,:,:,jp_tem)
+         ALLOCATE( ztrds(jpi,jpj,jpk) )   ;    ztrds(:,:,:) = tsa(:,:,:,jp_sal)
+      ENDIF
+
+      ! add non-local temperature and salinity flux ( in convective case only)
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1 
+            DO ji = fs_2, fs_jpim1
+               tsa(ji,jj,jk,jp_tem) =  tsa(ji,jj,jk,jp_tem)                      &
+                  &                 - (  ghats(ji,jj,jk  ) * avt  (ji,jj,jk  )   & 
+                  &                    - ghats(ji,jj,jk+1) * avt  (ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)
+               tsa(ji,jj,jk,jp_sal) =  tsa(ji,jj,jk,jp_sal)                      &
+                  &                 - (  ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   & 
+                  &                    - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      ! save the non-local tracer flux trends for diagnostic
+      IF( l_trdtra )   THEN
+         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
+         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)
+!!bug gm jpttdzdf ==> jpttkpp
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds )
+         DEALLOCATE( ztrdt )      ;     DEALLOCATE( ztrds )
+      ENDIF
+
+      IF(ln_ctl) THEN
+         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' kpp  - Ta: ', mask1=tmask,   &
+         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('tra_kpp')
+      !
+   END SUBROUTINE tra_kpp
+
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   SUBROUTINE trc_kpp( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_kpp  ***
+      !!
+      !! ** Purpose :   compute and add to the tracer trend the non-local
+      !!                tracer flux
+      !!
+      !! ** Method  :   ???
+      !!
+      !! history :
+      !!            9.0  ! 2005-11 (G. Madec)  Original code
+      !!       NEMO 3.3  ! 2010-06 (C. Ethe )  Adapted to passive tracers
+      !!----------------------------------------------------------------------
+      USE trc
+      USE prtctl_trc          ! Print control
+      !
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !
+      INTEGER  ::   ji, jj, jk, jn      ! Dummy loop indices
+      REAL(wp) ::   ztra, zflx
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd
+      !!----------------------------------------------------------------------
+
+      IF( kt == nit000 ) THEN
+         IF(lwp) WRITE(numout,*) 
+         IF(lwp) WRITE(numout,*) 'trc_kpp : KPP non-local tracer fluxes'
+         IF(lwp) WRITE(numout,*) '~~~~~~~   '
+      ENDIF
+
+      IF( l_trdtrc )  ALLOCATE( ztrtrd(jpi,jpj,jpk) )
+      !
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn)
+         ! add non-local on passive tracer flux ( in convective case only)
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1 
+               DO ji = fs_2, fs_jpim1
+                  ! Surface tracer flux for non-local term 
+                  zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1)
+                  ! compute the trend
+                  ztra = - ( ghats(ji,jj,jk  ) * fsavs(ji,jj,jk  )   &
+                  &        - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * zflx / fse3t(ji,jj,jk)
+                  ! add the trend to the general trend
+                  tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + ztra
+               END DO
+            END DO
+         END DO
+         ! save the non-local tracer flux trends for diagnostic
+         IF( l_trdtrc )  ztrtrd(:,:,:)  = tra(:,:,:,jn) - ztrtrd(:,:,:)
+         CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) )
+         !
+      END DO
+      IF( l_trdtrc )  DEALLOCATE( ztrtrd )
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="(' kpp')")  ;  CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=clname, clinfo2='trd' )
+      ENDIF
+      !
+   END SUBROUTINE trc_kpp
+
+#else
+   !!----------------------------------------------------------------------
+   !!   NO 'key_top'           DUMMY routine                  No TOP models
+   !!----------------------------------------------------------------------
+   SUBROUTINE trc_kpp( kt )         ! Dummy routine
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_kpp
+#endif
+
+   SUBROUTINE zdf_kpp_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE zdf_kpp_init  ***
+      !!                     
+      !! ** Purpose :   Initialization of the vertical eddy diffivity and 
+      !!      viscosity when using a kpp turbulent closure scheme
+      !!
+      !! ** Method  :   Read the namkpp namelist and check the parameters
+      !!      called at the first timestep (nit000)
+      !!
+      !! ** input   :   Namlist namkpp
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk     ! dummy loop indices
+#if ! defined key_kppcustom
+      INTEGER  ::   jm             ! dummy loop indices     
+      REAL(wp) ::   zref, zdist    ! tempory scalars
+#endif
+#if defined key_kpplktb
+      REAL(wp) ::   zustar, zucube, zustvk, zeta, zehat   ! tempory scalars
+#endif
+      REAL(wp) ::   zhbf           ! tempory scalars
+      LOGICAL  ::   ll_kppcustom   ! 1st ocean level taken as surface layer
+      LOGICAL  ::   ll_kpplktb     ! Lookup table for turbul. velocity scales 
+      !!
+      NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_kpp_init')
+      !
+      REWIND ( numnam )               ! Read Namelist namkpp : K-Profile Parameterisation
+      READ   ( numnam, namzdf_kpp )
+
+      IF(lwp) THEN                    ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_kpp_init : K-Profile Parameterisation'
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namzdf_kpp : set tke mixing parameters'
+         WRITE(numout,*) '     Shear instability mixing                      ln_kpprimix = ', ln_kpprimix
+         WRITE(numout,*) '     max. internal wave viscosity                  rn_difmiw   = ', rn_difmiw
+         WRITE(numout,*) '     max. internal wave diffusivity                rn_difsiw   = ', rn_difsiw
+         WRITE(numout,*) '     Richardson Number limit for shear instability rn_riinfty  = ', rn_riinfty
+         WRITE(numout,*) '     max. shear mixing at Rig = 0                  rn_difri    = ', rn_difri
+         WRITE(numout,*) '     Brunt-Vaisala squared for max. convection     rn_bvsqcon  = ', rn_bvsqcon
+         WRITE(numout,*) '     max. mix. in interior convec.                 rn_difcon   = ', rn_difcon
+         WRITE(numout,*) '     horizontal average flag                       nn_ave      = ', nn_ave
+      ENDIF
+
+      !                              ! allocate zdfkpp arrays
+      IF( zdf_kpp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_kpp_init : unable to allocate arrays' )
+
+      ll_kppcustom = .FALSE.
+      ll_kpplktb   = .FALSE.
+
+#if defined key_kppcustom
+      ll_kppcustom = .TRUE.
+#endif
+#if defined key_kpplktb
+      ll_kpplktb   = .TRUE.
+#endif
+      IF(lwp) THEN
+         WRITE(numout,*) '     Lookup table for turbul. velocity scales ll_kpplktb   = ', ll_kpplktb
+         WRITE(numout,*) '     1st ocean level taken as surface layer   ll_kppcustom = ', ll_kppcustom
+      ENDIF
+      
+      IF( lk_zdfddm) THEN
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) '    Double diffusion mixing on temperature and salinity '
+            WRITE(numout,*) '    CAUTION : done in routine zdfkpp, not in routine zdfddm '
+         ENDIF
+      ENDIF
+      
+
+      !set constants not in namelist
+      !-----------------------------
+      Vtc  = rconcv * SQRT( 0.2 / ( rconcs * epsilon ) ) / ( vonk * vonk * Ricr )
+      rcg  = rcstar * vonk * ( rconcs * vonk * epsilon )**pthird
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) '     Constant value for unreso. turbul. velocity shear Vtc = ', Vtc
+         WRITE(numout,*) '     Non-dimensional coef. for nonlocal transport      rcg = ', rcg
+       ENDIF
+
+      ! ratt is the attenuation coefficient for solar flux
+      ! Should be different is s_coordinate
+      DO jk = 1, jpk
+         zhbf     = - fsdept(1,1,jk) * hbf
+         ratt(jk) = 1.0 - ( rabs * EXP( zhbf / xsi1 ) + ( 1.0 - rabs ) * EXP( zhbf / xsi2 ) )        
+      ENDDO
+
+      ! Horizontal average : initialization of weighting arrays 
+      ! -------------------
+      
+      SELECT CASE ( nn_ave )
+
+      CASE ( 0 )                ! no horizontal average
+         IF(lwp) WRITE(numout,*) '          no horizontal average on avt, avmu, avmv'
+         IF(lwp) WRITE(numout,*) '          only in very high horizontal resolution !'
+         ! weighting mean arrays etmean, eumean and evmean
+         !           ( 1  1 )                                          ( 1 )
+         ! avt = 1/4 ( 1  1 )     avmu = 1/2 ( 1  1 )       avmv=  1/2 ( 1 )
+         !                          
+         etmean(:,:,:) = 0.e0
+         eumean(:,:,:) = 0.e0
+         evmean(:,:,:) = 0.e0
+         
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = 2, jpim1   ! vector opt.
+                  etmean(ji,jj,jk) = tmask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   &
+                  &            + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  )
+                  
+                  eumean(ji,jj,jk) = umask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji+1,jj  ,jk)  )
+
+                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                     &
+                  &  / MAX( 1.,  tmask(ji,jj,jk) + tmask(ji  ,jj+1,jk)  )
+               END DO
+            END DO
+         END DO
+
+      CASE ( 1 )                ! horizontal average 
+         IF(lwp) WRITE(numout,*) '          horizontal average on avt, avmu, avmv'
+         ! weighting mean arrays etmean, eumean and evmean
+         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )             ( 1/2  1  1/2 )
+         ! avt = 1/8 ( 1    2  1   )   avmu = 1/4 ( 1    1   )   avmv= 1/4 ( 1/2  1  1/2 )
+         !           ( 1/2  1  1/2 )              ( 1/2  1/2 )
+         etmean(:,:,:) = 0.e0
+         eumean(:,:,:) = 0.e0
+         evmean(:,:,:) = 0.e0
+         
+         DO jk = 1, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  etmean(ji,jj,jk) = tmask(ji, jj,jk)                           &
+                     & / MAX( 1., 2.* tmask(ji,jj,jk)                           &
+                     &      +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk)   &
+                     &             +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) &
+                     &      +1. * ( tmask(ji-1,jj  ,jk) + tmask(ji  ,jj+1,jk)   &
+                     &             +tmask(ji  ,jj-1,jk) + tmask(ji+1,jj  ,jk) ) )
+                  
+                  eumean(ji,jj,jk) = umask(ji,jj,jk)                        &
+                     &  / MAX( 1.,   tmask(ji,jj  ,jk) + tmask(ji+1,jj  ,jk)   &
+                     &       +.5 * ( tmask(ji,jj-1,jk) + tmask(ji+1,jj-1,jk)   &
+                     &              +tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) )  )
+                  
+                  evmean(ji,jj,jk) = vmask(ji,jj,jk)                        &
+                     &  / MAX( 1.,   tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   &
+                     &       +.5 * ( tmask(ji-1,jj,jk) + tmask(ji-1,jj+1,jk)   &
+                     &              +tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) )  )
+               END DO
+            END DO
+         END DO
+
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nn_ave = ', nn_ave
+         CALL ctl_stop( ctmp1 )
+
+      END SELECT
+ 
+      ! Initialization of vertical eddy coef. to the background value
+      ! -------------------------------------------------------------
+      DO jk = 1, jpk
+         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)
+      END DO
+
+      ! zero the surface flux for non local term and kpp mixed layer depth
+      ! ------------------------------------------------------------------
+      ghats(:,:,:) = 0.
+      wt0  (:,:  ) = 0.
+      ws0  (:,:  ) = 0.
+      hkpp (:,:  ) = 0. ! just a diagnostic (not essential)
+
+#if ! defined key_kppcustom
+      ! compute arrays (del, wz) for reference mean values 
+      ! (increase speed for vectorization key_kppcustom not defined)
+      del(1:jpk, 1:jpk) = 0.
+      DO jk = 1, jpk
+         zref = epsilon * fsdept(1,1,jk)    
+         DO jm = 1 , jpk
+            zdist = zref - fsdepw(1,1,jm)   
+            IF( zdist > 0.  ) THEN
+               del(jk,jm) = MIN( zdist, fse3t(1,1,jm) ) / zref   
+            ELSE
+               del(jk,jm) = 0.
+            ENDIF
+         ENDDO
+      ENDDO
+#endif
+
+#if defined key_kpplktb
+      ! build lookup table for turbulent velocity scales
+      dezehat = ( dehatmax - dehatmin ) / nilktbm1
+      deustar = ( ustmax   - ustmin   ) / njlktbm1
+ 
+      DO jj = 1, njlktb
+         zustar = ( jj - 1) * deustar + ustmin
+         zustvk = vonk * zustar 
+         zucube = zustar * zustar * zustar 
+         DO ji = 1 , nilktb
+            zehat = ( ji - 1 ) * dezehat + dehatmin
+            zeta   = zehat / ( zucube + epsln )
+            IF( zehat >= 0 ) THEN             ! Stable case
+               wmlktb(ji,jj) = zustvk / ABS( 1.0 + rconc1 * zeta + epsln )                        
+               wslktb(ji,jj) = wmlktb(ji,jj)
+            ELSE                                ! Unstable case 
+               IF( zeta > rzetam ) THEN
+                  wmlktb(ji,jj) = zustvk * ABS( 1.0    - rconc2 * zeta )**pfourth
+               ELSE
+                  wmlktb(ji,jj) = zustvk * ABS( rconam - rconcm * zeta )**pthird
+               ENDIF
+               
+               IF( zeta > rzetas ) THEN
+                  wslktb(ji,jj) = zustvk * SQRT( ABS( 1.0 - rconc2 * zeta ) )
+               ELSE
+                  wslktb(ji,jj) = zustvk * ABS( rconas - rconcs * zeta )**pthird
+               ENDIF
+            ENDIF
+         END DO
+      END DO
+#endif
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('zdf_kpp_init')
+      !
+   END SUBROUTINE zdf_kpp_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                        NO KPP scheme
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfkpp = .FALSE.   !: KPP flag
+CONTAINS
+   SUBROUTINE zdf_kpp_init           ! Dummy routine
+      WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?'
+   END SUBROUTINE zdf_kpp_init
+   SUBROUTINE zdf_kpp( kt )          ! Dummy routine
+      WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt
+   END SUBROUTINE zdf_kpp
+   SUBROUTINE tra_kpp( kt )          ! Dummy routine
+      WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt
+   END SUBROUTINE tra_kpp
+   SUBROUTINE trc_kpp( kt )          ! Dummy routine
+      WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_kpp
+#endif
+
+   !!======================================================================
+END MODULE zdfkpp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90	(revision 3437)
@@ -0,0 +1,129 @@
+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
+   !!----------------------------------------------------------------------
+   !!   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 zdf_oce         ! ocean vertical physics
+   USE in_out_manager  ! I/O manager
+   USE prtctl          ! Print control
+   USE iom             ! I/O library
+   USE lib_mpp         ! MPP library
+   USE wrk_nemo        ! work arrays
+   USE timing          ! Timing
+   USE trc_oce, ONLY : lk_offline ! offline flag
+
+   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   !: mixed layer depth at t-points        [m]
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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) + zrho_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)
+      !!
+      !! ** Action  :   nmln, hmld, hmlp, hmlpt
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk          ! dummy loop indices
+      INTEGER  ::   iikn, iiki          ! temporary integer within a do loop
+      INTEGER, POINTER, DIMENSION(:,:) ::   imld                ! temporary workspace
+      REAL(wp) ::   zrho_c = 0.01_wp    ! density criterion for mixed layer depth
+      REAL(wp) ::   zavt_c = 5.e-4_wp   ! Kz criterion for the turbocline depth
+      !!----------------------------------------------------------------------
+      !
+      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(:,:) = mbkt(:,:) + 1        ! Initialization to the number of w ocean point
+      imld(:,:) = mbkt(:,:) + 1
+      DO jk = jpkm1, nlb10, -1         ! from the bottom to nlb10
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( rhop(ji,jj,jk) > rhop(ji,jj,nla10) + zrho_c )   nmln(ji,jj) = jk      ! Mixed layer
+               IF( avt (ji,jj,jk) < zavt_c                     )   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) = fsdepw(ji,jj,iiki  ) * tmask(ji,jj,1)    ! Turbocline depth 
+            hmlp (ji,jj) = fsdepw(ji,jj,iikn  ) * tmask(ji,jj,1)    ! Mixed layer depth
+            hmlpt(ji,jj) = fsdept(ji,jj,iikn-1)                     ! depth of the last T-point inside the mixed layer
+         END DO
+      END DO
+      IF( .NOT.lk_offline ) THEN            ! no need to output in offline mode
+         CALL iom_put( "mldr10_1", hmlp )   ! mixed layer depth
+         CALL iom_put( "mldkz5"  , hmld )   ! turbocline depth
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90	(revision 3437)
@@ -0,0 +1,308 @@
+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   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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 eosbn2, ONLY : nn_eos
+
+   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   = 2            ! coefficient of the parameterization
+   REAL(wp) ::   rn_avmri = 100.e-4_wp   ! maximum value of the vertical eddy viscosity
+   REAL(wp) ::   rn_alp   =   5._wp      ! coefficient of the parameterization
+   REAL(wp) ::   rn_ekmfc =   0.7_wp     ! Ekman Factor Coeff
+   REAL(wp) ::   rn_mldmin=   1.0_wp     ! minimum mixed layer (ML) depth    
+   REAL(wp) ::   rn_mldmax=1000.0_wp     ! maximum mixed layer depth
+   REAL(wp) ::   rn_wtmix =  10.0_wp     ! Vertical eddy Diff. in the ML
+   REAL(wp) ::   rn_wvmix =  10.0_wp     ! Vertical eddy Visc. in the ML
+   LOGICAL  ::   ln_mldw  = .TRUE.       ! Use or not the MLD parameters
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tmric   !: coef. for the horizontal mean at t-point
+
+   !! * Substitutions
+#  include "domzgr_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 = 2, jpim1
+               zcoef = 0.5 / fse3w(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, 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 = 2, 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)
+               !                                            ! Add the background coefficient on eddy viscosity
+               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, nn_eos - 1. ) ) * rau0
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            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(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 = 1, jpj
+         DO ji = 1, jpi
+            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 = 1, jpj
+            DO ji = 1, jpi
+               IF( fsdept(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 = 1, jpj
+            DO ji = 1, jpi
+               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
+      !!
+      NAMELIST/namzdf_ric/ rn_avmri, rn_alp   , nn_ric  , rn_ekmfc,  &
+         &                rn_mldmin, rn_mldmax, rn_wtmix, rn_wvmix, ln_mldw
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnam )               ! Read Namelist namzdf_ric : richardson number dependent Kz
+      READ  ( numnam, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90	(revision 3437)
@@ -0,0 +1,858 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_zdftke   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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 restart        ! ocean restart
+   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
+   USE prtctl         ! Print control
+   USE in_out_manager ! I/O manager
+   USE iom            ! I/O manager library
+   USE lib_mpp        ! MPP library
+   USE wrk_nemo       ! work arrays
+   USE timing         ! Timing
+
+   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   = .FALSE.       ! mixing length scale surface value as function of wind stress or not
+   INTEGER  ::   nn_mxl    =  2            ! type of mixing length (=0/1/2/3)
+   REAL(wp) ::   rn_mxl0   = 0.04_wp       ! surface  min value of mixing length (kappa*z_o=0.4*0.1 m)  [m]
+   INTEGER  ::   nn_pdl    =  1            ! Prandtl number or not (ratio avt/avm) (=0/1)
+   REAL(wp) ::   rn_ediff  = 0.1_wp        ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e)
+   REAL(wp) ::   rn_ediss  = 0.7_wp        ! coefficient of the Kolmogoroff dissipation 
+   REAL(wp) ::   rn_ebb    = 3.75_wp       ! coefficient of the surface input of tke
+   REAL(wp) ::   rn_emin   = 0.7071e-6_wp  ! minimum value of tke           [m2/s2]
+   REAL(wp) ::   rn_emin0  = 1.e-4_wp      ! surface minimum value of tke   [m2/s2]
+   REAL(wp) ::   rn_bshear = 1.e-20_wp     ! background shear (>0) currently a numerical threshold (do not change it)
+   INTEGER  ::   nn_etau   = 0             ! type of depth penetration of surface tke (=0/1/2/3)
+   INTEGER  ::   nn_htau   = 0             ! type of tke profile of penetration (=0/1)
+   REAL(wp) ::   rn_efr    = 1.0_wp        ! fraction of TKE surface value which penetrates in the ocean
+   LOGICAL  ::   ln_lc     = .FALSE.       ! Langmuir cells (LC) as a source term of TKE or not
+   REAL(wp) ::   rn_lc     = 0.15_wp       ! coef to compute vertical velocity of Langmuir cells
+
+   REAL(wp) ::   ri_cri                    ! critic Richardson number (deduced from rn_ediff and rn_ediss values)
+   REAL(wp) ::   rmxl_min                  ! minimum mixing length value (deduced from rn_ediff and rn_emin values)  [m]
+   REAL(wp) ::   rhftau_add = 1.e-3_wp     ! add offset   applied to HF part of taum  (nn_etau=3)
+   REAL(wp) ::   rhftau_scl = 1.0_wp       ! scale factor applied to HF part of taum  (nn_etau=3)
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   en             !: now turbulent kinetic energy   [m2/s2]
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   htau           ! depth of tke penetration (nn_htau)
+   REAL(wp)        , ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dissl          ! now mixing lenght of dissipation
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avt_k , avm_k  ! not enhanced Kz
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   avmu_k, avmv_k ! not enhanced Kz
+#if defined key_c1d
+   !                                                                        !!** 1D cfg only  **   ('key_c1d')
+   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 "domzgr_substitute.h90"
+#  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_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
+         &      en    (jpi,jpj,jpk) , htau  (jpi,jpj)    , dissl(jpi,jpj,jpk) ,     & 
+         &      avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk),                          &
+         &      avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc      )
+         !
+      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( 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(:,:,:) 
+      !
+   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
+      !!--------------------------------------------------------------------
+      !
+      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 ) 
+      !
+      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
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      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)
+!CDIR NOVERRCHK
+!!    DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+!!       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 ) * fsdepw(:,:,1) * fse3w(:,:,1)
+         DO jk = 2, jpk
+            zpelc(:,:,jk)  = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk)
+         END DO
+         !                        !* finite Langmuir Circulation depth
+         zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag )
+         imlc(:,:) = 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
+# if defined key_vectopt_loop
+         DO jj = 1, 1
+            DO ji = 1, jpij   ! vector opt. (forced unrolling)
+# else
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
+# endif
+               zhlc(ji,jj) = fsdepw(ji,jj,imlc(ji,jj))
+            END DO
+         END DO
+         zcof = 0.016 / SQRT( zrhoa * zcdrag )
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1         !* TKE Langmuir circulation source term added to en
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+               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, fsdepw(ji,jj,jk) - zhlc(ji,jj) )
+                  zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) )
+                  !                                           ! TKE Langmuir circulation source term
+                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * tmask(ji,jj,jk)
+               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, jpj                 ! here avmu, avmv used as workspace
+            DO ji = 1, jpi
+               avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) )   &
+                  &                            * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) )   & 
+                  &           / (  fse3uw_n(ji,jj,jk)         &
+                  &              * fse3uw_b(ji,jj,jk) )
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) )   &
+                  &                            * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) )   &
+                  &                            / (  fse3vw_n(ji,jj,jk)               &
+                  &                              *  fse3vw_b(ji,jj,jk)  )
+            END DO
+         END DO
+      END DO
+      !
+      DO jk = 2, jpkm1           !* Matrix and right hand side in en
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zcof   = zfact1 * tmask(ji,jj,jk)
+               zzd_up = zcof * ( avm  (ji,jj,jk+1) + avm  (ji,jj,jk  ) )   &  ! upper diagonal
+                  &          / ( fse3t(ji,jj,jk  ) * fse3w(ji,jj,jk  ) )
+               zzd_lw = zcof * ( avm  (ji,jj,jk  ) + avm  (ji,jj,jk-1) )   &  ! lower diagonal
+                  &          / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk  ) )
+                  !                                                           ! shear prod. at w-point weightened by mask
+               zesh2  =  ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) )   &
+                  &    + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )    
+                  !
+               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)  ) * tmask(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 ) * tmask(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                            !  TKE due to surface and internal wave breaking
+      !                            !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( nn_etau == 1 ) THEN           !* penetration below the mixed layer (rn_efr fraction)
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                     &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ELSEIF( nn_etau == 2 ) THEN       !* act only at the base of the mixed layer (jk=nmln)  (rn_efr fraction)
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               jk = nmln(ji,jj)
+               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                  &                                               * ( 1._wp - fr_i(ji,jj) )  * tmask(ji,jj,jk)
+            END DO
+         END DO
+      ELSEIF( nn_etau == 3 ) THEN       !* penetration belox the mixed layer (HF variability)
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  ztx2 = utau(ji-1,jj  ) + utau(ji,jj)
+                  zty2 = vtau(ji  ,jj-1) + vtau(ji,jj)
+                  ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 )    ! module of the mean stress 
+                  zdif = taum(ji,jj) - ztau                            ! mean of modulus - modulus of the mean 
+                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications...
+                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) )   &
+                     &                                        * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk)
+               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 ) 
+      !
+      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, zpdlr, 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)
+      !
+      IF( ln_mxl0 ) THEN            ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)
+         zraug = vkarmn * 2.e5_wp / ( rau0 * grav )
+         zmxlm(:,:,1) = MAX(  rn_mxl0,  zraug * taum(:,:)  )
+      ELSE                          ! surface set to the minimum value
+         zmxlm(:,:,1) = rn_mxl0
+      ENDIF
+      zmxlm(:,:,jpk)  = rmxl_min     ! last level set to the interior minium value
+      !
+!CDIR NOVERRCHK
+      DO jk = 2, jpkm1              ! interior value : l=sqrt(2*e/n^2)
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zrn2 = MAX( rn2(ji,jj,jk), rsmall )
+               zmxlm(ji,jj,jk) = MAX(  rmxl_min,  SQRT( 2._wp * en(ji,jj,jk) / zrn2 )  )
+            END DO
+         END DO
+      END DO
+      !
+      !                     !* Physical limits for the mixing length
+      !
+      zmxld(:,:, 1 ) = zmxlm(:,:,1)   ! surface set to the zmxlm   value
+      zmxld(:,:,jpk) = rmxl_min       ! last level  set to the minimum value
+      !
+      SELECT CASE ( nn_mxl )
+      !
+      CASE ( 0 )           ! bounded by the distance to surface and bottom
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( fsdepw(ji,jj,jk), zmxlm(ji,jj,jk),   &
+                  &            fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 1 )           ! bounded by the vertical scale factor
+         DO jk = 2, jpkm1
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 2 )           ! |dk[xml]| bounded by e3t :
+         DO jk = 2, jpkm1         ! from the surface to the bottom :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface :
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemxl
+                  zmxld(ji,jj,jk) = zemxl
+               END DO
+            END DO
+         END DO
+         !
+      CASE ( 3 )           ! lup and ldown, |dk[xml]| bounded by e3t :
+         DO jk = 2, jpkm1         ! from the surface to the bottom : lup
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+         DO jk = jpkm1, 2, -1     ! from the bottom to the surface : ldown
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) )
+               END DO
+            END DO
+         END DO
+!CDIR NOVERRCHK
+         DO jk = 2, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  zemlm = MIN ( zmxld(ji,jj,jk),  zmxlm(ji,jj,jk) )
+                  zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) )
+                  zmxlm(ji,jj,jk) = zemlm
+                  zmxld(ji,jj,jk) = zemlp
+               END DO
+            END DO
+         END DO
+         !
+      END SELECT
+      !
+# if defined key_c1d
+      e_dis(:,:,:) = zmxld(:,:,:)      ! c1d configuration : save mixing and dissipation turbulent length scales
+      e_mix(:,:,:) = zmxlm(:,:,:)
+# endif
+
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      !                     !  Vertical eddy viscosity and diffusivity  (avmu, avmv, avt)
+      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+!CDIR NOVERRCHK
+      DO jk = 1, jpkm1            !* vertical eddy viscosity & diffivity at w-points
+!CDIR NOVERRCHK
+         DO jj = 2, jpjm1
+!CDIR NOVERRCHK
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zsqen = SQRT( en(ji,jj,jk) )
+               zav   = rn_ediff * zmxlm(ji,jj,jk) * zsqen
+               avm  (ji,jj,jk) = MAX( zav,                  avmb(jk) ) * tmask(ji,jj,jk)
+               avt  (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+               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 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
+      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.
+                  zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk)
+                  !                                          ! shear
+                  zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) )   &
+                    &  + avmu(ji  ,jj,jk) * ( un(ji  ,jj,jk-1) - un(ji  ,jj,jk) ) * ( ub(ji  ,jj,jk-1) - ub(ji  ,jj,jk) )
+                  zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) )   &
+                    &  + avmv(ji,jj  ,jk) * ( vn(ji,jj  ,jk-1) - vn(ji,jj  ,jk) ) * ( vb(ji,jj  ,jk-1) - vb(ji,jj  ,jk) )
+                  !                                          ! local Richardson number
+                  zri   = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear )
+                  zpdlr = MAX(  0.1_wp,  0.2 / MAX( 0.2 , zri )  )
+!!gm and even better with the use of the "true" ri_crit=0.22222...  (this change the results!)
+!!gm              zpdlr = MAX(  0.1_wp,  ri_crit / MAX( ri_crit , zri )  )
+                  avt(ji,jj,jk)   = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)
+# if defined key_c1d
+                  e_pdl(ji,jj,jk) = zpdlr * tmask(ji,jj,jk)    ! c1d configuration : save masked Prandlt number
+                  e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk)                            ! c1d config. : save Ri
+# 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
+      !!
+      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 )               !* Read Namelist namzdf_tke : Turbulente Kinetic Energy
+      READ   ( numnam, namzdf_tke )
+      !
+      ri_cri   = 2._wp    / ( 2._wp + rn_ediss / rn_ediff )   ! resulting critical Richardson number
+      rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) )    ! resulting minimum length to recover molecular viscosity
+      !
+      IF(lwp) THEN                    !* Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'zdf_tke_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 ! key_coupled
+      IF( nn_etau == 3 )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' )
+#endif
+
+      IF( ln_mxl0 ) THEN
+         IF(lwp) WRITE(numout,*) '   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min'
+         rn_mxl0 = rmxl_min
+      ENDIF
+      
+      IF( nn_etau == 2  )   CALL zdf_mxl( nit000 )      ! Initialization of nmln 
+
+      !                               !* 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) * tmask(:,:,jk)
+         avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
+         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+         avmv(:,:,jk) = avmb(jk) * vmask(:,:,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)
+              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) * tmask(:,:,jk)
+              avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)
+              avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)
+              avmv(:,:,jk) = avmb(jk) * vmask(:,:,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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90	(revision 3437)
@@ -0,0 +1,552 @@
+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   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   '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
+
+   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    = 500.      ! vertical decay scale for turbulence (meters)
+   REAL(wp) ::  rn_n2min   = 1.e-8     ! threshold of the Brunt-Vaisala frequency (s-1)
+   REAL(wp) ::  rn_tfe     = 1./3.     ! tidal dissipation efficiency (St Laurent et al. 2002)
+   REAL(wp) ::  rn_me      = 0.2       ! mixing efficiency (Osborn 1980)
+   LOGICAL  ::  ln_tmx_itf = .TRUE.    ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization
+   REAL(wp) ::  rn_tfe_itf = 1.        ! 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 "domzgr_substitute.h90"
+#  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_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.
+      !!----------------------------------------------------------------------
+      USE oce, zav_tide  =>   ua    ! use ua as workspace
+      !!
+      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      REAL(wp) ::   ztpc         ! scalar workspace
+      REAL(wp), POINTER, DIMENSION(:,:) ::   zkz
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('zdf_tmx')
+      !
+      CALL wrk_alloc( jpi,jpj, zkz )
+
+      !                          ! ----------------------- !
+      !                          !  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(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk)* tmask(:,:,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. )   !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.e0
+         DO jk= 1, jpk
+            DO jj= 1, jpj
+               DO ji= 1, jpi
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(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(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)
+         avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,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) ) * umask(ji,jj,jk)
+               avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji  ,jj+1,jk) ) * vmask(ji,jj,jk)
+            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 )
+      !
+      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
+!CDIR NOVERRCHK
+         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) * fse3w(:,:,jk)
+         zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,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 * fse3w(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(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,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. )   ! 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 + e1t(ji,jj) * e2t(ji,jj) * fse3w(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
+         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.
+      !!----------------------------------------------------------------------
+      USE oce     ,         zav_tide =>  ua         ! ua used as workspace
+      !!
+      INTEGER  ::   ji, jj, jk   ! dummy loop indices
+      INTEGER  ::   inum         ! local integer
+      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      ! 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 )
+      
+      REWIND( numnam )               ! Read Namelist namtmx : Tidal Mixing
+      READ  ( numnam, 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(:,:) ) * tmask(:,:,1)
+
+      ! Vertical structure (az_tmx)
+      DO jj = 1, jpj                ! part independent of the level
+         DO ji = 1, jpi
+            zhdep(ji,jj) = fsdepw(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean
+            zfact(ji,jj) = rau0 * 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)-fsdepw(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.e0
+         zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:)
+         DO jk= 2, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         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.e0
+         DO jk = 2, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)
+            END DO
+         END DO
+         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. )   !kz max = 300 cm2/s
+         END DO
+         ztpc = 0.e0
+         zpc(:,:,:) = Max(0.e0,rn2(:,:,:)) * zav_tide(:,:,:)
+         DO jk= 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)
+               END DO
+            END DO
+         END DO
+         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'
+
+         DO jk = 1, jpk
+            ze_z =                  SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk)     * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )
+            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( e1t*e2t*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( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,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( e1t(:,:) * e2t(:,:) * zkz(:,:)     * tmask_i(:,:) )   &
+               &     / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,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
+         !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi,jpj, zem2, zek1, zkz, zfact, zhdep )
+      CALL wrk_dealloc( jpi,jpj,jpk, zpc )
+      !
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_cray.f90	(revision 3437)
@@ -0,0 +1,30 @@
+!  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 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90	(revision 3437)
@@ -0,0 +1,441 @@
+MODULE lib_fortran
+   !!======================================================================
+   !!                       ***  MODULE  lib_fortran  ***
+   !! Fortran utilities:  includes some low levels fortran functionality
+   !!======================================================================
+   !! History :  3.2  !  2010-05  (M. Dunphy, R. Benshila)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   glob_sum    : generic interface for global masked summation over 
+   !!                 the interior domain for 1 or 2 2D or 3D arrays
+   !!                 it works only for T points   
+   !!   SIGN        : generic interface for SIGN to overwrite f95 behaviour
+   !!                 of intrinsinc sign function
+   !!----------------------------------------------------------------------
+   USE par_oce         ! Ocean parameter
+   USE 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
+   PUBLIC   DDPDD      ! also used in closea module
+#if defined key_nosignedzero
+   PUBLIC SIGN
+#endif
+
+   INTERFACE glob_sum
+      MODULE PROCEDURE glob_sum_2d, glob_sum_3d,glob_sum_2d_a, glob_sum_3d_a 
+   END INTERFACE
+
+#if defined key_nosignedzero   
+   INTERFACE SIGN
+      MODULE PROCEDURE SIGN_SCALAR, SIGN_ARRAY_1D, SIGN_ARRAY_2D, SIGN_ARRAY_3D,   &
+         &             SIGN_ARRAY_1D_A, SIGN_ARRAY_2D_A, SIGN_ARRAY_3D_A,          & 
+         &             SIGN_ARRAY_1D_B, SIGN_ARRAY_2D_B, SIGN_ARRAY_3D_B 
+   END INTERFACE
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS 
+
+#if ! defined key_mpp_rep
+
+   FUNCTION glob_sum_2d( ptab ) 
+      !!-----------------------------------------------------------------------
+      !!                  ***  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
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_3d = 0.e0
+      DO jk = 1, jpk
+         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
+      !!-----------------------------------------------------------------------
+      !
+      glob_sum_3d_a(:) = 0.e0
+      DO jk = 1, jpk
+         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
+
+#else  
+   !!----------------------------------------------------------------------
+   !!   'key_mpp_rep'                                   MPP reproducibility
+   !!----------------------------------------------------------------------
+   
+   FUNCTION glob_sum_2d( ptab ) 
+      !!----------------------------------------------------------------------
+      !!                  ***  FUNCTION  glob_sum_2d ***
+      !!
+      !! ** Purpose : perform a sum in calling DDPDD routine
+      !!----------------------------------------------------------------------
+      REAL(wp), INTENT(in), DIMENSION(jpi,jpj) ::   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(jpi,jpj,jpk) ::   ptab
+      REAL(wp)                                     ::   glob_sum_3d   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO    
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_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(jpi,jpj) ::   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(jpi,jpj,jpk) ::   ptab1, ptab2
+      REAL(wp)                                     ::   glob_sum_3d_a   ! global masked sum
+      !!
+      COMPLEX(wp)::   ctmp
+      REAL(wp)   ::   ztmp
+      INTEGER    ::   ji, jj, jk   ! dummy loop indices
+      !!-----------------------------------------------------------------------
+      !
+      ztmp = 0.e0
+      ctmp = CMPLX( 0.e0, 0.e0, wp )
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji =1, jpi
+            ztmp =  ptab1(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            ztmp =  ptab2(ji,jj,jk) * tmask_i(ji,jj)
+            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp )
+            END DO
+         END DO    
+      END DO
+      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain
+      glob_sum_3d_a = REAL(ctmp,wp)
+      !
+   END FUNCTION glob_sum_3d_a   
+
+#endif
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_print.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_print.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/lib_print.f90	(revision 3437)
@@ -0,0 +1,262 @@
+MODULE lib_print
+   !!======================================================================
+   !!                    ***  MODULE  lib_print  ***
+   !! print librairy :  formated real and integer array print
+   !!=====================================================================
+      
+   !!----------------------------------------------------------------------
+   !!   prihin       : print an integer 2D horizontal field
+   !!   prihre       : print an real 2D horizontal field
+   !!   prizre       : print an real 2D vertical field
+   !!----------------------------------------------------------------------
+   USE par_kind      ! kind parameters
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   prihin, prihre, prizre
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE prihin( ktab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , kscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  prihre  ***
+      !!  
+      !! ** purpose :   Print an integer field
+      !!
+      !! ** method :   format of print is selected with the dummy argument kscale
+      !!
+      !! History :
+      !!        !  90-04 (0. Marti)  Original code
+      !!        !  92-02 (M. Imbard)
+      !!        !  03-07 (G. Madec)  F90, free form
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i 
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kscale,                 &  ! kscale=0 or > 5  print ktab with format i8
+      !                             !         kscale=1 print ktab with format i1
+      !                             !         kscale=2 print ktab with format i2
+      !                             !         kscale=3 print ktab with format i3
+      !                             !         kscale=4 print ktab with format i4
+      !                             !         kscale=5 print ktab with format i5
+         kumout                     ! unit in which print
+      INTEGER, DIMENSION(ki,kj), INTENT( in ) ::   &
+         ktab                       ! integer 2D array to be print
+
+      !! * local declarations
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, ijnd       ! temporary integers
+
+      isca = 10
+      IF( kscale == 0 )   isca = 10
+      IF( kscale == 1 )   isca = 100
+      IF( kscale == 2 )   isca = 60
+      IF( kscale == 3 )   isca = 40
+      IF( kscale == 4 )   isca = 30
+      IF( kscale == 5 )   isca = 20
+
+      iind = MAX( 1, kind )
+      ijnd = MAX( 1, kjnd )
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF( il1 > kifin ) RETURN
+        WRITE(kumout,'(/)')
+        il2 = il1+iind*(isca-1)
+        IF( il2 > kifin )   il2 = kifin
+
+        IF( kscale == 1 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)') il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,100i1)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 2 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,60i2)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 3 ) THEN
+            WRITE(kumout,'(4x,i14," to ",1i4," each ",1i4,/)')il1, il2, iind
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,40i3)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 4 ) THEN
+            WRITE(kumout,'(4x,30i4,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,30i4)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSEIF( kscale == 5 ) THEN
+            WRITE(kumout,'(4x,20i5,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,20i5)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE(kumout,'(4x,10i8,/)') ( ji, ji = il1, il2, iind )
+            DO jj = kjfin, kjdeb, -ijnd
+              WRITE (kumout,'(1x,i3,10i8)') jj, ( ktab(ji,jj), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1 + iind * isca
+      END DO  
+
+   END SUBROUTINE prihin
+
+
+   SUBROUTINE prihre( ptab, ki   , kj   , kideb, kifin ,   &
+                      kind, kjdeb, kjfin, kjnd , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE prihre  ***
+      !!      
+      !! ** purpose :   Print a real field with the format 10e12.4 or 20f6.2
+      !!
+      !! ** method  :   the print format is selected with the pscale argument
+      !!
+      !! History :
+      !!   1.0  !  86-01  (P. Andrich)  Original code
+      !!        !  89-11  (C. Levy)
+      !!        !  92-02  (M. Imbard)
+      !!        !  92-06  (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj,                 &  ! array dimensions
+         kideb, kifin, kind,     &  ! first and last index, increment for i
+         kjdeb, kjfin, kjnd,     &  ! first and last index, increment for j
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e13.5 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj), INTENT( in ) ::   &
+         ptab                       ! integer 2D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jj, jn       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+
+      isca = 10
+      IF( pscale /= 0. )   isca=20
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(kind*isca) + 1
+
+        IF( il1 > kifin )   RETURN
+
+        WRITE(kumout,9100)
+
+        il2 = il1+kind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9102) jj, ( ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ELSE
+            WRITE(kumout,9103) ( ji, ji = il1, il2, kind )
+            DO jj = kjfin, kjdeb, -kjnd
+              WRITE(kumout,9104) jj, ( pscale*ptab(ji,jj), ji = il1, il2, kind )
+            END DO  
+        ENDIF
+        il1 = il1+kind*isca
+
+      END DO  
+
+      ! formats
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.2)
+
+   END SUBROUTINE prihre
+
+
+   SUBROUTINE prizre( ptab , ki   , kj   , kk   , kjcut ,   &
+                      kideb, kifin, kid  , kkdeb, kkfin ,   &
+                      kkd  , pscale, kumout )
+      !!----------------------------------------------------------------------
+      !!                      ***  ROUTINE prizre  ***
+      !!
+      !! ** purpose :   Print a vertical slab from a tridimentional real field
+      !!
+      !!   METHOD :
+      !! ** method  :   the print format is selected with the argument pscale
+      !!
+      !! History :
+      !!      original : 86-01 (o. Marti)
+      !!      addition : 92-02 (M. Imbard)
+      !!      addition : 92-06 (M. Imbard)
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT( in ) ::   &
+         ki, kj, kk,             &  ! array dimensions
+         kjcut,                  &  ! index j for the vertical slab
+         kideb, kifin, kid,      &  ! first and last index, increment for i
+         kkdeb, kkfin, kkd,      &  ! first and last index, increment for k
+         kumout                     ! unit in which print
+      REAL(wp), INTENT( in ) ::   &
+         pscale                     ! = 0  print        ptab with e12.4 format
+         !                          ! else print pscale*ptab with f6.2 format
+      REAL(wp), DIMENSION(ki,kj,kk), INTENT( in ) ::   &
+         ptab                       ! integer 3D array to be print
+
+      !! * Local variables
+      INTEGER ::   ji, jn, jk       ! dummy loop indices
+      INTEGER ::   isca, il1, il2   ! temporary integers
+      INTEGER ::   iind, iknd       !    "          "
+
+
+      iind = kid
+      iknd = kkd
+      isca = 10
+      IF( pscale /= 0.) isca = 20
+
+      IF (iind == 0) iind = 1
+      IF (iknd == 0) iknd = 1
+
+      il1 = kideb
+
+      DO jn = 1, (kifin-kideb+1)/(iind*isca) + 1
+
+        IF(il1 > kifin) RETURN
+        WRITE(kumout,9100)
+        il2 = il1+iind*(isca-1)
+        IF(il2 > kifin) il2 = kifin
+
+        IF( pscale == 0.) THEN
+            WRITE(kumout,9101) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE (kumout,9102) jk, ( ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ELSE
+            WRITE (kumout,9103) ( ji, ji = il1, il2, iind )
+            DO jk = kkdeb, kkfin, iknd
+              WRITE(kumout,9104)jk, ( pscale*ptab(ji,kjcut,jk), ji = il1, il2, iind )
+            END DO  
+        ENDIF
+
+        il1 = il1+iind*isca
+      END DO      
+
+ 9100 FORMAT(/)
+ 9101 FORMAT(10i12, /)
+ 9102 FORMAT(1x, i3, 10(1pe12.4))
+ 9103 FORMAT(3x, 20i6, /)
+ 9104 FORMAT(1x, i3, 1x, 20f6.1)
+
+      END SUBROUTINE prizre
+
+   !!======================================================================
+END MODULE lib_print
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/module_example
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/module_example	(revision 3437)
@@ -0,0 +1,201 @@
+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       : liste of module subroutine (caution, never use the
+   !!   exa_mpl_init  : name of the module for a routine)
+   !!   exa_mpl_stp   : Please try to use 3 letter block for routine names
+   !!----------------------------------------------------------------------
+   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
+      !!
+      NAMELIST/namexa/ exa_v1, exa_v2, nexa_0, sn_ex     
+      !!----------------------------------------------------------------------
+      !
+      sn_ex%clname ='toto'                      ! set default namelist values
+      sn_ex%nfreqh = 2 
+      !
+      REWIND( numnam )                          ! Read Namelist namexa : example parameters
+      READ  ( numnam, namexa )
+      !
+      IF(lwp) THEN                              ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'exa_mpl_init : example '
+         WRITE(numout,*) '~~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namexa : set example parameters'
+         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '      brief desciption               exa_v1  = ', exa_v1
+         WRITE(numout,*) '      brief desciption               nexa_0  = ', nexa_0
+         WRITE(numout,*) '      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemo.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemo.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90	(revision 3437)
@@ -0,0 +1,791 @@
+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-11  (C. Harris) decomposition changes for running with CICE
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   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 cla             ! cross land advection               (tra_cla routine)
+   USE domcfg          ! domain configuration               (dom_cfg routine)
+   USE mppini          ! shared/distributed memory setting (mpp_init routine)
+   USE domain          ! domain initialization             (dom_init routine)
+   USE obcini          ! open boundary cond. initialization (obc_ini routine)
+   USE bdyini          ! open boundary cond. initialization (bdy_init routine)
+   USE bdydta          ! open boundary cond. initialization (bdy_dta_init routine)
+   USE bdytides        ! open boundary cond. initialization (tide_init routine)
+   USE istate          ! initial state setting          (istate_init routine)
+   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
+   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
+   USE zdfini          ! vertical physics setting          (zdf_init routine)
+   USE phycst          ! physical constant                  (par_cst routine)
+   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
+   USE asmtrj          ! 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 step            ! NEMO time-stepping                 (stp     routine)
+#if defined key_oasis3
+   USE cpl_oasis3      ! OASIS3 coupling
+#elif defined key_oasis4
+   USE cpl_oasis4      ! OASIS4 coupling (not working)
+#endif
+   USE c1d             ! 1D configuration
+   USE step_c1d        ! Time stepping loop for the 1D configuration
+#if defined key_top
+   USE trcini          ! passive tracer initialisation
+#endif
+   USE lib_mpp         ! distributed memory computing
+#if defined key_iomput
+   USE mod_ioclient
+#endif
+
+   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 (2011)
+   !! $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       ! AGRIF: set the meshes
+# if defined key_top
+      CALL Agrif_Declare_Var_Top   ! AGRIF: set the meshes
+# 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_trjwri ) CALL asm_trj_wri( nit000 - 1 )    ! Output trajectory fields
+             IF( ln_asmdin ) THEN                        ! Direct initialization
+                IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 )    ! Tracers
+                IF( ln_dyninc ) THEN 
+                   CALL dyn_asm_inc( nit000 - 1 )    ! Dynamics
+                   IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 )      ! update vertical velocity 
+                ENDIF
+                IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 )    ! SSH
+             ENDIF
+          ENDIF
+        
+         DO WHILE ( istp <= nitend .AND. nstop == 0 )
+#if defined key_agrif
+            CALL Agrif_Step( stp )           ! AGRIF: time stepping
+#else
+            CALL stp( istp )                 ! standard time stepping
+#endif
+            istp = istp + 1
+            IF( lk_mpp )   CALL mpp_max( nstop )
+         END DO
+#endif
+
+      IF( lk_diaobs ) CALL dia_obs_wri
+       
+      !                            !------------------------!
+      !                            !==  finalize the run  ==!
+      !                            !------------------------!
+      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
+      !
+      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
+         WRITE(numout,cform_err)
+         WRITE(numout,*) nstop, ' error have been found' 
+      ENDIF
+      !
+#if defined key_agrif
+      CALL Agrif_ParentGrid_To_ChildGrid()
+      IF( lk_diaobs ) CALL dia_obs_wri
+      IF( nn_timing == 1 )   CALL timing_finalize
+      CALL Agrif_ChildGrid_To_ParentGrid()
+#endif
+      IF( nn_timing == 1 )   CALL timing_finalize
+      !
+      CALL nemo_closefile
+#if defined key_oasis3 || defined key_oasis4
+      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
+#else
+      IF( lk_mpp )   CALL mppstop       ! end mpp communications
+#endif
+      !
+   END SUBROUTINE nemo_gcm
+
+
+   SUBROUTINE nemo_init
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_init  ***
+      !!
+      !! ** Purpose :   initialization of the NEMO GCM
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji            ! dummy loop indices
+      INTEGER ::   ilocal_comm   ! local integer
+      CHARACTER(len=80), DIMENSION(16) ::   cltxt
+      !!
+      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
+         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
+         &             nn_bench, nn_timing
+      !!----------------------------------------------------------------------
+      !
+      cltxt = ''
+      !
+      !                             ! open Namelist file
+      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
+      !
+      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark
+      !
+      !                             !--------------------------------------------!
+      !                             !  set communicator & select the local node  !
+      !                             !--------------------------------------------!
+#if defined key_iomput
+      IF( Agrif_Root() ) THEN
+# if defined key_oasis3 || defined key_oasis4
+         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis
+# endif
+         CALL  init_ioclient( ilocal_comm )                 ! exchange io_server nemo local communicator with the io_server
+      ENDIF
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection
+#else
+# if defined key_oasis3 || defined key_oasis4
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )                 ! nemo local communicator given by oasis
+      ENDIF
+      narea = mynode( cltxt, numnam, nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
+# else
+      ilocal_comm = 0
+      narea = mynode( cltxt, numnam, nstop )                 ! Nodes selection (control print return in cltxt)
+# endif
+#endif
+      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
+
+      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
+
+      ! If 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
+      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
+      IF( Agrif_Root() ) THEN
+         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
+#if defined key_nemocice_decomp
+         jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 
+#else
+         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
+#endif
+         jpk = jpkdta                                             ! third dim
+         jpim1 = jpi-1                                            ! inner domain indices
+         jpjm1 = jpj-1                                            !   "           "
+         jpkm1 = jpk-1                                            !   "           "
+         jpij  = jpi*jpj                                          !  jpi x j
+      ENDIF
+
+      IF(lwp) THEN                            ! open listing units
+         !
+         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+         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.4  (2011) '
+         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_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
+
+      IF( lk_obc        )   CALL     obc_init   ! Open boundaries 
+      IF( lk_bdy        )   CALL     bdy_init       ! Open boundaries initialisation
+      IF( lk_bdy        )   CALL     bdy_dta_init   ! Open boundaries initialisation of external data arrays
+      IF( lk_bdy        )   CALL     tide_init      ! Open boundaries initialisation of tidal harmonic forcing
+
+                            CALL flush(numout)
+                            CALL dyn_nept_init  ! simplified form of Neptune effect
+                            CALL flush(numout)
+
+                            CALL  istate_init   ! ocean initial state (Dynamics and tracers)
+
+      !                                     ! Ocean physics
+                            CALL     sbc_init   ! Forcings : surface module 
+      !                                         ! Vertical physics
+                            CALL     zdf_init      ! namelist read
+                            CALL zdf_bfr_init      ! bottom friction
+      IF( lk_zdfric     )   CALL zdf_ric_init      ! Richardson number dependent Kz
+      IF( lk_zdftke     )   CALL zdf_tke_init      ! TKE closure scheme
+      IF( lk_zdfgls     )   CALL zdf_gls_init      ! GLS closure scheme
+      IF( lk_zdfkpp     )   CALL zdf_kpp_init      ! KPP closure scheme
+      IF( lk_zdftmx     )   CALL zdf_tmx_init      ! tidal vertical mixing
+      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
+         &                  CALL zdf_ddm_init      ! double diffusive mixing
+      !                                         ! Lateral physics
+                            CALL ldf_tra_init      ! Lateral ocean tracer physics
+                            CALL ldf_dyn_init      ! Lateral ocean momentum physics
+      IF( lk_ldfslp     )   CALL ldf_slp_init      ! slope of lateral mixing
+
+      !                                     ! Active tracers
+                            CALL tra_qsr_init   ! penetrative solar radiation qsr
+                            CALL tra_bbc_init   ! bottom heat flux
+      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme
+      IF( ln_tradmp     )   CALL tra_dmp_init   ! internal damping trends
+                            CALL tra_adv_init   ! horizontal & vertical advection
+                            CALL tra_ldf_init   ! lateral mixing
+                            CALL tra_zdf_init   ! vertical mixing and after tracer fields
+
+      !                                     ! Dynamics
+                            CALL dyn_adv_init   ! advection (vector or flux form)
+                            CALL dyn_vor_init   ! vorticity term including Coriolis
+                            CALL dyn_ldf_init   ! lateral mixing
+                            CALL dyn_hpg_init   ! horizontal gradient of Hydrostatic pressure
+                            CALL dyn_zdf_init   ! vertical diffusion
+                            CALL dyn_spg_init   ! surface pressure gradient
+                            
+      !                                     ! Misc. options
+      IF( nn_cla == 1   )   CALL cla_init       ! Cross Land Advection
+      
+#if defined key_top
+      !                                     ! Passive tracers
+                            CALL     trc_init
+#endif
+      !                                     ! Diagnostics
+      IF( lk_floats     )   CALL     flo_init   ! drifting Floats
+                            CALL     iom_init   ! iom_put initialization
+      IF( lk_diaar5     )   CALL dia_ar5_init   ! ar5 diag
+                            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_mod_init   ! Mixed-layer/Vorticity/Integral constraints trends
+      IF( lk_diaobs     ) THEN                  ! Observation & model comparison
+                            CALL dia_obs_init            ! Initialize observational data
+                            CALL dia_obs( nit000 - 1 )   ! Observation operator for restart
+      ENDIF      
+      !                                     ! Assimilation increments
+      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments
+      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
+      !
+   END SUBROUTINE nemo_init
+
+
+   SUBROUTINE nemo_ctl
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_ctl  ***
+      !!
+      !! ** Purpose :   control print setting 
+      !!
+      !! ** Method  : - print namctl information and check some consistencies
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
+         WRITE(numout,*) '~~~~~~~ '
+         WRITE(numout,*) '   Namelist namctl'
+         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
+         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
+         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
+         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
+         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
+         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
+         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
+         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
+         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
+         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
+      !                             ! 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( nbench == 1 ) THEN              ! Benchmark 
+         SELECT CASE ( cp_cfg )
+         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
+         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
+            &                                 ' key_gyre must be used or set nbench = 0' )
+         END SELECT
+      ENDIF
+      !
+      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   &
+         &                                               'with the IOM Input/Output manager. '         ,   &
+         &                                               'Compile with key_iomput enabled' )
+      !
+   END SUBROUTINE nemo_ctl
+
+
+   SUBROUTINE nemo_closefile
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE nemo_closefile  ***
+      !!
+      !! ** Purpose :   Close the files
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_mpp )   CALL mppsync
+      !
+      CALL iom_close                                 ! close all input/output files managed by iom_*
+      !
+      IF( numstp      /= -1 )   CLOSE( numstp      )   ! time-step file
+      IF( numsol      /= -1 )   CLOSE( numsol      )   ! solver file
+      IF( numnam      /= -1 )   CLOSE( numnam      )   ! oce namelist
+      IF( numnam_ice  /= -1 )   CLOSE( numnam_ice  )   ! ice namelist
+      IF( numevo_ice  /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
+      IF( numout      /=  6 )   CLOSE( numout      )   ! standard model output file
+      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 ldfdyn_oce, ONLY: ldfdyn_oce_alloc
+      USE ldftra_oce, ONLY: ldftra_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 + ldfdyn_oce_alloc()          ! ocean lateral  physics : dynamics
+      ierr = ierr + ldftra_oce_alloc()          ! ocean lateral  physics : tracers
+      ierr = ierr + zdf_oce_alloc   ()          ! ocean vertical physics
+      !
+      ierr = ierr + lib_mpp_alloc   (numout)    ! mpp exchanges
+      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.
+      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
+         &                            128,   64,   32,   16,    8,   4,   2  /
+      !!----------------------------------------------------------------------
+
+      ! 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 peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
+      !!----------------------------------------------------------------------
+
+      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
+      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
+      INTEGER ::   northcomms_alloc        ! allocate return status
+      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
+      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
+      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
+      IF( northcomms_alloc /= 0 ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
+         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
+      ENDIF
+      nsndto = 0
+      isendto = -1
+      ijpj   = 4
+      !
+      ! This routine has been called because ln_nnogather has been set true ( nammpp )
+      ! However, these first few exchanges have to use the mpi_allgather method to
+      ! establish the neighbour lists to use in subsequent peer to peer exchanges.
+      ! Consequently, set l_north_nogather to be false here and set it true only after
+      ! the lists have been established.
+      !
+      l_north_nogather = .FALSE.
+      !
+      ! Exchange and store ranks on northern rows
+
+      DO jtyp = 1,4
+
+         lrankset = .FALSE.
+         znnbrs = narea
+         SELECT CASE (jtyp)
+            CASE(1)
+               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
+            CASE(2)
+               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
+            CASE(3)
+               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
+            CASE(4)
+               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
+         END SELECT
+
+         IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+            DO jj = nlcj-ijpj+1, nlcj
+               ij = jj - nlcj + ijpj
+               DO ji = 1,jpi
+                  IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+               &     lrankset(INT(znnbrs(ji,jj))) = .true.
+               END DO
+            END DO
+
+            DO jj = 1,jpnij
+               IF ( lrankset(jj) ) THEN
+                  nsndto(jtyp) = nsndto(jtyp) + 1
+                  IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                     CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+                  &                 ' jpmaxngh will need to be increased ')
+                  ENDIF
+                  isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+               ENDIF
+            END DO
+         ENDIF
+
+      END DO
+
+      !
+      ! Type 5: I-point
+      !
+      ! ICE point exchanges may involve some averaging. The neighbours list is
+      ! built up using two exchanges to ensure that the whole stencil is covered.
+      ! lrankset should not be reset between these 'J' and 'K' point exchanges
+
+      jtyp = 5
+      lrankset = .FALSE.
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) &
+            &     lrankset(INT(znnbrs(ji,jj))) = .true.
+         END DO
+        END DO
+      ENDIF
+
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
+
+      IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN
+         DO jj = nlcj-ijpj+1, nlcj
+            ij = jj - nlcj + ijpj
+            DO ji = 1,jpi
+               IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND.  INT(znnbrs(ji,jj)) .NE. narea ) &
+            &       lrankset( INT(znnbrs(ji,jj))) = .true.
+            END DO
+         END DO
+
+         DO jj = 1,jpnij
+            IF ( lrankset(jj) ) THEN
+               nsndto(jtyp) = nsndto(jtyp) + 1
+               IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN
+                  CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+               &                 ' jpmaxngh will need to be increased ')
+               ENDIF
+               isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+            ENDIF
+         END DO
+         !
+         ! For northern row areas, set l_north_nogather so that all subsequent exchanges 
+         ! can use peer to peer communications at the north fold
+         !
+         l_north_nogather = .TRUE.
+         !
+      ENDIF
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/oce.F90	(revision 3437)
@@ -0,0 +1,87 @@
+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
+   !!----------------------------------------------------------------------
+   USE par_oce        ! ocean parameters
+   USE lib_mpp        ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90
+
+   LOGICAL, PUBLIC ::   l_traldf_rot = .FALSE.  !: rotated laplacian operator for lateral diffusion
+
+   !! dynamics and tracer fields                            ! before ! now    ! after  ! the after trends becomes the fields
+   !! --------------------------                            ! fields ! fields ! trends ! only after tra_zdf and dyn_spg
+   REAL(wp), PUBLIC, 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(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu] 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2]
+   !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsa             !: 4D T-S trends fields & work array 
+   !
+   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 ! trends !
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshb   , sshn   , ssha   !: sea surface height at t-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshu_b , sshu_n , sshu_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::   sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)         ::            sshf_n          !: sea surface height at f-point [m]
+   !
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION oce_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  FUNCTION oce_alloc  ***
+      !!----------------------------------------------------------------------
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      !
+      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)      ,                                                       &
+         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &   
+         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             &
+         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     &
+         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) )
+         !
+      ALLOCATE(rhd (jpi,jpj,jpk) ,                                         &
+         &     rhop(jpi,jpj,jpk) ,                                         &
+         &     sshb  (jpi,jpj)   , sshn  (jpi,jpj) , ssha  (jpi,jpj) ,     &
+         &     sshu_b(jpi,jpj)   , sshu_n(jpi,jpj) , sshu_a(jpi,jpj) ,     &
+         &     sshv_b(jpi,jpj)   , sshv_n(jpi,jpj) , sshv_a(jpi,jpj) ,     &
+         &                         sshf_n(jpi,jpj) ,                       &
+         &     spgu  (jpi,jpj)   , spgv(jpi,jpj)   ,                       &
+         &     gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts),                     &
+         &     gru(jpi,jpj)      , grv(jpi,jpj)                      , STAT=ierr(2) )
+         !
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_AMM_12km.h90	(revision 3437)
@@ -0,0 +1,93 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_AMM_12km.h90  ***  
+   !!   Ocean Domain : 12km resolution atlantic  margin model 
+   !!                  (AMM_12km configuration VN3.3)
+   !!---------------------------------------------------------------------
+   CHARACTER (len=16)        &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "amm"         !: name of the configuration
+   INTEGER                   &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      jp_cfg = 011  ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  = 198,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 224,        &  !: second                     > or = to jpj
+      jpkdta  = 33,         &  !: number of levels           > or = to jpk
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    0            !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
+      !                                     !: layer number above which  stretching will
+      !                                     !: be maximum. Usually of order jpk/2.
+      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
+      !                                     !: for the grid. The highest zacr, the smallest
+      !                                     !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5720._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R2.h90	(revision 3437)
@@ -0,0 +1,101 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R2.h90  ***
+   !!   Ocean Domain : 2 km resolution Channel (EEL_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 2   ,         &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 83,          &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 242,         &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels         ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     1           !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 2000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 2000.0_wp       !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R5.h90	(revision 3437)
@@ -0,0 +1,101 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R5.h90  ***   
+   !!   Ocean Domain : 5 km resolution Channel (EEL_R5 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 5      ,      &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files
+      jpidta  =  66   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  66   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+
+      ! total domain size      !!! * full domain *
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !:
+      pp_to_be_computed =      0._wp       !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 2            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = 43.436430714_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 8000.0_wp,   &  !: zonal      grid-spacing (meters)
+      ppe2_m   = 8000.0_wp       !: meridional grid-spacing (meters)
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+   REAL(wp), PARAMETER  ::       &   !:
+      &     ppsur = -4762.96143546300_wp    ,  &  !: Computed in domzgr, set ppdzmin, pphmax below
+      &     ppa0  =   255.58049070440_wp    ,  &  !:
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      !
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_EEL_R6.h90	(revision 3437)
@@ -0,0 +1,101 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_EEL_R6.h90  ***   
+   !!   Ocean Domain : 6 km resolution Channel (EEL_R6 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "eel"            !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &
+      jp_cfg = 6      ,      &  !: resolution of the configuration (km)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 29,          &  !: 1st lateral dimension ( >= jpi )
+      jpjdta  = 83,          &  !: 2nd    "         "    ( >= jpj )
+      jpkdta  = 30,          &  !: number of levels      ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+
+      ! Domain characteristics
+      jperio  =      1          !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp ,  &  !: ???
+      pp_to_be_computed =      0._wp       !: ???
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 3            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   35.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = 6000.0_wp,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = 6000.0_wp       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: Computed in domzgr
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_GYRE.h90	(revision 3437)
@@ -0,0 +1,106 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_GYRE.h90  ***
+   !!   Ocean Domain : GYRE configuration at 1/jp_cfg degree resolution 
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "gyre"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg =  1   ,        &  !: 
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 30*jp_cfg+2, &  !: 1st horizontal dimension ( >= jpi )
+      jpjdta  = 20*jp_cfg+2, &  !: 2nd    "            "    ( >= jpj )
+      jpkdta  = 31,          &  !: number of levels         ( >= jpk )
+
+      ! global domain size     !!! * full domain *
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+
+      ! Domain characteristics
+      jperio  =     0           !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &  !:
+      pp_not_used       = 999999._wp  , & !: ???
+      pp_to_be_computed =      0._wp      !: ???
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER,PARAMETER   ::    & !:
+      jphgr_msh = 5            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+      !                        ! =5  beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::     &  !:
+      ppglam0  =    0.0_wp,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  =   29.0_wp,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                          ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used ,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used ,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,    &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used        !: meridional grid-spacing (meters )
+   !!
+   !!  Coefficients associated with the vertical coordinate system
+   !!
+
+   REAL(wp), PARAMETER  ::       &  !:
+      &     ppsur = -2033.194295283385_wp   ,  &  !: 
+      &     ppa0  =  155.8325369664153_wp   ,  &  !:
+      &     ppa1  =  146.3615918601890_wp   ,  &  !:
+      !
+      &     ppkth =  17.28520372419791_wp   ,  &  !: (non dimensional): gives the approximate
+      !                                           !    layer number above which  stretching will
+      !                                           !    be maximum. Usually of order jpk/2.
+      &     ppacr =  5.000000000000000_wp         !: (non dimensional): stretching factor
+      !                                           !    for the grid. The highest zacr, the smallest
+      !                                           !    the stretching.
+
+   !!
+   !!  If all ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &  !:
+      &     ppdzmin = pp_not_used   ,  &  !: (meters): depth of the top (first) model layer
+      !                             !            depth of second "w" level
+      &     pphmax  = pp_not_used         !: (meters): maximum depth of the ocean
+      !                             !            depth of the last "w" level
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R025.h90	(revision 3437)
@@ -0,0 +1,126 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R025.h90  ***  
+   !!   Ocean Domain : 0.25 degrees resolution global ocean
+   !!                  (0RCA_R025 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  = 1442,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  = 1021,        &  !: second                     > or = to jpj
+#if key_orca_r025==75
+      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+#else
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+#endif
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    4            !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+#if key_orca_r025==75
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r025 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R05.h90	(revision 3437)
@@ -0,0 +1,136 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R05.h90  ***  
+   !!   Ocean Domain : 0.5 degrees resolution global ocean
+   !!                  (0RCA_R05 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 05  ,         &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all the input files *
+      jpidta  = 722,         &  !: 1st lateral dimension > or = to jpiglo
+      jpjdta  = 511,         &  !: 2nd   "         "     > or = to jpjglo
+      jpkdta  =  31             !: number of levels      > or = to jpkglo
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 187   ,      &  !: 2nd     "                 "    --> j 
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+   INTEGER    &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      ! zoom domain size       !!! *  arctic zoom  *
+      jpiglo  = 562,         &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-301+1,&  !: 2nd     "                 "    --> j
+      ! zoom starting position
+      jpizoom =  81   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom = 301   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   5             !: lateral cond. type (between 0 and 6)
+
+#else
+      ! global domain size     !!! *  global domain  *
+   INTEGER    &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd     "                 "    --> j
+      ! zoom starting position    
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =    6            !: lateral cond. type (between 0 and 6)
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999._wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER, PARAMETER   ::   & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! =====================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R1.h90	(revision 3437)
@@ -0,0 +1,129 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R1.h90  ***  
+   !!   Ocean Domain : 1 degrees resolution global ocean
+   !!                  (0RCA_R1 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_ORCA_R1.h90 2379 2010-11-12 14:51:18Z acc $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !! Andrew Coward, 12/11/2010.
+   !! Parameters appropriate to ORCA1
+   !! Use: key_orca_r1=75 to set 75 levels
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "orca"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 1    ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  =  362,        &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  292,        &  !: second                     > or = to jpj
+#if key_orca_r1==75
+      jpkdta  = 75 ,         &  !: number of levels           > or = to jpk
+#else
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+#endif
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   6             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+#if key_orca_r1==75
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur =  -3958.951371276829_wp  ,  &  !: ORCA r1 coefficients
+      &     ppa0  =   103.9530096000000_wp  ,  &  !: (75 levels case)
+      &     ppa1  =   2.415951269000000_wp  ,  &  !:
+      &     ppkth =   15.35101370000000_wp  ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =       7.00000000000_wp        !: (non dimensional): stretching factor
+      !                                           !: for the grid. The higher zacr, the smaller
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .TRUE.                    !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2  =   100.7609285000000_wp  ,  &  !: Double tanh function parameters
+      &     ppkth2=   48.02989372000000_wp  ,  &  !:
+      &     ppacr2=    13.00000000000_wp          !:
+      !
+#else
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,        &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,        &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,        &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,        &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =   9.00000000000_wp            !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to pp_to_be_computed, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::                      &
+      &     ppdzmin = 6._wp           ,        &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp                    !: (meters) Maximum depth of the ocean gdepw(jpk)
+   !!
+   LOGICAL,  PARAMETER ::                      &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::                      &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+#endif
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R2.h90	(revision 3437)
@@ -0,0 +1,164 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R2.h90  ***  
+   !!   Ocean Domain : 2 degrees resolution global ocean
+   !!                  (0RCA_R2 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "orca"           !: name of the configuration 
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 2,            &  !: resolution of the configuration (degrees)
+
+      ! data size              !!! * size of all input files *
+      jpidta  = 182,         &  !: 1st lateral dimension ( >= jpiglo )
+      jpjdta  = 149,         &  !: 2nd    "       "      ( >= jpjglo )
+      jpkdta  = 31              !: number of levels      ( >= jpk    ) 
+
+#if defined key_antarctic
+      ! zoom domain size       !!! *  antarctic zoom  * 
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 50,          &  !: 2nd    "                  "    --> j
+      ! zoom starting position
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   1             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_arctic
+      ! zoom domain size       !!! *  arctic zoom  *
+   INTEGER    &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = 142   ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta-97+1, &  !: 2nd    "                  "    --> j
+      ! zoom starting position 
+      jpizoom =  21   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =  97   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   3             !: lateral cond. type (between 0 and 6)
+
+#elif defined key_c1d
+      ! global domain size     !!! *  global domain  *
+   INTEGER    &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = 3     ,      &  !: 1st dimension of global domain --> i
+      jpjglo  = 3     ,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom 
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   133  ,    &  !: in data domain indices (160W,75N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   110  ,    &  !: in data domain indices (160W,50N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   97   ,    &  !: in data domain indices (160W,30N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   86   ,    &  !: in data domain indices (160W,10N)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   49   ,    &  !: in data domain indices (160W,30S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =   27   ,    &  !: in data domain indices (160W,60S)
+      ! jpizoom =   61   ,    &  !: left bottom (i,j) indices of the zoom
+      ! jpjzoom =    7   ,    &  !: in data domain indices (160W,75S)
+      jpizoom =   110   ,    &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   97   ,    &  !: in data domain indices (64W,31.5N) BATS site
+      ! Domain characteristics
+      jperio  =   0            !: lateral cond. type (between 0 and 6)
+#else
+      ! global domain size     !!! *  global domain  *
+   INTEGER    &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jpiglo  = jpidta,      &  !: 1st dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: 2nd    "                  "    --> j
+      ! starting position of the zoom 
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data domain indices
+      ! Domain characteristics
+      jperio  =   4             !: lateral cond. type (between 0 and 6)
+
+#endif
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+
+   INTEGER,PARAMETER   ::    & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) ,PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   !!
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_ORCA_R4.h90	(revision 3437)
@@ -0,0 +1,94 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R4.h90  ***   
+   !!   Ocean Domain : 4 degrees resolution global ocean
+   !!                  (0RCA_R4 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+       ::    &  
+     cp_cfg = "orca"           !: name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 4      ,      &  !: resolution of the configuration (degrees)
+      ! Original data size
+      jpidta  =  92   ,      &  !: first horizontal dimension > or = to jpi
+      jpjdta  =  76   ,      &  !: second                     > or = to jpj
+      jpkdta  =  31   ,      &  !: number of levels           > or = to jpk
+      ! global domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =   4             !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PARAMETER ::   &
+      pp_not_used       = 999999_wp , &  !:
+      pp_to_be_computed = 0._wp          !:
+
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        ! = 0 curvilinear coordinate on the sphere
+      !                        !     read in coordinate.nc file
+      !                        ! = 1 geographical mesh on the sphere
+      !                        !     with regular grid-spacing
+      !                        ! = 2 f-plane with regular grid-spacing
+      !                        ! = 3 beta-plane with regular grid-spacing
+      !                        ! = 4 Mercator grid with T/U point at the equator  with
+      !                        !     isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp) , PARAMETER ::      &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = -4762.96143546300_wp    ,  &  !: ORCA r4, r2 and r05 coefficients
+      &     ppa0  =   255.58049070440_wp    ,  &  !: (default coefficients)
+      &     ppa1  =   245.58132232490_wp    ,  &  !:
+      &     ppkth =    21.43336197938_wp    ,  &  !: (non dimensional): gives the approximate
+      !                                           !: layer number above which  stretching will
+      !                                           !: be maximum. Usually of order jpk/2.
+      &     ppacr =     3.00000000000_wp          !: (non dimensional): stretching factor
+      !                                           !: for the grid. The highest zacr, the smallest
+      !                                           !: the stretching.
+
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = pp_not_used           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = pp_not_used                 !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.                   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used           ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used           ,  &  !:
+      &     ppacr2  = pp_not_used                 !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_POMME_R025.h90	(revision 3437)
@@ -0,0 +1,102 @@
+   !!---------------------------------------------------------------------
+   !!                     ***  par_ORCA_R025.h90  ***  
+   !!   Ocean Domain : 0.25 degrees resolution global ocean
+   !!                  (0RCA_R025 configuration)
+   !!---------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   CHARACTER (len=16)      &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      ::    &  
+      cp_cfg = "pomme"          !: POMME025 name of the configuration
+   INTEGER     &
+#if !defined key_agrif
+      , PARAMETER  &
+#endif
+      :: &
+      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees)
+      ! Original data size
+      ! ORCA025 global grid size
+      jpiglo_ORCA025 = 1442, &
+      jpjglo_ORCA025 = 1021, &  ! not used currently
+      ! POMME "global" domain localisation in the ORCA025 global grid
+      jpi_iw    = 1059,      & 
+      jpi_ie    = 1088,      &  
+      jpj_js    = 661,       &
+      jpj_jn    = 700,       &
+      jpidta  = ( jpi_ie - jpi_iw + 1 ), &   !: =30 first horizontal dimension > or = to jpi
+      jpjdta  = ( jpj_jn - jpj_js + 1 ), &   !: =40 second                     > or = to jpj
+      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk
+      ! total domain matrix size
+      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i
+      jpjglo  = jpjdta,      &  !: second dimension of global domain --> j
+      ! starting position of the zoom
+      jpizoom =   1   ,      &  !: left bottom (i,j) indices of the zoom
+      jpjzoom =   1   ,      &  !: in data indices
+      ! Domain characteristics
+      jperio  =    0            !: lateral cond. type (between 0 and 6)
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL,PARAMETER      ::  pp_not_used = 999999_wp , &
+      &                    pp_to_be_computed = 0._wp
+   !!
+   !! Coefficients associated with the horizontal coordinate system (jphgr_msh /= 0 )
+   !!
+   INTEGER, PARAMETER ::     & !
+      jphgr_msh = 0            !: type of horizontal mesh
+      !                        !  = 0 curvilinear coordinate on the sphere
+      !                        !      read in coordinate.nc file
+      !                        !  = 1 geographical mesh on the sphere
+      !                        !      with regular grid-spacing
+      !                        !  = 2 f-plane with regular grid-spacing
+      !                        !  = 3 beta-plane with regular grid-spacing
+      !                        !  = 4 Mercator grid with T/U point at the equator  with
+      !                        !      isotropic resolution (e1_deg)
+
+      !   ppglam0 , ppgphi0: coordinates of the lower leftmost T point of the grid.
+      !   The mercator grid starts only approximately at gphi0 because
+      !   of the constraint that the equator be a T point.
+   REAL(wp), PARAMETER ::       &  !
+      ppglam0  = pp_not_used,   &  !: longitude of first raw and column T-point (jphgr_msh = 1)
+      ppgphi0  = pp_not_used,   &  !: latitude  of first raw and column T-point (jphgr_msh = 1)
+      !                            !  latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3)
+      ppe1_deg = pp_not_used,   &  !: zonal      grid-spacing (degrees)
+      ppe2_deg = pp_not_used,   &  !: meridional grid-spacing (degrees)
+      !
+      ppe1_m   = pp_not_used,   &  !: zonal      grid-spacing (meters )
+      ppe2_m   = pp_not_used       !: meridional grid-spacing (meters )
+
+   !!  Coefficients associated with the vertical coordinate system
+
+   REAL(wp), PARAMETER  ::       &
+      &     ppsur = pp_to_be_computed ,  &  !: Computed in domzgr, set ppdzmin and pphmax below
+      &     ppa0  = pp_to_be_computed ,  &  !:    "           "
+      &     ppa1  = pp_to_be_computed ,  &  !:    "           "
+      !
+      &     ppkth =  23.563_wp        ,  &  !: (non dimensional): gives the approximate
+      !                                     !: layer number above which  stretching will
+      !                                     !: be maximum. Usually of order jpk/2.
+      &     ppacr =    9.00000000000_wp     !: (non dimensional): stretching factor
+      !                                     !: for the grid. The highest zacr, the smallest
+      !                                     !: the stretching.
+
+   !!
+   !!  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !!  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   !!
+   REAL(wp), PARAMETER ::        &
+      &     ppdzmin = 6._wp           ,  &  !: (meters) vertical thickness of the top layer
+      &     pphmax  = 5750._wp              !: (meters) Maximum depth of the ocean gdepw(jpk)
+   LOGICAL,  PARAMETER ::        &
+      &     ldbletanh = .FALSE.             !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PARAMETER ::        &
+      &     ppa2    = pp_not_used     ,  &  !: Double tanh function parameters
+      &     ppkth2  = pp_not_used     ,  &  !:
+      &     ppacr2  = pp_not_used           !:
+   !!---------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_kind.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_kind.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/par_oce.F90	(revision 3437)
@@ -0,0 +1,204 @@
+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 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+#if   defined key_orca_r4
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R4.h90"
+#elif defined key_orca_r2
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R2.h90"
+#elif defined key_orca_r1
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r1'   :                           global ocean : ORCA R1
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R1.h90"
+#elif defined key_orca_r05
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R05.h90"
+#elif defined key_orca_r025
+   !!---------------------------------------------------------------------
+   !!   'key_orca_r025' :                         global ocean : ORCA R025
+   !!---------------------------------------------------------------------
+#             include "par_ORCA_R025.h90"
+#elif defined key_eel_r2
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r2'    :                                 channel : EEL R2
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R2.h90"
+#elif defined key_eel_r5
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r5'    :                                 channel : EEL R5
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R5.h90"
+#elif defined key_eel_r6
+   !!---------------------------------------------------------------------
+   !!   'key_eel_r6'    :                                 channel : EEL R6
+   !!---------------------------------------------------------------------
+#             include "par_EEL_R6.h90"
+#elif defined key_gyre
+   !!---------------------------------------------------------------------
+   !!   'key_gyre'      :                        mid-latitude basin : GYRE
+   !!---------------------------------------------------------------------
+#             include "par_GYRE.h90"
+#elif defined key_pomme_r025
+   !!---------------------------------------------------------------------
+   !!   'key_pomme_r025':                        regional basin : POMME025
+   !!---------------------------------------------------------------------
+#             include "par_POMME_R025.h90"
+#elif defined key_amm_12km
+   !!---------------------------------------------------------------------
+   !!   'key_amm_12km':                    Atlantic Margin Model : AMM12km 
+   !!---------------------------------------------------------------------
+#             include "par_AMM_12km.h90"
+#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
+   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
+   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+
+   ! zoom starting position 
+   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                                  !  = 5 North fold F-point pivot
+   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
+   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                                !  = 2 f-plane with regular grid-spacing
+   !                                                !  = 3 beta-plane with regular grid-spacing
+   !                                                !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
+   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
+   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
+   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
+   !
+   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
+   !
+#endif
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
+#if defined key_agrif
+   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
+
+   !!---------------------------------------------------------------------
+   !! Optimization/control flags
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
+#endif
+
+#if defined key_vectopt_loop
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step.F90	(revision 3437)
@@ -0,0 +1,271 @@
+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
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   stp             : OPA system time-stepping
+   !!----------------------------------------------------------------------
+   USE step_oce         ! time stepping definition modules 
+#if defined key_top
+   USE trcstp           ! passive tracer time-stepping      (trc_stp routine)
+#endif
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   stp   ! called by opa.F90
+
+   !! * Substitutions
+#  include "domzgr_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
+
+#if defined key_agrif
+   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, div,cur,w)
+      !!              -8- Outputs and diagnostics
+      !!----------------------------------------------------------------------
+      INTEGER ::   jk       ! dummy loop indice
+      INTEGER ::   indic    ! error indicator if < 0
+      !! ---------------------------------------------------------------------
+
+#if defined key_agrif
+      kstp = nit000 + Agrif_Nb_Step()
+!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
+!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0 )   CALL iom_swap
+# endif   
+#endif   
+                             indic = 0                ! reset to no error condition
+      IF( kstp /= nit000 )   CALL day( kstp )         ! Calendar (day was already called at nit000 in day_init)
+                             CALL iom_setkt( kstp )   ! say to iom that we are at time step kstp
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Update data, open boundaries, surface boundary condition (including sea-ice)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice)
+      IF( lk_tide    )   CALL sbc_tide( kstp )
+      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries
+      IF( lk_obc     )   CALL obc_rad( kstp )         ! compute phase velocities at open boundaries
+      IF( lk_bdy     )   CALL bdy_dta( kstp, time_offset=+1 ) ! update dynamic and tracer data at open boundaries
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !  Ocean dynamics : ssh, wn, hdiv, rot                                 !
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL ssh_wzv( kstp )         ! after ssh & vertical velocity
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Ocean physics update                (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency
+                         CALL bn2( tsn, rn2  )        ! now    Brunt-Vaisala frequency
+      !
+      !  VERTICAL PHYSICS   
+                         CALL zdf_bfr( kstp )         ! bottom friction
+                         
+      !                                               ! Vertical eddy viscosity and diffusivity coefficients
+      IF( lk_zdfric  )   CALL zdf_ric( kstp )            ! Richardson number dependent Kz
+      IF( lk_zdftke  )   CALL zdf_tke( kstp )            ! TKE closure scheme for Kz
+      IF( lk_zdfgls  )   CALL zdf_gls( kstp )            ! GLS closure scheme for Kz
+      IF( lk_zdfkpp  )   CALL zdf_kpp( kstp )            ! KPP closure scheme for Kz
+      IF( lk_zdfcst  )   THEN                            ! Constant Kz (reset avt, avm[uv] to the background value)
+         avt (:,:,:) = rn_avt0 * tmask(:,:,:)
+         avmu(:,:,:) = rn_avm0 * umask(:,:,:)
+         avmv(:,:,:) = rn_avm0 * vmask(:,:,:)
+      ENDIF
+      IF( ln_rnf_mouth ) THEN                         ! increase diffusivity at rivers mouths
+         DO jk = 2, nkrnf   ;   avt(:,:,jk) = avt(:,:,jk) + 2.e0 * rn_avt_rnf * rnfmsk(:,:) * 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 .AND. .NOT. lk_zdfkpp )   &
+         &               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( lk_ldfslp ) THEN                            ! slope of lateral mixing
+                         CALL eos( tsb, rhd )                ! before in situ density
+         IF( ln_zps )    CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv,  &    ! Partial steps: before horizontal gradient
+            &                                      rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF( ln_traldf_grif ) THEN                           ! before slope for Griffies operator
+                         CALL ldf_slp_grif( kstp )
+         ELSE
+                         CALL ldf_slp( kstp, rhd, rn2b )     ! before slope for Madec operator
+         ENDIF
+      ENDIF
+#if defined key_traldf_c2d
+      IF( lk_traldf_eiv )   CALL ldf_eiv( kstp )      ! eddy induced velocity coefficient
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! diagnostics and outputs             (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats
+      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth)
+      IF( lk_diafwb  )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics
+      IF( ln_diaptr  )   CALL dia_ptr( kstp )         ! Poleward TRansports diagnostics
+      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports
+      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag
+      IF( lk_diaharm )   CALL dia_harm( kstp )        ! Tidal harmonic analysis
+                         CALL dia_wri( kstp )         ! ocean model: outputs
+
+#if defined key_top
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Passive Tracer Model
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                         CALL trc_stp( kstp )         ! time-stepping
+#endif
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Active tracers                              (ua, va used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                             tsa(:,:,:,:) = 0.e0            ! set tracer trends to zero
+
+      IF(  ln_asmiau .AND. &
+         & ln_trainc     )   CALL tra_asm_inc( kstp )       ! apply tracer assimilation increment
+                             CALL tra_sbc    ( kstp )       ! surface boundary condition
+      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr
+      IF( 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
+                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection
+      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes
+                             CALL tra_ldf    ( kstp )       ! lateral mixing
+#if defined key_agrif
+      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge
+#endif
+                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields
+
+      IF( ln_dynhpg_imp  ) THEN                             ! semi-implicit hpg (time stepping then eos)
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
+                             CALL eos    ( tsa, rhd, rhop )      ! Time-filtered in situ density for hpg computation
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv,  &    ! zps: time filtered hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         
+      ELSE                                                  ! centered hpg  (eos then time stepping)
+                             CALL eos    ( tsn, rhd, rhop )      ! now in situ density for hpg computation
+         IF( ln_zps      )   CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv,  &    ! zps: now hor. derivative
+            &                                          rhd, gru , grv  )      ! of t, s, rd at the last ocean level
+         IF( ln_zdfnpc   )   CALL tra_npc( kstp )                ! update after fields by non-penetrative convection
+                             CALL tra_nxt( kstp )                ! tracer fields at next time step
+      ENDIF 
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Dynamics                                    (tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero
+                               va(:,:,:) = 0.e0
+
+      IF(  ln_asmiau .AND. &
+         & ln_dyninc       )   CALL dyn_asm_inc( kstp )     ! apply dynamics assimilation increment
+      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! subtract Neptune velocities (simplified)
+                               CALL dyn_adv( kstp )         ! advection (vector or flux form)
+                               CALL dyn_vor( kstp )         ! vorticity term including Coriolis
+                               CALL dyn_ldf( kstp )         ! lateral mixing
+      IF( ln_neptsimp )        CALL dyn_nept_cor( kstp )    ! add Neptune velocities (simplified)
+#if defined key_agrif
+      IF(.NOT. Agrif_Root())   CALL Agrif_Sponge_dyn        ! momemtum sponge
+#endif
+                               CALL dyn_hpg( kstp )         ! horizontal gradient of Hydrostatic pressure
+                               CALL dyn_bfr( kstp )         ! bottom friction   
+                               CALL dyn_zdf( kstp )         ! vertical diffusion
+                               CALL dyn_spg( kstp, indic )  ! surface pressure gradient
+                               CALL dyn_nxt( kstp )         ! lateral velocity at next time step
+
+                               CALL ssh_nxt( kstp )         ! sea surface height at next time step
+
+      IF( ln_diahsb        )   CALL dia_hsb( kstp )         ! - ML - global conservation diagnostics
+      IF( lk_diaobs  )         CALL dia_obs( kstp )         ! obs-minus-model (assimilation) diagnostics (call after dynamics update)
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Control and restarts
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+                               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
+      IF( lrst_oce         )   CALL rst_write    ( kstp )   ! write output ocean restart file
+      IF( lk_obc           )   CALL obc_rst_write( kstp )   ! write open boundary restart file
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Trends                              (ua, va, tsa used as workspace)
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( nstop == 0 ) THEN                         
+         IF( lk_trddyn     )   CALL trd_dwr( kstp )         ! trends: dynamics 
+         IF( lk_trdtra     )   CALL trd_twr( kstp )         ! trends: active tracers
+         IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer 
+         IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Coupled mode
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+      IF( lk_cpl           )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges
+      !
+      IF( nn_timing == 1 .AND.  kstp == nit000  )   CALL timing_reset
+      !
+   END SUBROUTINE stp
+
+   !!======================================================================
+END MODULE step
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/step_oce.F90	(revision 3437)
@@ -0,0 +1,112 @@
+MODULE step_oce
+   !!======================================================================
+   !!                       ***  MODULE step_oce  ***
+   !! Ocean time-stepping : module used in both initialisation phase and time stepping
+   !!======================================================================
+   !! History :   3.3  ! 2010-08  (C. Ethe)  Original code - reorganisation of the initial phase
+   !!----------------------------------------------------------------------
+   USE oce              ! ocean dynamics and tracers variables
+   USE dom_oce          ! ocean space and time domain variables 
+   USE zdf_oce          ! ocean vertical physics variables
+   USE ldftra_oce       ! ocean tracer   - trends
+   USE ldfdyn_oce       ! ocean dynamics - trends
+   USE in_out_manager   ! I/O manager
+   USE iom              !
+   USE lbclnk
+
+   USE daymod           ! calendar                         (day     routine)
+
+   USE sbcmod           ! surface boundary condition       (sbc     routine)
+   USE sbcrnf           ! surface boundary condition: runoff variables
+   USE sbccpl           ! surface boundary condition: coupled formulation (call send at end of step)
+   USE cpl_oasis3, ONLY : lk_cpl
+   USE sbctide          ! Tide initialisation
+
+   USE traqsr           ! solar radiation penetration      (tra_qsr routine)
+   USE trasbc           ! surface boundary condition       (tra_sbc routine)
+   USE trabbc           ! bottom boundary condition        (tra_bbc routine)
+   USE trabbl           ! bottom boundary layer            (tra_bbl routine)
+   USE tradmp           ! internal damping                 (tra_dmp routine)
+   USE traadv           ! advection scheme control     (tra_adv_ctl routine)
+   USE traldf           ! lateral mixing                   (tra_ldf routine)
+   !   zdfkpp           ! KPP non-local tracer fluxes      (tra_kpp routine)
+   USE trazdf           ! vertical mixing                  (tra_zdf routine)
+   USE tranxt           ! time-stepping                    (tra_nxt routine)
+   USE tranpc           ! non-penetrative convection       (tra_npc routine)
+
+   USE eosbn2           ! equation of state                (eos_bn2 routine)
+
+   USE dynadv           ! advection                        (dyn_adv routine)
+   USE dynbfr           ! Bottom friction terms            (dyn_bfr routine)
+   USE dynvor           ! vorticity term                   (dyn_vor routine)
+   USE dynhpg           ! hydrostatic pressure grad.       (dyn_hpg routine)
+   USE dynldf           ! lateral momentum diffusion       (dyn_ldf routine)
+   USE dynzdf           ! vertical diffusion               (dyn_zdf routine)
+   USE dynspg_oce       ! surface pressure gradient        (dyn_spg routine)
+   USE dynspg           ! surface pressure gradient        (dyn_spg routine)
+   USE dynnept          ! simp. form of Neptune effect(dyn_nept_cor routine)
+
+   USE dynnxt           ! time-stepping                    (dyn_nxt routine)
+
+   USE obc_par          ! open boundary condition variables
+   USE obcdta           ! open boundary condition data     (obc_dta routine)
+   USE obcrst           ! open boundary cond. restart      (obc_rst routine)
+   USE obcrad           ! open boundary cond. radiation    (obc_rad routine)
+
+   USE bdy_par          ! for lk_bdy
+   USE bdydta           ! open boundary condition data     (bdy_dta routine)
+
+   USE sshwzv           ! vertical velocity and ssh        (ssh_wzv routine)
+
+   USE ldfslp           ! iso-neutral slopes               (ldf_slp routine)
+   USE ldfeiv           ! eddy induced velocity coef.      (ldf_eiv routine)
+
+   USE zdftmx           ! tide-induced vertical mixing     (zdf_tmx routine)
+   USE zdfbfr           ! bottom friction                  (zdf_bfr routine)
+   USE zdftke           ! TKE vertical mixing              (zdf_tke routine)
+   USE zdfgls           ! GLS vertical mixing              (zdf_gls routine)
+   USE zdfkpp           ! KPP vertical mixing              (zdf_kpp routine)
+   USE zdfddm           ! double diffusion mixing          (zdf_ddm routine)
+   USE zdfevd           ! enhanced vertical diffusion      (zdf_evd routine)
+   USE zdfric           ! Richardson vertical mixing       (zdf_ric routine)
+   USE zdfmxl           ! Mixed-layer depth                (zdf_mxl routine)
+
+   USE zpshde           ! partial step: hor. derivative     (zps_hde routine)
+
+   USE diawri           ! Standard run outputs             (dia_wri routine)
+   USE trdicp           ! Ocean momentum/tracers trends    (trd_wri routine)
+   USE trdmld           ! mixed-layer trends               (trd_mld routine)
+   USE trdmld_rst       ! restart for mixed-layer trends
+   USE trdmod_oce       ! ocean momentum/tracers trends
+   USE trdmod           ! momentum/tracers trends   
+   USE trdvor           ! vorticity budget                 (trd_vor routine)
+   USE diaptr           ! poleward transports              (dia_ptr routine)
+   USE diadct           ! sections transports              (dia_dct routine)
+   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine)
+   USE diahth           ! thermocline depth                (dia_hth routine)
+   USE diafwb           ! freshwater budget                (dia_fwb routine)
+   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine)
+   USE diaharm
+   USE flo_oce          ! floats variables
+   USE floats           ! floats computation               (flo_stp routine)
+
+   USE asminc           ! assimilation increments      (tra_asm_inc routine)
+   !                                                   (dyn_asm_inc routine)
+
+   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 timing           ! Timing            
+
+#if defined key_agrif
+   USE agrif_opa_sponge ! Momemtum and tracers sponges
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE step_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/stpctl.F90	(revision 3437)
@@ -0,0 +1,180 @@
+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 sol_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
+   USE dynspg_oce      ! pressure gradient schemes 
+   USE c1d             ! 1D vertical configuration
+
+   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
+      !!              - Print solver statistics in numsol 
+      !!              - Stop the run IF problem for the solver ( indec < 0 )
+      !!
+      !! ** 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
+      !!
+      INTEGER  ::   ji, jj, jk              ! dummy loop indices
+      INTEGER  ::   ii, ij, ik              ! temporary integers
+      REAL(wp) ::   zumax, zsmin, zssh2     ! temporary 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.e0
+      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 (solver or ssh statistics)
+      ! --------
+      IF( lk_dynspg_flt ) THEN      ! elliptic solver statistics (if required)
+         !
+         IF(lwp) WRITE(numsol,9200) kt, niter, res, SQRT(epsr)/eps       ! Solver
+         !
+         IF( kindic < 0 .AND. zsmin > 0.e0 .AND. zumax <= 20.e0 ) THEN   ! create a abort file if problem found 
+            IF(lwp) THEN
+               WRITE(numout,*) ' stpctl: the elliptic solver DO not converge or explode'
+               WRITE(numout,*) ' ====== '
+               WRITE(numout,9200) kt, niter, res, sqrt(epsr)/eps
+               WRITE(numout,*)
+               WRITE(numout,*) ' stpctl: output of last fields'
+               WRITE(numout,*) ' ======  '
+            ENDIF
+         ENDIF
+         !
+      ELSE                                   !* 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
+         !
+      ENDIF
+
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/timing.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/timing.F90	(revision 3437)
@@ -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.3  (2010) '
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90	(revision 3437)
@@ -0,0 +1,281 @@
+MODULE trc_oce
+   !!======================================================================
+   !!                      ***  MODULE  trc_oce  ***
+   !! Ocean passive tracer  :  share SMS/Ocean variables
+   !!======================================================================
+   !! History :  1.0  !  2004-03  (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   !!   trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration         
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE in_out_manager  ! I/O manager
+   USE dom_oce         ! ocean space and time domain
+   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
+
+   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
+
+#if defined key_top && defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_top'   &   'key_pisces'                       PISCES bio-model          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .TRUE.   !: bio-model light absorption flag
+#else
+   !!----------------------------------------------------------------------
+   !! Default option                          No bio-model light absorption      
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_qsr_bio = .FALSE.   !: bio-model light absorption flag
+#endif
+
+#if defined key_offline
+   !!----------------------------------------------------------------------
+   !!   'key_offline'                                     OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .TRUE.   !: offline flag
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NO  OFFLINE mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_offline = .FALSE.   !: offline flag
+#endif
+#if defined key_degrad
+   !!----------------------------------------------------------------------
+   !!   'key_degrad'                                     Degradation mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .TRUE.   !: degradation flag
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                   NO  Degradation mode          
+   !!----------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_degrad = .FALSE.   !: degradation flag
+#endif
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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  ***
+      !!----------------------------------------------------------------------
+      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) 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 bellow the following depth
+      zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
+      !
+      ! Level of light extinction
+      pjl = jpkm1
+      DO jk = jpkm1, 1, -1
+         zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )
+         IF( zem >= zhext )   pjl = jk                       ! last T-level reached by Qsr
+      END DO
+      !
+   END FUNCTION trc_oce_ext_lev
+
+   !!======================================================================
+END MODULE trc_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/vectopt_loop_substitute.h90	(revision 3437)
@@ -0,0 +1,18 @@
+   !!----------------------------------------------------------------------
+   !!                   ***  vectopt_loop_substitute  ***
+   !!----------------------------------------------------------------------
+   !! ** purpose :   substitute the inner loop starting and inding indices 
+   !!      to allow unrolling of do-loop using CPP macro.
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90	(revision 3437)
@@ -0,0 +1,596 @@
+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.
+   !!----------------------------------------------------------------------
+   !! 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 
+         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
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90	(revision 3437)
@@ -0,0 +1,67 @@
+MODULE par_c14b
+   !!======================================================================
+   !!                        ***  par_c14b ***
+   !! TOP :   set the C14 bomb parameters
+   !!======================================================================
+   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER
+
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_2d       !: number of 2D diag in CFC
+   USE par_cfc    , ONLY : jp_cfc_3d       !: number of 3D diag in CFC
+   USE par_cfc    , ONLY : jp_cfc_trd      !: number of biological diag in CFC
+
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lb      = jp_lobster     + jp_pisces     + jp_cfc     !: cum. number of pass. tracers
+   INTEGER, PARAMETER ::   jp_lb_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  !:
+   INTEGER, PARAMETER ::   jp_lb_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  !:
+   INTEGER, PARAMETER ::   jp_lb_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd !:
+   
+#if defined key_c14b
+   !!---------------------------------------------------------------------
+   !!   'key_c14b'   :                                   C14 bomb tracer
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c14b     = .TRUE.      !: C14 bomb flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b     =  1          !: number of passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_3d  =  1          !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_trd =  0          !: number of sms trends for C14
+   INTEGER, PUBLIC, PARAMETER ::   jpc14       = jp_lb + 1   !: assign an index in trc arrays for C14 bomb 
+#else
+   !!---------------------------------------------------------------------
+   !!   Default     :                                       No C14 tracer
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_c14b     = .FALSE.     !: C14 bomb flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b     =  0          !: No C14 tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_2d  =  0          !: No C14 additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_3d  =  0          !: No C14 additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_trd =  0          !: number of sms trends for C14
+#endif
+
+   ! Starting/ending C14 do-loop indices (N.B. no C14 : jp_c14b0 > jp_c14b1 the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb     + 1            !: First index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb     + jp_c14b      !: Last  index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_2d  = jp_lb_2d  + 1            !: First index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_2d  = jp_lb_2d  + jp_c14b_2d   !: Last  index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_3d  = jp_lb_3d  + 1            !: First index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_3d  = jp_lb_3d  + jp_c14b_3d   !: Last  index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_trd = jp_lb_trd + 1            !: First index of C14 tracer
+   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_trd = jp_lb_trd + jp_c14b_trd  !: Last  index of C14 tracer
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_c14b
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90	(revision 3437)
@@ -0,0 +1,215 @@
+MODULE trcini_c14b
+   !!======================================================================
+   !!                         ***  MODULE trcini_c14b  ***
+   !! TOP :   initialisation of the C14 bomb tracer
+   !!======================================================================
+   !! History :  1.0  ! 2005-10  (Z. Lachkar) Original code
+   !!            2.0  ! 2007-12  (C. Ethe) 
+   !!----------------------------------------------------------------------
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                          C14 bomb tracer
+   !!----------------------------------------------------------------------
+   !! trc_ini_c14b      : C14 model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_c14b     ! C14 sms trends
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_c14b   ! called by trcini.F90 module
+
+   !                             ! With respect to data file !!
+   INTEGER  ::   jpybeg = 1765   ! starting year for C14
+   INTEGER  ::   jpyend = 2002   ! ending year for C14
+   INTEGER  ::   nrec            ! number of year in CO2 Concentrations file
+   INTEGER  ::   nmaxrec 
+   INTEGER  ::   inum1, inum2    ! unit number
+
+   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
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_c14b
+      !!-------------------------------------------------------------------
+      !!                     ***  trc_ini_c14b  ***  
+      !!
+      !! ** Purpose :   initialization for C14 model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jl, jm
+      REAL(wp) ::   zyear
+      !!----------------------------------------------------------------------
+
+      !                     ! Allocate C14b arrays
+      IF( trc_sms_c14b_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' )
+
+      CALL trc_ctl_c14b     !  Control consitency
+
+      IF(lwp) WRITE(numout,*) ''
+      IF(lwp) WRITE(numout,*) ' trc_ini_c14b: initialisation of Bomb C14 chemical model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+
+      ! Initialization of boundaries conditions
+      ! --------------------------------------- 
+      qtr_c14(:,:) = 0._wp
+      
+      ! Initialization of qint in case of  no restart 
+      !----------------------------------------------
+      IF( .NOT. ln_rsttr ) THEN    
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero '
+         ENDIF
+         trn     (:,:,:,jpc14) = 0._wp
+         qint_c14(:,:        ) = 0._wp
+      ENDIF
+
+
+      ! Read CO2 atmospheric concentrations file...
+      ! read CO2 data from year jpybeg to year jpyend
+      !------------------------------------------------
+
+      nrec    = ( jpyend - jpybeg + 1 )     ! number of year in CO2 Concentrations file
+      nmaxrec = 2 * nrec
+
+      IF(lwp) WRITE(numout,*) 'Read CO2 atmospheric concentrations file '
+  
+      CALL ctl_opn( inum1, 'splco2.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      REWIND(inum1)
+      
+      DO jm = 1, 5        ! Skip over 1st six descriptor lines
+         READ(inum1,'(1x)')
+      END DO
+
+      ! get  CO2 data
+      DO jm = 1, nmaxrec
+         READ(inum1, *)  zyear, spco2(jm)
+         IF (lwp) WRITE(numout, '(f7.1,f9.4)')  zyear, spco2(jm)
+      END DO
+      WRITE(numout,*)
+      CLOSE(inum1)
+
+      IF (lwp) WRITE(numout,*) 'Read C-14 atmospheric concentrations file '
+
+      CALL ctl_opn( inum2, 'atmc14.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+      REWIND(inum2)
+
+      ! Skip over 1st descriptor line
+      READ(inum2, '(1x)')
+
+      ! READ FILE
+      DO jm = 1, nrec
+         READ(inum2,*) zyear, bomb(jm,1), bomb(jm,2), bomb(jm,3)
+         IF (lwp) WRITE(numout, '(f7.1, 3f9.4)') zyear, bomb(jm,1), bomb(jm,2), bomb(jm,3)
+      END DO
+      CLOSE(inum2)
+
+      ! Conversion unit : Now atm units are in real C-14 [per mil]
+      ! C-14(Orr) = C-14(per mil)/10.0
+       DO jm = 1, nrec
+         bomb(jm,1) = ( bomb(jm,1 ) + 17.40 ) * 0.1
+         bomb(jm,2) = ( bomb(jm,2 ) + 10.40 ) * 0.1
+         bomb(jm,3) = ( bomb(jm,3 ) + 14.65 ) * 0.1
+       END DO
+
+       ! Linear  interpolation of the C-14 source fonction
+       ! in linear latitude band  (20N,40N) and (20S,40S)
+       !------------------------------------------------------
+       DO jj = 1 , jpj
+          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
+      !
+      IF(lwp) WRITE(numout,*) 'Initialization of C14 bomb tracer done'
+      IF(lwp) WRITE(numout,*) ' '
+      !
+   END SUBROUTINE trc_ini_c14b
+
+
+   SUBROUTINE trc_ctl_c14b
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_ctl_c14b  ***
+      !!
+      !! ** Purpose :   control the cpp options, namelist and files 
+      !!----------------------------------------------------------------------
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' C14 bomb Model '
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! Check number of tracers
+      ! -----------------------   
+      IF( jp_c14b > 1)   CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' )
+
+      ! Check tracer names
+      ! ------------------
+      IF( ctrcnm(jpc14) /= 'C14B' ) THEN
+          ctrcnm(jpc14)  = 'C14B'
+          ctrcln(jpc14)  = 'Bomb C14 concentration'
+      ENDIF
+
+      IF(lwp) THEN
+         CALL ctl_warn( ' we force tracer names' )
+         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcln(jpc14)
+         WRITE(numout,*) ' '
+      ENDIF
+
+      ! Check tracer units
+      ! ------------------
+      IF( ctrcun(jpc14) /= 'ration' ) THEN
+          ctrcun(jpc14)  = 'ration'
+          IF(lwp) THEN
+             CALL ctl_warn( ' we force tracer unit' )
+             WRITE(numout,*) ' tracer  ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14)
+             WRITE(numout,*) ' '
+          ENDIF
+       ENDIF
+      !
+   END SUBROUTINE trc_ctl_c14b
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                    No C14 bomb tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_c14b             ! Empty routine
+   END SUBROUTINE trc_ini_c14b
+#endif
+
+   !!======================================================================
+END MODULE trcini_c14b
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90	(revision 3437)
@@ -0,0 +1,138 @@
+MODULE trcnam_c14b
+   !!======================================================================
+   !!                         ***  MODULE trcnam_c14b  ***
+   !! TOP :   initialisation of some run parameters for C14 chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
+   !!----------------------------------------------------------------------
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                         C14 bomb tracer
+   !!----------------------------------------------------------------------
+   !! trc_nam_c14b      : C14 model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_c14b     ! C14b specific variable
+   USE iom             ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_c14b   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_c14b
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_c14b  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for C14 model
+      !!
+      !! ** Method  :   Read the namc14 namelist and check the parameter 
+      !!       values called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist namelist_c14b
+      !!----------------------------------------------------------------------
+      INTEGER ::   numnatb
+
+      ! definition of additional diagnostic as a structure
+      INTEGER :: jl, jn
+      TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d
+      TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d
+      !!
+      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b
+      NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics
+      !!-------------------------------------------------------------------
+
+      ndate_beg_b = 650101            ! default namelist value
+      nyear_res_b = 1955
+
+      !                             ! Open namelist file
+      CALL ctl_opn( numnatb, 'namelist_c14b', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         
+      READ( numnatb , namc14date )     ! read namelist
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam: Read namdates, namelist for C14 chemical model'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '    initial calendar date (aammjj) for C14  ndate_beg_b = ', ndate_beg_b
+         WRITE(numout,*) '    restoring time constant (year)          nyear_res_b = ', nyear_res_b
+      ENDIF
+      nyear_beg_b = ndate_beg_b / 10000
+      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b
+      !
+      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
+         !
+         ! Namelist namc14dia
+         ! -------------------
+         DO jl = 1, jp_c14b_2d
+            WRITE(c14dia2d(jl)%sname,'("2D_",I1)') jl                      ! short name
+            WRITE(c14dia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            c14dia2d(jl)%units = ' '                                       ! units
+         END DO
+         !                                 ! 3D output arrays
+         DO jl = 1, jp_c14b_3d
+            WRITE(c14dia3d(jl)%sname,'("3D_",I1)') jl                      ! short name
+            WRITE(c14dia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            c14dia3d(jl)%units = ' '                                       ! units
+         END DO
+
+         REWIND( numnatb )               ! 
+         READ  ( numnatb, namc14dia )
+
+         DO jl = 1, jp_c14b_2d
+            jn = jp_c14b0_2d + jl - 1
+            ctrc2d(jn) = c14dia2d(jl)%sname
+            ctrc2l(jn) = c14dia2d(jl)%lname
+            ctrc2u(jn) = c14dia2d(jl)%units
+         END DO
+
+         DO jl = 1, jp_c14b_3d
+            jn = jp_c14b0_3d + jl - 1
+            ctrc3d(jn) = c14dia3d(jl)%sname
+            ctrc3l(jn) = c14dia3d(jl)%lname
+            ctrc3u(jn) = c14dia3d(jl)%units
+         END DO
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : natadd'
+            DO jl = 1, jp_c14b_3d
+               jn = jp_c14b0_3d + jl - 1
+               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
+                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
+            END DO
+            WRITE(numout,*) ' '
+
+            DO jl = 1, jp_c14b_2d
+               jn = jp_c14b0_2d + jl - 1
+               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
+                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+         !
+      ENDIF
+
+   END SUBROUTINE trc_nam_c14b
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No 14C
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_c14b                      ! Empty routine
+   END  SUBROUTINE  trc_nam_c14b
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_c14b
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90	(revision 3437)
@@ -0,0 +1,85 @@
+MODULE trcrst_c14b
+   !!======================================================================
+   !!                       ***  MODULE trcrst_c14b  ***
+   !! TOP :   create, write, read the restart files of c14b tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!----------------------------------------------------------------------
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                               c14b tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_c14b   : read  restart file
+   !!   trc_rst_wri_c14b    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_c14b          ! c14b sms trends
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_c14b   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_c14b   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_c14b( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_c14b  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from c14b model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      INTEGER              :: jn    ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_c14b : Read specific variables from c14b model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      
+      CALL iom_get( knum, jpdom_autoglo, 'qint_c14', qint_c14 ) 
+
+   END SUBROUTINE trc_rst_read_c14b
+
+   SUBROUTINE trc_rst_wri_c14b( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_c14b  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from c14b model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_c14b : Write specific variables from c14b model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      CALL iom_rstput( kt, kitrst, knum, 'qint_c14', qint_c14 )
+
+   END SUBROUTINE trc_rst_wri_c14b
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_c14b( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_wri_c14b: You should not have seen this print! error?', knum
+   END SUBROUTINE trc_rst_read_c14b
+
+   SUBROUTINE trc_rst_wri_c14b( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_c14b: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_c14b
+#endif
+
+   !!======================================================================
+END MODULE trcrst_c14b
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90	(revision 3437)
@@ -0,0 +1,318 @@
+MODULE trcsms_c14b
+   !!======================================================================
+   !!                      ***  MODULE trcsms_c14b  ***
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_c14b
+   !!----------------------------------------------------------------------
+   !!   'key_c14b'                                         Bomb C14 tracer
+   !!----------------------------------------------------------------------
+   !!   trc_sms_c14b :  compute and add C14 suface forcing to C14 trends
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! Ocean variables
+   USE par_trc       ! TOP parameters
+   USE trc           ! TOP variables
+   USE trdmod_oce
+   USE trdmod_trc
+   USE iom           ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_c14b       ! called in trcsms.F90
+   PUBLIC   trc_sms_c14b_alloc ! called in trcini_c14b.F90
+
+   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec  = 240           ! temporal parameter 
+   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec2 = 2 * jpmaxrec  ! 
+   INTEGER , PUBLIC, PARAMETER ::   jpzon     = 3             ! number of zones
+
+   INTEGER , PUBLIC    ::   ndate_beg_b      ! initial calendar date (aammjj) for C14
+   INTEGER , PUBLIC    ::   nyear_beg_b      ! initial year for C14
+   INTEGER , PUBLIC    ::   nyear_res_b      ! restoring time constant (year)
+   INTEGER , PUBLIC    ::   nyear_beg        ! initial year (aa) 
+
+   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec,jpzon) ::   bomb       !: C14 atm data (3 zones)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)          ::   fareaz     !: Spatial Interpolation Factors
+   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec2)      ::   spco2      !: Atmospheric CO2
+  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qtr_c14    !: flux at surface
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qint_c14   !: cumulative flux
+
+   REAL(wp) ::   xlambda, xdecay, xaccum       ! C14 decay coef.  
+   REAL(wp) ::   xconv1 = 1._wp                ! conversion from to 
+   REAL(wp) ::   xconv2 = 0.01_wp / 3600._wp   ! conversion from cm/h to m/s: 
+   REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_c14b( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sms_c14b  ***
+      !!
+      !! ** Purpose :   Compute the surface boundary contition on C14bomb
+      !!      passive tracer associated with air-mer fluxes and add it to 
+      !!      the general trend of tracers equations.
+      !!
+      !! ** Original comments from J. Orr :
+      !!
+      !!      Calculates the input of Bomb C-14 to the surface layer of OPA
+      !!
+      !!      James Orr, LMCE, 28 October 1992
+      !!
+      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989)
+      !!      (hereafter referred to as TDB) with constant gas exchange,
+      !!      although in this case, a perturbation approach is used for
+      !!      bomb-C14 so that both the ocean and atmosphere begin at zero.
+      !!      This saves tremendous amounts of computer time since no
+      !!      equilibrum run is first required (i.e., for natural C-14).
+      !!      Note: Many sensitivity tests can be run with this approach and
+      !!            one never has to make a run for natural C-14; otherwise,
+      !!            a run for natural C-14 must be run each time that one
+      !!            changes a model parameter!
+      !!
+      !!
+      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC.
+      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy
+      !!      of Martin Heimann) for model calibration.  This model spans from
+      !!      preindustrial times to present, in a format different than that
+      !!      given by TDB.  It must be converted to the ORR C-14 units used
+      !!      here, although in this case, the perturbation includes not only
+      !!      bomb C-14 but changes due to the Suess effect.
+      !!
+      !!----------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
+      !
+      INTEGER :: ji, jj, jk, jz     ! dummy loop indices 
+      INTEGER :: iyear_beg , iyear_beg1, iyear_end1 
+      INTEGER :: iyear_beg2, iyear_end2 
+      INTEGER :: imonth1, im1, in1 
+      INTEGER :: imonth2, im2, in2 
+      REAL(wp), DIMENSION(jpzon) :: zonbc14       !: time interp atm C14 
+      REAL(wp)                   :: zpco2at       !: time interp atm C02 
+      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 
+      REAL(wp) :: zdemi, ztra
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zatmbc14  
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdecay
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_c14b')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zatmbc14 )
+      CALL wrk_alloc( jpi, jpj, jpk, zdecay   )
+
+      IF( kt == nittrc000 )  THEN         ! Computation of decay coeffcient
+         zdemi   = 5730._wp
+         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday )
+         xdecay  = EXP( - xlambda * rdt )
+         xaccum  = 1._wp -  xdecay
+      ENDIF
+
+      ! Temporal interpolation
+      ! ----------------------
+      iyear_beg = nyear - 1954 + ( nyear_res_b - 1700 - nyear_beg_b  ) ! JMM Very dangerous 
+                                                                       ! nyear=0001 for 1955
+      ! For Atmospheric C14 concentrations:
+      iyear_beg1 = iyear_beg
+      imonth1    = nmonth
+      IF ( imonth1 <= 6 ) THEN
+         iyear_beg1 = iyear_beg1 - 1
+         im1       =  6 - imonth1 + 1
+         im2       =  6 + imonth1 - 1
+      ELSE
+         im1       = 12 - imonth1 + 7
+         im2       =      imonth1 - 7
+      ENDIF
+      iyear_end1 = iyear_beg1 + 1
+
+      iyear_beg1 = MAX( iyear_beg1, 1   )
+      iyear_end1 = MIN( iyear_end1, 241 )
+
+
+      ! For Atmospheric CO2 concentrations:
+      iyear_beg2 = 2 * iyear_beg - 1
+      imonth2    = INT( nmonth / 2. )
+
+      IF ( imonth2 <= 3 ) THEN
+         iyear_beg2 = iyear_beg2 - 1 
+         in1       = 3 - imonth2 + 1
+         in2       = 3 + imonth2 - 1
+      ELSE
+         in1       = 6 - imonth2 + 4
+         in2       =     imonth2 - 4
+      ENDIF
+      
+      iyear_end2 = iyear_beg2 + 1
+      
+      iyear_beg2 = MAX( iyear_beg2, 1   )
+      iyear_end2 = MIN( iyear_end2, 482 )
+
+
+      !  ----------------------------------------------------------------
+      !  As explained by the TDB 89 papers, C-14/C-12 is the same
+      !  as C-14 concentration in this special case (no fractionation
+      !  effects in this model, which thus allow direct comparison
+      !  to del-C-14, after unit change from above).
+      ! -----------------------------------------------------------------------
+      !  Calc C-14 in atmosphere based on interp of IPCC (M. Heimann) data
+      !        - Compare input to calculated C-14 for each time in record
+      !-------------------------------------------------------------------------
+      
+      
+      !  Temporal and spatial interpolation at time k
+      ! --------------------------------------------------
+      
+      ! Compute atmospheric C-14 for each zone (90-20S, 20S-20N, 20-90N)
+      DO jz = 1, jpzon
+         zonbc14(jz) = (  bomb(iyear_beg1,jz) * FLOAT( im1 )  &
+              &         + bomb(iyear_end1,jz) * FLOAT( im2 ) ) / 12.
+         ! C-14 exactly starts at zero :
+         ! JMM +Zouhair : Slightly negative values are set to 0 (when perturbation approaches)
+         zonbc14(jz) = MAX( zonbc14(jz), 0. )
+      END DO
+      
+      
+      !  For each (i,j)-box, with information from the fractional area
+      !  (zonmean), computes area-weighted mean to give the atmospheric C-14
+      !  ----------------------------------------------------------------
+      zatmbc14(:,:) = zonbc14(1) * fareaz(:,:,1)   &
+         &          + zonbc14(2) * fareaz(:,:,2)   &
+         &          + zonbc14(3) * fareaz(:,:,3)
+      
+      ! time interpolation of CO2 concentrations to it time step  
+      zpco2at = (  spco2(iyear_beg2) * FLOAT( in1 )              &
+           &     + spco2(iyear_end2) * FLOAT( in2 ) ) / 6.
+
+      IF(lwp) THEN
+          WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2,   &
+          &                ' CO2 concen : ',zpco2at 
+          WRITE(numout, *) 'time : ', kt, ' C14 year begin/end :',iyear_beg1,'/',iyear_end1,   &
+          &                ' C14B concen (Z1/Z2/Z3) : ',zonbc14(1),'/',zonbc14(2),'/',zonbc14(3)
+      ENDIF
+
+      !  Determine seasonally variable gas exchange coefficient 
+      !----------------------------------------------------------
+      !  Computes the Schmidt number of CO2 in seawater using the formulation
+      !  presented by Wanninkhof (1992, J. Geophys. Res., 97,7373-7382).  
+      ! -------------------------------------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi  
+            !  Computation of solubility  
+            IF (tmask(ji,jj,1) >  0.) THEN
+               ztp  = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01
+               zsk  = 0.023517 + ztp * ( -0.023656 + 0.0047036 * ztp )
+               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) )
+               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)]
+               zsol = zsol * 1.e-03
+            ELSE
+               zsol = 0._wp
+            ENDIF
+
+            ! speed transfert : Formulation of Wanninkhof (1992, JGR, 97,7373-7382)
+            ! JMM/Zouhair : coef of 0.25 rather than 0.3332 for CORe wind speed
+
+            ! Computes the Schmidt number of CO2 in seawater
+            zt   = tsn(ji,jj,1,jp_tem)
+            zsch = 2073.1 + zt * ( -125.62 + zt * (3.6276 - 0.043219 * zt ) )
+
+            ! Wanninkhof Piston velocity and convert from units [cm/hr] -> [m/s]
+            zv2  = wndm(ji,jj) * wndm(ji,jj)
+            zsch = zsch / 660.
+            zpv  = ( 0.25  * zv2 / SQRT(zsch) ) * xconv2 * tmask(ji,jj,1)
+
+            ! Flux of Bomb C-14 from air-sea : speed*(conc. at equil-conc. at surf)
+            ! in C-14 (orr-model-units) / m**2 * s
+            qtr_c14(ji,jj) = -zpv * zsol * zpco2at                                   &
+                 &                       * ( trb(ji,jj,1,jpc14) - zatmbc14(ji,jj) )  &
+#if defined key_degrad
+                 &                       * facvol(ji,jj,1)                           &
+#endif
+                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2.
+            ! Add the surface flux to the trend
+            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1) 
+            
+            ! cumulation of surface flux at each time step
+            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt
+            !
+         END DO
+      END DO
+
+      ! Computation of decay effects on tracer concentration
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+#if defined key_degrad
+               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) )
+#else
+               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * xaccum
+#endif
+               tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - zdecay(ji,jj,jk) / rdt
+               !
+            END DO
+         END DO
+      END DO
+
+      IF( ln_diatrc ) THEN
+         IF( lk_iomput ) THEN
+            CALL iom_put( "qtrC14b"  , qtr_c14  )
+            CALL iom_put( "qintC14b" , qint_c14 )
+            CALL iom_put( "fdecay"   , zdecay   )
+          ELSE
+            trc2d(:,:  ,jp_c14b0_2d     ) = qtr_c14 (:,:)
+            trc2d(:,:  ,jp_c14b0_2d + 1 ) = qint_c14(:,:)
+            trc3d(:,:,:,jp_c14b0_3d     ) = zdecay  (:,:,:)
+          ENDIF
+      ENDIF
+
+      IF( l_trdtrc )  CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends
+
+      CALL wrk_dealloc( jpi, jpj,      zatmbc14 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdecay   )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_c14b')
+      !
+   END SUBROUTINE trc_sms_c14b
+
+
+   INTEGER FUNCTION trc_sms_c14b_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sms_c14b_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( fareaz  (jpi,jpj ,jpzon) ,     &
+         &      qtr_c14 (jpi,jpj)        ,     &
+         &      qint_c14(jpi,jpj)        , STAT=trc_sms_c14b_alloc )
+         !
+      IF( trc_sms_c14b_alloc /= 0 )   CALL ctl_warn('trc_sms_c14b_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trc_sms_c14b_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Dummy module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine
+      WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_c14b
+#endif
+
+  !!======================================================================
+END MODULE trcsms_c14b
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90	(revision 3437)
@@ -0,0 +1,64 @@
+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)
+   !!----------------------------------------------------------------------
+   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER
+
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lc      = jp_lobster     + jp_pisces     !: cumulative number of passive tracers
+   INTEGER, PARAMETER ::   jp_lc_2d   = jp_lobster_2d  + jp_pisces_2d  !:
+   INTEGER, PARAMETER ::   jp_lc_3d   = jp_lobster_3d  + jp_pisces_3d  !:
+   INTEGER, PARAMETER ::   jp_lc_trd  = jp_lobster_trd + jp_pisces_trd !:
+   
+#if defined key_cfc
+   !!---------------------------------------------------------------------
+   !!   'key_cfc'   :                                          CFC tracers
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC
+   
+   ! assign an index in trc arrays for each CFC prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11 
+   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12   
+#else
+   !!---------------------------------------------------------------------
+   !!   Default     :                                       No CFC tracers
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .FALSE.     !: CFC flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  0          !: No CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  0          !: No CFC additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: No CFC additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC
+#endif
+
+   ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers
+
+   !!======================================================================
+END MODULE par_cfc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90	(revision 3437)
@@ -0,0 +1,158 @@
+MODULE trcini_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcini_cfc  ***
+   !! TOP :   initialisation of the CFC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) 
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_cfc      : CFC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_cfc      ! CFC sms trends
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module
+
+   CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ???
+
+   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
+      !!----------------------------------------------------------------------
+
+      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 of formatted file cfc1112atm'
+      
+      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,2), 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,*) 'Initialization de 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,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2)
+        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   p11HN    p11HS    p12HN    p12HS '
+         DO jn = 30, jpyear
+            WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2)
+         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
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                         No CFC tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_cfc             ! Empty routine
+   END SUBROUTINE trc_ini_cfc
+#endif
+
+   !!======================================================================
+END MODULE trcini_cfc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90	(revision 3437)
@@ -0,0 +1,116 @@
+MODULE trcnam_cfc
+   !!======================================================================
+   !!                         ***  MODULE trcnam_cfc  ***
+   !! TOP :   initialisation of some run parameters for CFC chemical model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_nam_cfc      : CFC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_cfc      ! CFC specific variable
+   USE iom             ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_cfc   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_cfc
+      !!-------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_cfc  ***
+      !!                 
+      !! ** Purpose :   Definition some run parameter for CFC model
+      !!
+      !! ** Method  :   Read the namcfc namelist and check the parameter 
+      !!       values called at the first timestep (nittrc000)
+      !!
+      !! ** input   :   Namelist namcfc
+      !!----------------------------------------------------------------------
+      INTEGER ::  numnatc
+      INTEGER :: jl, jn
+      TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d
+      !!
+      NAMELIST/namcfcdate/ ndate_beg, nyear_res
+      NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics
+      !!-------------------------------------------------------------------
+
+      ndate_beg = 300101            ! default namelist value
+      nyear_res = 1950
+
+      !                             ! Open namelist file
+      CALL ctl_opn( numnatc, 'namelist_cfc', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+         
+      READ( numnatc , namcfcdate )     ! read namelist
+
+      IF(lwp) THEN                  ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model'
+         WRITE(numout,*) ' ~~~~~~~'
+         WRITE(numout,*) '    initial calendar date (aammjj) for CFC  ndate_beg = ', ndate_beg
+         WRITE(numout,*) '    restoring time constant (year)          nyear_res = ', nyear_res
+      ENDIF
+      nyear_beg = ndate_beg / 10000
+      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg
+      !
+
+      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
+         !
+         ! Namelist namcfcdia
+         ! -------------------
+         DO jl = 1, jp_cfc_2d
+            WRITE(cfcdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name
+            WRITE(cfcdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            cfcdia2d(jl)%units = ' '                                       ! units
+         END DO
+
+         REWIND( numnatc )               ! read natrtd
+         READ  ( numnatc, namcfcdia )
+
+         DO jl = 1, jp_cfc_2d
+            jn = jp_cfc0_2d + jl - 1
+            ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname )
+            ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname )
+            ctrc2u(jn) = TRIM( cfcdia2d(jl)%units )
+         END DO
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : natadd'
+            DO jl = 1, jp_cfc_2d
+               jn = jp_cfc0_2d + jl - 1
+               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
+                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+         !
+      ENDIF
+
+   END SUBROUTINE trc_nam_cfc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                                No CFC
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_cfc                      ! Empty routine
+   END  SUBROUTINE  trc_nam_cfc
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_cfc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90	(revision 3437)
@@ -0,0 +1,90 @@
+MODULE trcrst_cfc
+   !!======================================================================
+   !!                       ***  MODULE trcrst_cfc  ***
+   !! TOP :   create, write, read the restart files of CFC tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_cfc   : read  restart file
+   !!   trc_rst_wri_cfc    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_cfc          ! CFC sms trends
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_cfc   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_cfc   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_cfc( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_cfc  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from CFC model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      INTEGER              :: jn    ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_cfc : Read specific variables from CFC model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      
+      DO jn = jp_cfc0, jp_cfc1
+         CALL iom_get( knum, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
+      END DO
+
+   END SUBROUTINE trc_rst_read_cfc
+
+   SUBROUTINE trc_rst_wri_cfc( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_cfc  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from CFC model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      INTEGER              :: jn      ! dummy loop indices
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_cfc : Write specific variables from CFC model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      DO jn = jp_cfc0, jp_cfc1
+         CALL iom_rstput( kt, kitrst, knum, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )
+      END DO
+
+   END SUBROUTINE trc_rst_wri_cfc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_cfc( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_wri_cfc: You should not have seen this print! error?', knum
+   END SUBROUTINE trc_rst_read_cfc
+
+   SUBROUTINE trc_rst_wri_cfc( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_cfc: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_cfc
+#endif
+
+   !!======================================================================
+END MODULE trcrst_cfc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90	(revision 3437)
@@ -0,0 +1,273 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_cfc
+   !!----------------------------------------------------------------------
+   !!   'key_cfc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends
+   !!   trc_cfc_cst  :  sets constants for CFC surface forcing computation
+   !!----------------------------------------------------------------------
+   USE oce_trc       ! Ocean variables
+   USE par_trc       ! TOP parameters
+   USE trc           ! TOP variables
+   USE trdmod_oce
+   USE trdmod_trc
+   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 CFC1112 file
+   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 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(:,:)   ::   patm     ! atmospheric function
+
+   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm]
+   REAL(wp), DIMENSION(3,2) ::   sob   !    "               "
+   REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius
+      
+   !                          ! 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 
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_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, 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 trc_cfc_cst
+
+      ! 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) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  &
+               &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 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
+               zt1  = tsn(ji,jj,1,jp_tem)
+               zt2  = zt1 * zt1 
+               zt3  = zt1 * zt2
+               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3
+
+               !    speed transfert : formulae of wanninkhof 1992
+               zv2     = wndm(ji,jj) * wndm(ji,jj)
+               zsch    = zsch / 660.
+               zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1)
+
+               ! 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 )   &
+#if defined key_degrad
+                  &                         * facvol(ji,jj,1)                           &
+#endif
+                  &                         * 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) / fse3t(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( ln_diatrc ) THEN
+        !
+        IF( lk_iomput ) THEN
+           CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) )
+           CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) )
+        ELSE
+           trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1)
+           trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1)
+        END IF
+        !
+      END IF
+ 
+      IF( l_trdtrc ) THEN
+          DO jn = jp_cfc0, jp_cfc1
+            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends
+          END DO
+      END IF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc')
+      !
+   END SUBROUTINE trc_sms_cfc
+
+
+   SUBROUTINE trc_cfc_cst
+      !!---------------------------------------------------------------------
+      !!                     ***  trc_cfc_cst  ***  
+      !!
+      !! ** Purpose : sets constants for CFC model
+      !!---------------------------------------------------------------------
+
+      ! coefficient for CFC11 
+      !----------------------
+
+      ! Solubility
+      soa(1,1) = -229.9261 
+      soa(2,1) =  319.6552
+      soa(3,1) =  119.4471
+      soa(4,1) =  -1.39165
+
+      sob(1,1) =  -0.142382
+      sob(2,1) =   0.091459
+      sob(3,1) =  -0.0157274
+
+      ! Schmidt number 
+      sca(1,1) = 3501.8
+      sca(2,1) = -210.31
+      sca(3,1) =  6.1851
+      sca(4,1) = -0.07513
+
+      ! coefficient for CFC12 
+      !----------------------
+
+      ! Solubility
+      soa(1,2) = -218.0971
+      soa(2,2) =  298.9702
+      soa(3,2) =  113.8049
+      soa(4,2) =  -1.39165
+
+      sob(1,2) =  -0.143566
+      sob(2,2) =   0.091015
+      sob(3,2) =  -0.0153924
+
+      ! schmidt number 
+      sca(1,2) =  3845.4 
+      sca(2,2) =  -228.95
+      sca(3,2) =  6.1908 
+      sca(4,2) =  -0.067430
+
+   END SUBROUTINE trc_cfc_cst
+
+
+   INTEGER FUNCTION trc_sms_cfc_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_cfc_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( xphem   (jpi,jpj)        ,     &
+         &      qtr_cfc (jpi,jpj,jp_cfc) ,     &
+         &      qint_cfc(jpi,jpj,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
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                         No CFC tracers
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_cfc( kt )       ! Empty routine
+      WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_cfc
+#endif
+
+   !!======================================================================
+END MODULE trcsms_cfc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90	(revision 3437)
@@ -0,0 +1,59 @@
+MODULE par_lobster
+   !!======================================================================
+   !!                        ***  par_lobster  ***
+   !! TOP :   set the LOBSTER 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
+
+#if defined key_lobster
+   !!---------------------------------------------------------------------
+   !!   'key_lobster'   :                                LOBSTER bio-model
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_lobster     = .TRUE.    !: LOBSTER flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster     =  6        !: number of LOBSTER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_trd = 17       !: number of sms trends for LOBSTER
+
+   ! assign an index in trc arrays for each LOBSTER prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_det     =  1        !: detritus                    [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_zoo     =  2        !: zooplancton concentration   [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_phy     =  3        !: phytoplancton concentration [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_no3     =  4        !: nitrate concentration       [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_nh4     =  5        !: ammonium concentration      [mmoleN/m3]
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob_dom     =  6        !: dissolved organic matter    [mmoleN/m3]
+
+   ! productive layer depth
+   INTEGER, PUBLIC, PARAMETER ::   jpkb           = 12        !: first vertical layers where biology is active
+   INTEGER, PUBLIC, PARAMETER ::   jpkbm1         = jpkb - 1  !: first vertical layers where biology is active
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                                           No LOBSTER model
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_lobster     = .FALSE.   !: LOBSTER flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster     =  0        !: No LOBSTER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  =  0        !: No LOBSTER additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  0        !: No LOBSTER additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_trd =  0        !: number of sms trends for LOBSTER
+#endif
+
+   ! Starting/ending LOBSTER do-loop indices (N.B. no LOBSTER : jpl_lob < jpf_lob the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob0     =          1       !: First index of LOBSTER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob1     = jp_lobster       !: Last  index of LOBSTER tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob0_2d  =          1       !: First index of LOBSTER 2D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob1_2d  = jp_lobster_2d    !: Last  index of LOBSTER 2D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob0_3d  =          1       !: First index of LOBSTER 3D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob1_3d  = jp_lobster_3d    !: Last  index of LOBSTER 3D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob0_trd =          1       !: First index of LOBSTER bio. diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_lob1_trd = jp_lobster_trd   !: Last  index of LOBSTER bio. diag
+
+   !!======================================================================
+END MODULE par_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90	(revision 3437)
@@ -0,0 +1,140 @@
+MODULE sms_lobster 
+   !!----------------------------------------------------------------------
+   !!                     ***  sms_lobster.F90  ***  
+   !! TOP :   LOBSTER 1 Source Minus Sink variables
+   !!----------------------------------------------------------------------
+   !! History :  OPA  !  1999-09  (M. Levy)  original code
+   !!             -   !  2000-12  (O. Aumont, E. Kestenare) add sediment 
+   !!   NEMO     1.0  !  2005-10  (C. Ethe) F90
+   !!             -   !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod
+   !!             -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca
+   !!            2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                         LOBSTER model
+   !!----------------------------------------------------------------------
+   USE par_oce    ! ocean parameters
+   USE par_trc    ! passive tracer parameters
+   USE lib_mpp    ! MPP library
+
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   sms_lobster_alloc   ! called in trcini_lobster.F90
+
+   !!  biological parameters
+   !! ----------------------
+   REAL(wp) ::   apmin    !: minimum phytoplancton concentration              (NAMELIST)
+   REAL(wp) ::   azmin    !: minimum zooplancton concentration                (NAMELIST)
+   REAL(wp) ::   anmin    !: minimum nutrients concentration                  (NAMELIST)
+   REAL(wp) ::   admin    !: minimum detritus concentration                   (NAMELIST)
+   REAL(wp) ::   redf     !: redfield ratio c:n                               (NAMELIST)
+   REAL(wp) ::   reddom   !: redfield ratio c:n for DOM                       
+   REAL(wp) ::   slopet   !: van t hoff coefficient                           (NAMELIST)
+   REAL(wp) ::   toptp    !: optimal photosynthesis temperature               (NAMELIST) 
+   REAL(wp) ::   aknut    !: half-saturation nutrient                         (NAMELIST)
+   REAL(wp) ::   psinut   !: inhibition of nitrate uptake by ammonium         (NAMELIST)
+   REAL(wp) ::   akno3    !: half-saturation for nitrate                      (NAMELIST)
+   REAL(wp) ::   aknh4    !: half-saturation for ammonium                     (NAMELIST)
+   REAL(wp) ::   rcchl    !: ???                                              
+   REAL(wp) ::   rgamma   !: phytoplankton exudation fraction                 (NAMELIST)
+   REAL(wp) ::   toptgz   !: optimal temperature for zooplankton growth       (NAMELIST)
+   REAL(wp) ::   tmaxgz   !: maximal temperature for zooplankton growth       (NAMELIST) 
+   REAL(wp) ::   rgz      !: widtht of zooplankton temperature FUNCTION       (NAMELIST)
+   REAL(wp) ::   rppz     !: zooplankton nominal preference for phytoplancton food (NAMELIST)
+   REAL(wp) ::   taus     !: maximum specific zooplankton grazing rate        (NAMELIST)
+   REAL(wp) ::   aks      !: half saturation constant for total zooplankton grazing (NAMELIST)
+   REAL(wp) ::   filmax   !: maximum mass clearance rate for zooplankton      (NAMELIST)
+   REAL(wp) ::   rpnaz    !: non-assimilated phytoplankton by zooplancton     (NAMELIST)
+   REAL(wp) ::   rdnaz    !: non-assimilated detritus by zooplankton          (NAMELIST) 
+   REAL(wp) ::   eggzoo   !: minimum for zooplankton concentration            (NAMELIST)
+   REAL(wp) ::   tauzn    !: zooplancton specific excretion rate              (NAMELIST)
+   REAL(wp) ::   tmmaxp   !: maximal phytoplancton mortality rate             (NAMELIST)
+   REAL(wp) ::   tmminp   !: minimal phytoplancton mortality rate             (NAMELIST)
+   REAL(wp) ::   tmmaxz   !: maximal zooplankton mortality rate               (NAMELIST)
+   REAL(wp) ::   tmminz   !: minimal zooplankton mortality rate               (NAMELIST)
+   REAL(wp) ::   anumin   !: nutrient threshold for phytoplankton mortality   (NAMELIST)
+   REAL(wp) ::   afdmin   !: food threshold for zooplankton mortality         (NAMELIST)
+   REAL(wp) ::   taudn    !: detrital breakdown rate                          (NAMELIST)
+   REAL(wp) ::   vsed     !: sedimentation speed                              (NAMELIST)
+   REAL(wp) ::   tmumax   !: maximal phytoplankton growth rate                (NAMELIST)
+   REAL(wp) ::   aki      !: light photosynthesis half saturation constant    (NAMELIST)
+   REAL(wp) ::   tmaxr    !: maximum coefficient for passive tracer damping   (NAMELIST)
+   REAL(wp) ::   tminr    !: minimum coefficient for passive tracer damping   (NAMELIST)
+   REAL(wp) ::   fdoml    !: fraction of exsudation that goes to nh4 (should be labile dom)
+   REAL(wp) ::   taunn    !: nitrification rate
+   REAL(wp) ::   taudomn  !: slow remineralization rate of semi-labile dom to nh4
+   REAL(wp) ::   xhr      !: coeff for Martin's remineralistion profile
+   REAL(wp) ::   fphylab  !: NH4 fraction of phytoplankton excretion
+   REAL(wp) ::   fzoolab  !: NH4 fraction of zooplankton excretion
+   REAL(wp) ::   fdetlab  !: NH4 fraction of detritus dissolution
+   REAL(wp) ::   fdbod    !: zooplankton mortality fraction that goes to detritus
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   remdmp   !: depth dependant damping coefficient of passive tracers 
+   
+   !! Optical parameters                                
+   !! ------------------                                
+   REAL(wp) ::   xkr0     !: water coefficient absorption in red      (NAMELIST)
+   REAL(wp) ::   xkg0     !: water coefficient absorption in green    (NAMELIST)
+   REAL(wp) ::   xkrp     !: pigment coefficient absorption in red    (NAMELIST)
+   REAL(wp) ::   xkgp     !: pigment coefficient absorption in green  (NAMELIST)
+   REAL(wp) ::   xlr      !: exposant for pigment absorption in red   (NAMELIST)
+   REAL(wp) ::   xlg      !: exposant for pigment absorption in green (NAMELIST)
+   REAL(wp) ::   rpig     !: chla/chla+phea ratio                     (NAMELIST)
+                                                        
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln   !: number of levels in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze    !: euphotic layer depth
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar   !: par (photosynthetic available radiation)
+
+   !! Sediment parameters                               
+   !! -------------------                               
+   REAL(wp) ::   sedlam       !: time coefficient of POC remineralization in sediments
+   REAL(wp) ::   sedlostpoc   !: ???
+   REAL(wp) ::   areacot      !: ???
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpoca   !: mass of POC in sediments
+                                                        
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fbod      !: rapid sinking particles
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cmask     !: ???
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION sms_lobster_alloc()
+      !!----------------------------------------------------------------------
+      !!        *** ROUTINE sms_lobster_alloc ***
+      !!----------------------------------------------------------------------
+      !
+      ALLOCATE(                                                                   &
+         !*  Biological parameters
+         &      remdmp(jpk,jp_lobster)                                      ,     &
+         !*  Optical parameters
+         &      neln   (jpi,jpj) , xze    (jpi,jpj)     , xpar(jpi,jpj,jpk) ,     &
+         !*  Sediment parameters
+         &      dminl  (jpi,jpj) , dmin3  (jpi,jpj,jpk)                     ,     &
+         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj)     , sedpoca(jpi,jpj)  ,     &
+         &      fbod   (jpi,jpj) , cmask  (jpi,jpj)                         , STAT=sms_lobster_alloc ) 
+         !
+      IF( lk_mpp                 )   CALL mpp_sum ( sms_lobster_alloc )
+      IF( sms_lobster_alloc /= 0 )   CALL ctl_warn('sms_lobster_alloc: failed to allocate arrays')
+      !
+   END FUNCTION sms_lobster_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     NO LOBSTER model 
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE sms_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90	(revision 3437)
@@ -0,0 +1,460 @@
+MODULE trcbio
+   !!======================================================================
+   !!                         ***  MODULE trcbio  ***
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                     LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_bio        :  
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc             ! 
+   USE sms_lobster     ! 
+   USE lbclnk          ! 
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdmod_oce
+   USE trdmod_trc
+   USE iom
+   
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_bio    ! called in ???
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_bio( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_bio  ***
+      !!
+      !! ** Purpose :   compute the now trend due to biogeochemical processes
+      !!              and add it to the general trend of passive tracers equations
+      !!
+      !! ** Method  :   each now biological flux is calculated in function of now
+      !!              concentrations of tracers.
+      !!              depending on the tracer, these fluxes are sources or sinks.
+      !!              the total of the sources and sinks for each tracer
+      !!              is added to the general trend.
+      !!        
+      !!                      tra = tra + zf...tra - zftra...
+      !!                                     |         |
+      !!                                     |         |
+      !!                                  source      sink
+      !!        
+      !!              IF 'key_diabio' defined , the biogeochemical trends
+      !!              for passive tracers are saved for futher diagnostics.
+      !!---------------------------------------------------------------------
+      !!
+      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('trc_bio')
+      !
+      IF( ln_diatrc ) 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,*) ' trc_bio: LOBSTER bio-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      ENDIF
+
+      fbod(:,:) = 0.e0
+      IF( ln_diatrc ) 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,jp_lob_det) )
+               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) )
+               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) )
+               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) )
+               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) )
+               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) )
+
+               ! Limitations
+               zlt   = 1.
+               zle   = 1. - EXP( -xpar(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 fbod is redistributed below level jpkbio
+               zzoobod = tmminz * zzoo * zzoo
+               fbod(ji,jj) = fbod(ji,jj) + (1-fdbod) * zzoobod * fse3t(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,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta
+               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa
+               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a
+               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a
+               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma
+
+
+               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
+                  trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy
+                  trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy
+                  trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4
+                  trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom
+                  trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo
+                  trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet
+                  trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo
+                  !  trend number 8 in trcsed
+                  trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet
+                  trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod
+                  trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom
+                  trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3
+                  trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom
+                  !  trend number 17 in trcexp
+                ENDIF
+                IF( ln_diatrc ) THEN
+                  ! convert fluxes in per day
+                  ze3t = fse3t(ji,jj,jk) * 86400.
+                  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,jp_lob_det) )
+               zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) )
+               zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) )
+               zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) )
+               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) )
+               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) )
+
+               !    Limitations
+               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,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta
+               tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa
+               tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a
+               tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a
+               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma
+               !
+               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
+                  trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy
+                  trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy
+                  trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4
+                  trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom
+                  trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo
+                  trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet
+                  trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo
+                  !  trend number 8 in trcsed
+                  trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet
+                  trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod
+                  trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom
+                  trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3
+                  trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4
+                  trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom
+                  !  trend number 17 in trcexp 
+                ENDIF
+                IF( ln_diatrc ) THEN
+                  ! convert fluxes in per day
+                  ze3t = fse3t(ji,jj,jk) * 86400.
+                  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
+
+      IF( ln_diatrc ) 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
+         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) )
+            !
+         ELSE
+            !
+            trc2d(:,:,jp_lob0_2d    ) = zw2d(:,:,1) 
+            trc2d(:,:,jp_lob0_2d + 1) = zw2d(:,:,2) 
+            trc2d(:,:,jp_lob0_2d + 2) = zw2d(:,:,3) 
+            trc2d(:,:,jp_lob0_2d + 3) = zw2d(:,:,4) 
+            trc2d(:,:,jp_lob0_2d + 4) = zw2d(:,:,5) 
+            trc2d(:,:,jp_lob0_2d + 5) = zw2d(:,:,6) 
+            trc2d(:,:,jp_lob0_2d + 6) = zw2d(:,:,7) 
+                     ! trend number 8 is in trcsed.F
+            trc2d(:,:,jp_lob0_2d +  8) = zw2d(:,:,8) 
+            trc2d(:,:,jp_lob0_2d +  9) = zw2d(:,:,9) 
+            trc2d(:,:,jp_lob0_2d + 10) = zw2d(:,:,10) 
+            trc2d(:,:,jp_lob0_2d + 11) = zw2d(:,:,11) 
+            trc2d(:,:,jp_lob0_2d + 12) = zw2d(:,:,12) 
+            trc2d(:,:,jp_lob0_2d + 13) = zw2d(:,:,13) 
+            trc2d(:,:,jp_lob0_2d + 14) = zw2d(:,:,14) 
+            trc2d(:,:,jp_lob0_2d + 15) = zw2d(:,:,15) 
+            trc2d(:,:,jp_lob0_2d + 16) = zw2d(:,:,16) 
+            trc2d(:,:,jp_lob0_2d + 17) = zw2d(:,:,17) 
+            ! trend number 19 is in trcexp.F
+            trc3d(:,:,:,jp_lob0_3d    ) = zw3d(:,:,:,1) 
+            trc3d(:,:,:,jp_lob0_3d + 1) = zw3d(:,:,:,2) 
+            trc3d(:,:,:,jp_lob0_3d + 2) = zw3d(:,:,:,3) 
+         ENDIF
+        !
+      ENDIF
+
+      IF( ln_diabio .AND. .NOT. lk_iomput )  THEN
+         DO jl = jp_lob0_trd, jp_lob1_trd
+            CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. )
+         END DO 
+      ENDIF
+      !
+      IF( l_trdtrc ) THEN
+         DO jl = jp_lob0_trd, jp_lob1_trd
+            CALL trd_mod_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend
+         END DO
+      ENDIF
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bio')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( ln_diatrc ) THEN
+         CALL wrk_dealloc( jpi, jpj,     17, zw2d )
+         CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_bio')
+      !
+   END SUBROUTINE trc_bio
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_bio( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_bio: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_bio
+#endif 
+
+   !!======================================================================
+END MODULE  trcbio
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90	(revision 3437)
@@ -0,0 +1,176 @@
+MODULE trcexp
+   !!======================================================================
+   !!                         ***  MODULE p4sed  ***
+   !! TOP :   PISCES 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
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                     LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_exp        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE sms_lobster
+   USE lbclnk
+   USE trc
+   USE trcnam_trp
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdmod_oce
+   USE trdmod_trc
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_exp    ! called in p4zprg.F90
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_exp( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_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, ierr
+      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrbio
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_exp')
+      !
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      ENDIF
+
+      IF( l_trdtrc )  THEN
+         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'trc_exp: unable to allocate ztrbio array' )   ;   RETURN
+         ENDIF
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3)
+      ENDIF
+
+      ! 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_lobster.F90
+      ! ----------------------------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 2, jpjm1
+            DO ji = fs_2, fs_jpim1
+               ze3t = 1. / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj)
+            END DO
+         END DO
+      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,jp_lob_no3) = tra(ji,jj,ikt,jp_lob_no3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikt) 
+            ! Deposition of organic matter in the sediment
+            zwork = vsed * trn(ji,jj,ikt,jp_lob_det)
+            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(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,jp_lob_no3) = tra(ji,jj,1,jp_lob_no3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1)
+         END DO
+      END DO
+
+      CALL lbc_lnk( sedpocn, 'T', 1. )
+ 
+      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example
+      IF( ln_diatrc ) THEN
+         IF( lk_iomput ) THEN   ;   CALL iom_put( "SEDPOC" , sedpocn )
+         ELSE                   ;   trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:)
+         ENDIF
+      ENDIF
+
+      
+      ! Time filter and swap of arrays
+      ! ------------------------------
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step
+        !                                             ! (only swap)
+        sedpocn(:,:) = sedpoca(:,:)
+        !                                              
+      ELSE
+        !
+        DO jj = 1, jpj
+           DO ji = 1, jpi
+              zsedpocd = sedpoca(ji,jj) - 2. * sedpocn(ji,jj) + sedpocb(ji,jj)      ! time laplacian on tracers
+              sedpocb(ji,jj) = sedpocn(ji,jj) + atfp * zsedpocd                     ! sedpocb <-- filtered sedpocn
+              sedpocn(ji,jj) = sedpoca(ji,jj)                                       ! sedpocn <-- sedpoca
+           END DO
+        END DO
+        ! 
+      ENDIF
+      sedpoca(:,:) = 0.e0
+      !
+      IF( l_trdtrc ) THEN
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) - ztrbio(:,:,:)
+         jl = jp_lob0_trd + 16
+         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
+         DEALLOCATE( ztrbio ) 
+      ENDIF
+
+      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('trc_exp')
+      !
+   END SUBROUTINE trc_exp
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_exp( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_exp
+#endif 
+
+   !!======================================================================
+END MODULE  trcexp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90	(revision 3437)
@@ -0,0 +1,272 @@
+MODULE trcini_lobster
+   !!======================================================================
+   !!                         ***  MODULE trcini_lobster  ***
+   !! TOP :   initialisation of the LOBSTER biological model
+   !!======================================================================
+   !! History :   OPA  !  1999-09  (M. Levy) Original code
+   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment 
+   !!   NEMO      1.0  !  2004-03  (C. Ethe) Modularity
+   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.lobster1.h90
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                     LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !! trc_ini_lobster  : LOBSTER model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE sms_lobster     ! Source Minus Sink variables
+   USE oce_trc         ! ocean variables
+   USE trc
+   USE lbclnk 
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_lobster   ! called by trcini.F90 module
+
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_lobster
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE trc_ini_lobster  ***
+      !! ** purpose :   specific initialisation for LOBSTER bio-model
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER  ::   ji, jj, jk, jn
+      REAL(wp) ::   ztest, zfluo, zfluu
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zrro
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdm0
+      !!---------------------------------------------------------------------
+
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zrro )
+      CALL wrk_alloc( jpi, jpj, jpk, zdm0 )
+
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_lobster :   LOBSTER biochemical model initialisation'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+
+      !                                ! Allocate LOBSTER arrays
+      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_lobster: unable to allocate LOBSTER arrays' )
+
+
+
+      ! initialization of fields for optical model
+      ! --------------------------------------------
+      xze (:,:)   = 5._wp
+      xpar(:,:,:) = 0._wp
+
+      ! initialization for passive tracer remineralisation-damping  array
+      ! -----------------------------------------------------------------
+
+      DO jn = jp_lob0, jp_lob1
+         remdmp(:,jn) = tminr
+      END DO
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trcini: compute remineralisation-damping arrays for tracers'
+      ENDIF
+
+      ! initialization of biological variables
+      ! ------------------------------------------
+
+      ! 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 = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr 
+               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(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 ji = 2, jpi-1
+         DO jj = 2, jpj-1
+            IF( tmask(ji,jj,1) == 1._wp ) THEN
+               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1)
+               IF( ztest == 0 )   cmask(ji,jj) = 1._wp
+            ENDIF
+         END DO
+      END DO
+
+      CALL lbc_lnk( cmask, 'T', 1. )
+
+      ! Coastal surface
+      ! ---------------
+      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) )
+
+      ! Initialization of tracer concentration in case of  no restart 
+      !-------------------------------------------------------------
+      IF( .NOT. ln_rsttr ) THEN    
+
+# if defined key_eel_r6 || defined key_eel_r2
+         ! LOBSTER initialisation for EEL
+         ! ----------------------
+         ! here: analytical initialisation used in Levy et al. (2001)
+         
+         DO jk = 1, 7
+            trn(:,:,jk,jp_lob_det) = 0.016 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_zoo) = 0.018 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_phy) = 0.036 * tmask(:,:,jk) 
+            trn(:,:,jk,jp_lob_no3) = 1.e-5 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_nh4) = 5.e-4 * tmask(:,:,jk)
+            trn(:,:,jk,jp_lob_dom) = 0.017 * tmask(:,:,jk)
+         END DO
+         
+         trn(:,:, 8,jp_lob_det) = 0.020   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_zoo) = 0.027   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_phy) = 0.041   * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_no3) = 0.00022 * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_nh4) = 0.0033  * tmask(:,:, 8)
+         trn(:,:, 8,jp_lob_dom) = 0.021   * tmask(:,:, 8)
+         
+         trn(:,:, 9,jp_lob_det) = 0.0556  * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_zoo) = 0.123   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_phy) = 0.122   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_no3) = 0.028   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_nh4) = 0.024   * tmask(:,:, 9)
+         trn(:,:, 9,jp_lob_dom) = 0.06    * tmask(:,:, 9)
+         
+         trn(:,:,10,jp_lob_det) = 0.025   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_zoo) = 0.016   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_phy) = 0.029   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_no3) = 2.462   * tmask(:,:,10)
+         trn(:,:,10,jp_lob_nh4) = 0.04    * tmask(:,:,10)
+         trn(:,:,10,jp_lob_dom) = 0.022   * tmask(:,:,10)
+         
+         trn(:,:,11,jp_lob_det) = 0.0057  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_zoo) = 0.0005  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_phy) = 0.0006  * tmask(:,:,11)
+         trn(:,:,11,jp_lob_no3) = 3.336   * tmask(:,:,11)
+         trn(:,:,11,jp_lob_nh4) = 0.005   * tmask(:,:,11)
+         trn(:,:,11,jp_lob_dom) = 0.004   * tmask(:,:,11)
+         
+         trn(:,:,12,jp_lob_det) = 0.002   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_zoo) = 1.e-6   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_phy) = 5.e-6   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_no3) = 4.24    * tmask(:,:,12)
+         trn(:,:,12,jp_lob_nh4) = 0.001   * tmask(:,:,12)
+         trn(:,:,12,jp_lob_dom) = 3.e-5   * tmask(:,:,12)
+         
+         DO jk=13,jpk
+            trn(:,:,jk,jp_lob_det) = 0.e0
+            trn(:,:,jk,jp_lob_zoo) = 0.e0
+            trn(:,:,jk,jp_lob_phy) = 0.e0
+            trn(:,:,jk,jp_lob_nh4) = 0.e0
+            trn(:,:,jk,jp_lob_dom) = 0.e0
+         END DO
+         
+         trn(:,:,13,jp_lob_no3) = 5.31  * tmask(:,:,13)
+         trn(:,:,14,jp_lob_no3) = 6.73  * tmask(:,:,14)
+         trn(:,:,15,jp_lob_no3) = 8.32  * tmask(:,:,15)
+         trn(:,:,16,jp_lob_no3) = 10.13 * tmask(:,:,16)
+         trn(:,:,17,jp_lob_no3) = 11.95 * tmask(:,:,17)
+         trn(:,:,18,jp_lob_no3) = 13.57 * tmask(:,:,18)
+         trn(:,:,19,jp_lob_no3) = 15.08 * tmask(:,:,19)
+         trn(:,:,20,jp_lob_no3) = 16.41 * tmask(:,:,20)
+         trn(:,:,21,jp_lob_no3) = 17.47 * tmask(:,:,21)
+         trn(:,:,22,jp_lob_no3) = 18.29 * tmask(:,:,22)
+         trn(:,:,23,jp_lob_no3) = 18.88 * tmask(:,:,23)
+         trn(:,:,24,jp_lob_no3) = 19.30 * tmask(:,:,24)
+         trn(:,:,25,jp_lob_no3) = 19.68 * tmask(:,:,25)
+         trn(:,:,26,jp_lob_no3) = 19.91 * tmask(:,:,26)
+         trn(:,:,27,jp_lob_no3) = 19.99 * tmask(:,:,27)
+         trn(:,:,28,jp_lob_no3) = 20.01 * tmask(:,:,28)
+         trn(:,:,29,jp_lob_no3) = 20.01 * tmask(:,:,29)
+         trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30)
+
+
+# elif defined key_gyre || defined key_orca_r2
+         ! LOBSTER initialisation for GYRE
+         ! ----------------------
+         ! here:  init NO3=f(density) by asklod AS Kremeur 2005-07
+         trn(:,:,:,jp_lob_det) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_zoo) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_nh4) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_phy) = 0.1 * tmask(:,:,:)
+         trn(:,:,:,jp_lob_dom) = 1.0 * tmask(:,:,:)
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN
+                     trn(ji,jj,jk,jp_lob_no3) = 2. * tmask(ji,jj,jk)
+                  ELSE
+                     trn(ji,jj,jk,jp_lob_no3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk)
+                  ENDIF
+               END DO
+            END DO
+         END DO
+#endif
+
+      ENDIF
+
+      !  initialize the POC in sediments
+      sedpocb(:,:) = 0._wp
+      sedpocn(:,:) = 0._wp
+      sedpoca(:,:) = 0._wp
+      !
+      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done'
+      !
+      CALL wrk_dealloc( jpi, jpj,      zrro )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdm0 )
+      !
+   END SUBROUTINE trc_ini_lobster
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                   No LOBSTER bio-model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_lobster             ! Empty routine
+   END SUBROUTINE trc_ini_lobster
+#endif
+
+   !!======================================================================
+END MODULE trcini_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90	(revision 3437)
@@ -0,0 +1,361 @@
+MODULE trcnam_lobster
+   !!======================================================================
+   !!                      ***  MODULE trcnam_lobster  ***
+   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.lobster1.h90
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'   :                                 LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !! trc_nam_lobster   : LOBSTER model namelist read
+   !!----------------------------------------------------------------------
+   USE oce_trc                                   ! Ocean variables
+   USE par_trc                                   ! TOP parameters
+   USE trc                                       ! TOP variables
+   USE trdmod_trc_oce , ONLY :  lk_trdmld_trc    !  tracers  trend flag
+   USE sms_lobster                               ! sms trends
+   USE iom                                       ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_lobster   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_lobster
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_lobster  ***  
+      !!
+      !! ** Purpose :   read LOBSTER namelist
+      !!
+      !! ** input   :   file 'namelist.trc.sms' containing the following
+      !!             namelist: natbio, natopt, and natdbi ("key_diabio")
+      !!----------------------------------------------------------------------
+      INTEGER ::   numnatl
+      !!
+      INTEGER :: jl, jn
+      TYPE(DIAG), DIMENSION(jp_lobster_2d )  :: lobdia2d
+      TYPE(DIAG), DIMENSION(jp_lobster_3d )  :: lobdia3d
+      TYPE(DIAG), DIMENSION(jp_lobster_trd)  :: lobdiabio
+
+      NAMELIST/namlobphy/ apmin, tmumax, rgamma, fphylab, tmmaxp, tmminp, &
+         &                rcchl, aki, toptp 
+      NAMELIST/namlobnut/ anmin, akno3, aknh4, taunn, psinut
+      NAMELIST/namlobzoo/ azmin, eggzoo, rgz, rppz, taus, aks, rpnaz,     &
+         &                rdnaz, tauzn, fzoolab, fdbod, tmmaxz, tmminz
+      NAMELIST/namlobdet/ admin, taudn, fdetlab, vsed
+      NAMELIST/namlobdom/ taudomn
+      NAMELIST/namlobsed/ sedlam, sedlostpoc
+      NAMELIST/namlobrat/ redf, reddom, slopet, tmaxr, tminr, xhr,        &
+         &                filmax, toptgz, tmaxgz, anumin, afdmin
+
+      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
+      NAMELIST/namlobdia/ lobdia3d, lobdia2d     ! additional diagnostics
+      NAMELIST/namlobdbi/ lobdiabio
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_lobster : read LOBSTER namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+
+      !                               ! Open the namelist file
+      !                               ! ----------------------
+      CALL ctl_opn( numnatl, 'namelist_lobster', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+
+      ! namlobphy : parameters for phytoplankton
+      apmin   = 0. 
+      tmumax  = 0. 
+      rgamma  = 0. 
+      fphylab = 0.  
+      tmmaxp  = 0.
+      tmminp  = 0.
+      rcchl   = 0. 
+      aki     = 0. 
+      toptp   = 0. 
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobphy )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobphy'
+          WRITE(numout,*) '    minimum phytoplancton concentration                  apmin     =', apmin
+          WRITE(numout,*) '    phyto max growth rate                                tmumax    =', 86400 * tmumax, ' d'
+          WRITE(numout,*) '    phytoplankton exudation fraction                     rgamma    =', rgamma
+          WRITE(numout,*) '    NH4 fraction of phytoplankton exsudation             fphylab   =', fphylab
+          WRITE(numout,*) '    maximal phyto mortality rate                         tmmaxp    =', 86400 * tmmaxp
+          WRITE(numout,*) '    minimal phyto mortality rate                         tmminp    =', 86400 * tmminp
+          WRITE(numout,*) '    carbone/chlorophyl ratio                             rcchl     =', rcchl
+          WRITE(numout,*) '    light hlaf saturation constant                       aki       =', aki
+          WRITE(numout,*) '    optimal photosynthesis temperature                   toptp     =', toptp
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobnut : parameters for nutrients
+      anmin  = 0.
+      psinut = 0.
+      akno3  = 0.
+      aknh4  = 0.
+      taunn  = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobnut )
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobnut'
+          WRITE(numout,*) '    minimum nutrients     concentration                  anmin     =', anmin
+          WRITE(numout,*) '    half-saturation nutrient for no3 uptake              akno3     =', akno3
+          WRITE(numout,*) '    half-saturation nutrient for nh4 uptake              aknh4     =', aknh4
+          WRITE(numout,*) '    nitrification rate                                   taunn     =', taunn
+          WRITE(numout,*) '    inhibition of no3 uptake by nh4                      psinut    =', psinut
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobzoo : parameters for zooplankton
+      azmin   = 0.
+      rgz     = 0.
+      rppz    = 0.
+      taus    = 0.
+      aks     = 0.
+      rpnaz   = 0.
+      rdnaz   = 0.
+      eggzoo  = 0.
+      tauzn   = 0.
+      tmmaxz  = 0.
+      tmminz  = 0.
+      fzoolab = 0.
+      fdbod   = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobzoo )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobzoo'
+          WRITE(numout,*) '    minimum zooplancton   concentration                  azmin     =', azmin
+          WRITE(numout,*) '    minimum  for zoo concentration                       eggzoo    =', eggzoo
+          WRITE(numout,*) '    widtht of zoo temperature FUNCTION                   rgz       =', rgz
+          WRITE(numout,*) '    zoo preference for phyto                             rppz      =', rppz
+          WRITE(numout,*) '    maximal zoo grazing rate                             taus      =', 86400 * taus, ' d'
+          WRITE(numout,*) '    half saturation constant for zoo food                aks       =', aks
+          WRITE(numout,*) '    non-assimilated phyto by zoo                         rpnaz     =', rpnaz
+          WRITE(numout,*) '    non-assimilated detritus by zoo                      rdnaz     =', rdnaz
+          WRITE(numout,*) '    zoo specific excretion rate                          tauzn     =', 86400 * tauzn
+          WRITE(numout,*) '    maximal zoo mortality rate                           tmmaxz    =', 86400 * tmmaxz
+          WRITE(numout,*) '    minimal zoo mortality rate                           tmminz    =', 86400 * tmminz
+          WRITE(numout,*) '    NH4 fraction of zooplankton excretion                fzoolab   =', fzoolab
+          WRITE(numout,*) '    Zooplankton mortality fraction that goes to detritus fdbod     =', fdbod
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobdet : parameters for detritus
+      admin   = 0.
+      taudn   = 0.
+      vsed    = 0.
+      fdetlab = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobdet )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdet'
+          WRITE(numout,*) '    minimum detritus      concentration                  admin     =', admin
+          WRITE(numout,*) '    detrital breakdown rate                              taudn     =', 86400 * taudn , ' d'
+          WRITE(numout,*) '    detritus sedimentation speed                         vsed      =', 86400 * vsed  , ' d'
+          WRITE(numout,*) '    NH4 fraction of detritus dissolution                 fdetlab   =', fdetlab
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobdom : parameters for DOM
+      taudomn = 0.
+
+      REWIND( numnatl ) 
+      READ  ( numnatl, namlobdom )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobdom'
+          WRITE(numout,*) '    dom remineralisation rate                            taudomn   =', taudomn
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobsed : parameters from aphotic layers to sediment
+      sedlam     = 0.
+      sedlostpoc = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobsed )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobsed'
+          WRITE(numout,*) '    time coeff of POC in sediments                       sedlam    =', sedlam
+          WRITE(numout,*) '    Sediment geol loss for POC                           sedlostpoc=', sedlostpoc
+          WRITE(numout,*) ' '
+      ENDIF
+
+      ! namlobrat : general coefficient
+      redf   = 0.
+      reddom = 0.
+      slopet = 0.
+      tmaxr  = 1./(     4.*rday)*0.
+      tminr  = 1./(24.*30.*rday)*0.
+      xhr    = 0.
+      filmax = 0.
+      toptgz = 0.
+      tmaxgz = 0.
+      anumin = 0.
+      afdmin = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobrat )
+
+      IF(lwp) THEN
+          WRITE(numout,*) ' Namelist namlobrat'
+          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf 
+          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom 
+          WRITE(numout,*) '    van t hoff coefficient                               slopet    =', slopet
+          WRITE(numout,*) '    maximum damping for d z or p                         tmaxr     =', tmaxr
+          WRITE(numout,*) '    damping-remineralisation rate                        tminr     =', tminr
+          WRITE(numout,*) '    coeff for martin''s remineralistion                  xhr       =', xhr
+          WRITE(numout,*) '    maximal mass clearance rate for zoo                  filmax    =', filmax
+          WRITE(numout,*) '    optimal temperature for zoo growth                   toptgz    =', toptgz
+          WRITE(numout,*) '    maximal temperature for zoo growth                   tmaxgz    =', tmaxgz
+          WRITE(numout,*) '    nutrient threshold for phyto mort                    anumin    =', anumin
+          WRITE(numout,*) '    food threshold for zoo mort                          afdmin    =', afdmin
+          WRITE(numout,*) ' '
+      ENDIF
+
+
+      ! namlobopt : optical parameters
+      xkg0  = 0. 
+      xkr0  = 0.
+      xkgp  = 0.
+      xkrp  = 0.
+      xlg   = 0.
+      xlr   = 0.
+      rpig  = 0.
+
+      REWIND( numnatl )
+      READ  ( numnatl, namlobopt )
+
+      IF(lwp) THEN                         
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist namlobopt'
+         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
+         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
+         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
+         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
+         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
+         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
+         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
+         WRITE(numout,*) ' '
+      ENDIF
+
+      !
+      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
+         !
+         ! Namelist namlobdia
+         ! -------------------
+         DO jl = 1, jp_lobster_2d
+            WRITE(lobdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name
+            WRITE(lobdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            lobdia2d(jl)%units = ' '                                        ! units
+         END DO
+         !                                 ! 3D output arrays
+         DO jl = 1, jp_lobster_3d
+            WRITE(lobdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name
+            WRITE(lobdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            lobdia3d(jl)%units = ' '                                        ! units
+         END DO
+
+         REWIND( numnatl )               ! read natrtd
+         READ  ( numnatl, namlobdia )
+
+         DO jl = 1, jp_lobster_2d
+            jn = jp_lob0_2d + jl - 1
+            ctrc2d(jn) = lobdia2d(jl)%sname
+            ctrc2l(jn) = lobdia2d(jl)%lname
+            ctrc2u(jn) = lobdia2d(jl)%units
+         END DO
+
+         DO jl = 1, jp_lobster_3d
+            jn = jp_lob0_3d + jl - 1
+            ctrc3d(jn) = lobdia3d(jl)%sname
+            ctrc3l(jn) = lobdia3d(jl)%lname
+            ctrc3u(jn) = lobdia3d(jl)%units
+         END DO
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : natadd'
+            DO jl = 1, jp_lobster_3d
+               jn = jp_lob0_3d + jl - 1
+               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
+                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
+            END DO
+            WRITE(numout,*) ' '
+
+            DO jl = 1, jp_lobster_2d
+               jn = jp_lob0_2d + jl - 1
+               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
+                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+         !
+      ENDIF
+
+      IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmld_trc ) THEN
+         !
+         ! Namelist namlobdbi
+         ! -------------------
+         DO jl = 1, jp_lobster_trd
+            IF(     jl <  10 ) THEN   ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I1)') jl      ! short name
+            ELSEIF (jl < 100 ) THEN   ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I2)') jl  
+            ELSE                      ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I3)') jl
+            ENDIF
+            WRITE(lobdiabio(jl)%lname,'("BIOLOGICAL TREND NUMBER ",I2)') jl                 ! long name
+            lobdiabio(jl)%units = 'mmoleN/m3/s '                                            ! units
+         END DO
+
+         REWIND( numnatl )
+         READ  ( numnatl, namlobdbi ) 
+ 
+         DO jl = 1, jp_lobster_trd
+            jn = jp_lob0_trd + jl - 1
+            ctrbio(jl) = lobdiabio(jl)%sname
+            ctrbil(jl) = lobdiabio(jl)%lname
+            ctrbiu(jl) = lobdiabio(jl)%units
+         END DO
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : namlobdbi'
+            DO jl = 1, jp_lobster_trd
+               jn = jp_lob0_trd + jl - 1
+               WRITE(numout,*) '  biological trend No : ', jn, '    short name : ', ctrbio(jn), &
+                 &             '  long name  : ', ctrbio(jn), '   unit : ', ctrbio(jn)
+            END DO
+            WRITE(numout,*) ' '
+         END IF
+         !
+      END IF
+      !
+   END SUBROUTINE trc_nam_lobster
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                            No LOBSTER
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_lobster                      ! Empty routine
+   END  SUBROUTINE  trc_nam_lobster
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90	(revision 3437)
@@ -0,0 +1,156 @@
+MODULE trcopt
+   !!======================================================================
+   !!                         ***  MODULE trcopt  ***
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                     LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_opt        :   Compute the light availability in the water column
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_lobster
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_opt   ! called in trcprg.F90
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_opt( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_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  :   xpar   ???
+      !!                neln   ???
+      !!                xze    ???
+      !!---------------------------------------------------------------------
+      !!
+      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('trc_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,*) ' trc_opt : LOBSTER optic-model'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
+      ENDIF
+
+      !                                          ! surface irradiance
+      zpar0m (:,:)   = qsr   (:,:) * 0.43        ! ------------------
+      zpar100(:,:)   = zpar0m(:,:) * 0.01
+      xpar   (:,:,1) = zpar0m(:,:)
+      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,jp_lob_phy) ) * zcoef  )
+               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * fse3t(ji,jj,jk-1) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * fse3t(ji,jj,jk-1) )
+            END DO
+        END DO
+      END DO
+      DO jk = 1, jpkm1                                ! mean par at t-levels
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zpig = LOG(  MAX( TINY(0.), trn(ji,jj,jk,jp_lob_phy) ) * zcoef  )
+               zkr  = xkr0 + xkrp * EXP( xlr * zpig )
+               zkg  = xkg0 + xkgp * EXP( xlg * zpig )
+               zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkr * fse3t(ji,jj,jk) ) )
+               zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * fse3t(ji,jj,jk) ) * ( 1 - EXP( -zkg * fse3t(ji,jj,jk) ) )
+               xpar (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
+            END DO
+         END DO
+      END DO
+
+      !                                          ! Euphotic layer
+      !                                          ! --------------
+      neln(:,:) = 1                                   ! euphotic layer level
+      DO jk = 1, jpk                                  ! (i.e. 1rst T-level strictly below EL bottom)
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( xpar(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
+              !                                       ! nb. this is to ensure compatibility with
+              !                                       ! nmld_trc definition in trd_mld_trc_zint
+           END DO
+         END DO
+      END DO
+      !                                               ! Euphotic layer depth
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            xze(ji,jj) = fsdepw(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('trc_opt')
+      !
+   END SUBROUTINE trc_opt
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_opt( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_opt: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_opt
+#endif 
+
+   !!======================================================================
+END MODULE  trcopt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90	(revision 3437)
@@ -0,0 +1,87 @@
+MODULE trcrst_lobster
+   !!======================================================================
+   !!                       ***  MODULE trcrst_lobster  ***
+   !! TOP :   create, write, read the restart files of LOBSTER tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                               lobster tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_lobster   : read  restart file
+   !!   trc_rst_wri_lobster    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_lobster          ! lobster sms trends
+   USE sms_lobster          ! lobster sms trends
+   USE iom
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_lobster   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_lobster   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_lobster( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_lobster  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from lobster model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_lobster : Read specific variables from lobster model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) 
+      CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) 
+
+   END SUBROUTINE trc_rst_read_lobster
+
+   SUBROUTINE trc_rst_wri_lobster( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_lobster  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from lobster model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_lobster : Write specific variables from lobster model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) )
+
+   END SUBROUTINE trc_rst_wri_lobster
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_lobster( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_wri_lobster: You should not have seen this print! error?',knum
+   END SUBROUTINE trc_rst_read_lobster
+
+   SUBROUTINE trc_rst_wri_lobster( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_lobster: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_lobster
+#endif
+
+   !!======================================================================
+END MODULE trcrst_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90	(revision 3437)
@@ -0,0 +1,157 @@
+MODULE trcsed
+   !!======================================================================
+   !!                         ***  MODULE p4sed  ***
+   !! 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
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                     LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !!   trc_sed        :  Compute loss of organic matter in the sediments
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trc
+   USE sms_lobster
+   USE lbclnk
+   USE trdmod_oce
+   USE trdmod_trc
+   USE iom
+   USE prtctl_trc      ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sed    ! called in ???
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sed( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_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, ztrbio
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sed')
+      !
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation'
+         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
+      ENDIF
+
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra )
+
+      IF( ln_diatrc )  THEN
+         CALL wrk_alloc( jpi, jpj, zw2d )
+      ENDIF
+
+      IF( l_trdtrc ) THEN
+         CALL wrk_alloc( jpi, jpj, jpk, ztrbio )
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det)
+      ENDIF
+
+      ! sedimentation of detritus  : upstream scheme
+      ! --------------------------------------------
+
+      ! for detritus sedimentation only - jp_lob_det
+      zwork(:,:,1  ) = 0.e0      ! surface value set to zero
+      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero
+
+      ! 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,jp_lob_det)
+      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) ) / fse3t(ji,jj,jk)
+               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra(ji,jj,jk) 
+            END DO
+         END DO
+      END DO
+
+      IF( ln_diatrc ) THEN 
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zw2d(ji,jj) = zw2d(ji,jj) + ztra(ji,jj,jk) * fse3t(ji,jj,jk) * 86400.
+               END DO
+            END DO
+         END DO
+         IF( lk_iomput )  THEN
+           CALL iom_put( "TDETSED", zw2d )
+         ELSE
+           trc2d(:,:,jp_lob0_2d + 7) = zw2d(:,:)
+         ENDIF
+         CALL wrk_dealloc( jpi, jpj, zw2d )
+      ENDIF
+      !
+      IF( ln_diabio )  trbio(:,:,:,jp_lob0_trd + 7) = ztra(:,:,:)
+      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra )
+      !
+      IF( l_trdtrc ) THEN
+         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:)
+         jl = jp_lob0_trd + 7
+         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend
+         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )
+      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
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sed')
+      !
+   END SUBROUTINE trc_sed
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sed( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sed: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sed
+#endif 
+
+   !!======================================================================
+END MODULE  trcsed
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90	(revision 3437)
@@ -0,0 +1,84 @@
+MODULE trcsms_lobster
+   !!======================================================================
+   !!                         ***  MODULE trcsms_lobster  ***
+   !! TOP :   Time loop of LOBSTER model
+   !!======================================================================
+   !! History :   1.0  !            M. Levy
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_lobster
+   !!----------------------------------------------------------------------
+   !!   'key_lobster'                                       LOBSTER bio-model
+   !!----------------------------------------------------------------------
+   !!   trcsms_lobster        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   USE oce_trc          !
+   USE trc
+   USE trcbio
+   USE trcopt
+   USE trcsed
+   USE trcexp
+   USE trdmod_oce
+   USE trdmod_trc_oce
+   USE trdmod_trc
+   USE trdmld_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_lobster    ! called in trcsms.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_sms_lobster( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_lobster  ***
+      !!
+      !! ** 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('trc_sms_lobster')
+      !
+      CALL trc_opt( kt )      ! optical model
+      CALL trc_bio( kt )      ! biological model
+      CALL trc_sed( kt )      ! sedimentation model
+      CALL trc_exp( kt )      ! export
+
+      IF( l_trdtrc ) THEN
+         DO jn = jp_lob0, jp_lob1
+           CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends
+         END DO
+      END IF
+
+      IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_lobster')
+      !
+   END SUBROUTINE trc_sms_lobster
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                     No passive tracer
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sms_lobster( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_lobster: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_lobster
+#endif 
+
+   !!======================================================================
+END MODULE  trcsms_lobster
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90	(revision 3437)
@@ -0,0 +1,75 @@
+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)
+   !!----------------------------------------------------------------------
+   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER
+
+   USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES
+   USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES
+   USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES
+
+   USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_2d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_3d       !: number of tracers in CFC
+   USE par_cfc    , ONLY : jp_cfc_trd      !: number of tracers in CFC
+
+   USE par_c14b   , ONLY : jp_c14b         !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_2d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_3d      !: number of tracers in C14
+   USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER ::   jp_lm      = jp_lobster     + jp_pisces     + jp_cfc     + jp_c14b     !: 
+   INTEGER, PARAMETER ::   jp_lm_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !:
+   INTEGER, PARAMETER ::   jp_lm_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !:
+   INTEGER, PARAMETER ::   jp_lm_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !:
+
+#if defined key_my_trc
+   !!---------------------------------------------------------------------
+   !!   'key_my_trc'                     user defined tracers (MY_TRC)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .TRUE.   !: PTS flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  2       !: number of PTS tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd')
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC
+
+   ! assign an index in trc arrays for each PTS prognostic variables
+   INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer
+   INTEGER, PUBLIC, PARAMETER ::   jpmyt2 = jp_lm + 2     !: 2nd MY_TRC tracer
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                           No user defined tracers (MY_TRC)
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .FALSE.  !: MY_TRC flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  0       !: No MY_TRC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: No MY_TRC additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: No MY_TRC additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lm     + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lm     + jp_my_trc      !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lm_2d  + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lm_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lm_3d  + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lm_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lm_trd + 1              !: First index of MY_TRC passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lm_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers
+
+   !!======================================================================
+END MODULE par_my_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90	(revision 3437)
@@ -0,0 +1,61 @@
+MODULE trcini_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcini_my_trc  ***
+   !! TOP :   initialisation of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! trc_ini_my_trc   : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE par_trc         ! TOP parameters
+   USE oce_trc
+   USE trc
+   USE trcsms_my_trc
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_my_trc   ! 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_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_ini_my_trc  ***  
+      !!
+      !! ** Purpose :   initialization for MY_TRC model
+      !!
+      !! ** Method  : - Read the namcfc namelist and check the parameter values
+      !!----------------------------------------------------------------------
+
+      !                       ! 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: initialisation of MY_TRC model'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      
+      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0.
+      !
+   END SUBROUTINE trc_ini_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_my_trc             ! Empty routine
+   END SUBROUTINE trc_ini_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcini_my_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90	(revision 3437)
@@ -0,0 +1,55 @@
+MODULE trcnam_my_trc
+   !!======================================================================
+   !!                      ***  MODULE trcnam_my_trc  ***
+   !! TOP :   initialisation of some run parameters for LOBSTER bio-model
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'   :                                       MY_TRC model
+   !!----------------------------------------------------------------------
+   !! trc_nam_my_trc      : MY_TRC model initialisation
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_my_trc   ! called by trcnam.F90 module
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_my_trc
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_nam_my_trc  ***  
+      !!
+      !! ** Purpose :   read MY_TRC namelist
+      !!
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_my_trc : read MY_TRC namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~'
+      !
+   END SUBROUTINE trc_nam_my_trc
+   
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                             No MY_TRC
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_my_trc                      ! Empty routine
+   END  SUBROUTINE  trc_nam_my_trc
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_my_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcrst_my_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcrst_my_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcrst_my_trc.F90	(revision 3437)
@@ -0,0 +1,51 @@
+MODULE trcrst_my_trc
+   !!======================================================================
+   !!                       ***  MODULE trcrst_my_trc  ***
+   !! TOP :   create, write, read the restart files of MY_TRC tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe)  Original
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_my_trc   : read  restart file
+   !!   trc_rst_wri_my_trc    : write restart file
+   !!----------------------------------------------------------------------
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_my_trc   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_my_trc   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_my_trc( knum ) 
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_read_my_trc: No specific variables to read on unit', knum
+   END SUBROUTINE trc_rst_read_my_trc
+
+   SUBROUTINE trc_rst_wri_my_trc( kt, kirst, knum )
+     INTEGER, INTENT(in)  :: kt, kirst, knum
+     WRITE(*,*) 'trc_rst_wri_my_trc: No specific variables to write on unit' ,knum, ' at time ', kt, kirst
+   END SUBROUTINE trc_rst_wri_my_trc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_my_trc( knum )
+     INTEGER, INTENT(in)  :: knum
+     WRITE(*,*) 'trc_rst_read_my_trc: You should not have seen this print! error?', knum
+   END SUBROUTINE trc_rst_read_my_trc
+
+   SUBROUTINE trc_rst_wri_my_trc( kt, kirst, knum )
+     INTEGER, INTENT(in)  :: kt, kirst, knum
+     WRITE(*,*) 'trc_rst_wri_my_trc: You should not have seen this print! error?', kt, kirst, knum
+   END SUBROUTINE trc_rst_wri_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcrst_my_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90	(revision 3437)
@@ -0,0 +1,109 @@
+MODULE trcsms_my_trc
+   !!======================================================================
+   !!                         ***  MODULE trcsms_my_trc  ***
+   !! TOP :   Main module of the MY_TRC tracers
+   !!======================================================================
+   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
+   !!----------------------------------------------------------------------
+#if defined key_my_trc
+   !!----------------------------------------------------------------------
+   !!   'key_my_trc'                                               CFC tracers
+   !!----------------------------------------------------------------------
+   !! 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 trdmod_oce
+   USE trdmod_trc
+
+   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 3.3 , NEMO Consortium (2010)
+   !! $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 )
+
+      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) )
+        trn(:,:,1,jpmyt1) = 1._wp
+        trb(:,:,1,jpmyt1) = 1._wp
+        tra(:,:,1,jpmyt1) = 0._wp
+      END WHERE
+
+      WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80))
+        trn(:,:,1,jpmyt2) = 1._wp
+        trb(:,:,1,jpmyt2) = 1._wp
+        tra(:,:,1,jpmyt2) = 0._wp
+      END WHERE
+
+      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer
+          DO jn = jp_myt0, jp_myt1
+            ztrmyt(:,:,:) = tra(:,:,:,jn)
+            CALL trd_mod_trc( ztrmyt, jn, jptra_trd_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
+
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                                        No MY_TRC model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_sms_my_trc( kt )             ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_my_trc
+#endif
+
+   !!======================================================================
+END MODULE trcsms_my_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90	(revision 3437)
@@ -0,0 +1,147 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zrem          !  Remineralisation of organic matter
+   USE prtctl_trc      !  print control for debugging
+   USE iom             !  I/O manager
+  
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  p4z_bio    
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_bio ( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  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, jnt
+      INTEGER  ::  ji, jj, jk, jn
+      REAL(wp) ::  ztra
+#if defined key_kriest
+      REAL(wp) ::  zcoef1, zcoef2
+#endif
+      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
+               IF( fsdepw(ji,jj,jk+1) > hmld(ji,jj) )   xdiss(ji,jj,jk) = 0.01
+            END DO 
+         END DO
+      END DO
+
+          
+      CALL p4z_sink ( kt, jnt )     ! vertical flux of particulate organic matter
+      CALL p4z_opt  ( kt, jnt )     ! Optic: PAR in the water column
+      CALL p4z_lim  ( kt      )     ! co-limitations by the various nutrients
+      CALL p4z_prod ( kt, jnt )     ! phytoplankton growth rate over the global ocean. 
+      !                             ! (for each element : C, Si, Fe, Chl )
+      CALL p4z_rem  ( kt      )     ! remineralization terms of organic matter+scavenging of Fe
+      CALL p4z_mort ( kt      )     ! phytoplankton mortality
+      !                             ! zooplankton sources/sinks routines 
+      CALL p4z_micro( kt      )           ! microzooplankton
+      CALL p4z_meso ( kt, jnt )           ! mesozooplankton
+
+      !                             ! test if tracers concentrations fall below 0.
+      xnegtr(:,:,:) = 1.e0
+      DO jn = jp_pcs0, jp_pcs1
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  IF( ( trn(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 
+                     ztra             = ABS(  ( trn(ji,jj,jk,jn) - rtrn ) &
+                                            / ( tra(ji,jj,jk,jn) + rtrn ) )
+                     xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
+                  ENDIF
+              END DO
+            END DO
+         END DO
+      END DO
+      !                                ! where at least 1 tracer concentration becomes negative
+      !                                ! 
+      DO jn = jp_pcs0, jp_pcs1
+         trn(:,:,:,jn) = trn(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
+      END DO
+
+
+      tra(:,:,:,:) = 0.e0
+
+#if defined key_kriest
+      ! 
+      zcoef1 = 1.e0 / xkr_massp 
+      zcoef2 = 1.e0 / xkr_massp / 1.1
+      DO jk = 1,jpkm1
+         trn(:,:,jk,jpnum) = MAX(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  )
+         trn(:,:,jk,jpnum) = MIN(  trn(:,:,jk,jpnum), trn(:,:,jk,jppoc) * zcoef2              )
+      END DO
+#endif
+
+      !
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('bio ')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_bio')
+      !
+   END SUBROUTINE p4z_bio
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_bio                         ! Empty routine
+   END SUBROUTINE p4z_bio
+#endif 
+
+   !!======================================================================
+END MODULE  p4zbio
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90	(revision 3437)
@@ -0,0 +1,349 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_che         !
+   PUBLIC   p4z_che_alloc   !
+
+   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 ::   atcox  = 0.20946         ! units atm
+
+   REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)
+   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )  
+
+   REAL(wp) ::   akcc1  = -171.9065       ! coeff. for apparent solubility equilibrium
+   REAL(wp) ::   akcc2  =   -0.077993     ! Millero et al. 1995 from Mucci 1983
+   REAL(wp) ::   akcc3  = 2839.319        
+   REAL(wp) ::   akcc4  =   71.595        
+   REAL(wp) ::   akcc5  =   -0.77712      
+   REAL(wp) ::   akcc6  =    0.00284263   
+   REAL(wp) ::   akcc7  =  178.34        
+   REAL(wp) ::   akcc8  =   -0.07711     
+   REAL(wp) ::   akcc9  =    0.0041249   
+
+   REAL(wp) ::   rgas   = 83.143         ! universal gas constants
+   REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles
+
+   REAL(wp) ::   bor1   = 0.00023        ! borat constants
+   REAL(wp) ::   bor2   = 1. / 10.82
+
+   REAL(wp) ::   ca0    = -162.8301      ! WEISS & PRICE 1980, units mol/(kg atm)
+   REAL(wp) ::   ca1    =  218.2968
+   REAL(wp) ::   ca2    =   90.9241
+   REAL(wp) ::   ca3    =   -1.47696
+   REAL(wp) ::   ca4    =    0.025695
+   REAL(wp) ::   ca5    =   -0.025225
+   REAL(wp) ::   ca6    =    0.0049867
+
+   REAL(wp) ::   c10    = -3670.7        ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)   
+   REAL(wp) ::   c11    =    62.008     
+   REAL(wp) ::   c12    =    -9.7944    
+   REAL(wp) ::   c13    =     0.0118     
+   REAL(wp) ::   c14    =    -0.000116
+
+   REAL(wp) ::   c20    = -1394.7       ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)   
+   REAL(wp) ::   c21    =    -4.777   
+   REAL(wp) ::   c22    =     0.0184   
+   REAL(wp) ::   c23    =    -0.000118
+
+   REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate
+   REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966)
+   REAL(wp) ::   ks0    =    141.328 
+   REAL(wp) ::   ks1    =  -4276.1  
+   REAL(wp) ::   ks2    =    -23.093
+   REAL(wp) ::   ks3    = -13856.  
+   REAL(wp) ::   ks4    =   324.57 
+   REAL(wp) ::   ks5    =   -47.986
+   REAL(wp) ::   ks6    =  35474. 
+   REAL(wp) ::   ks7    =   -771.54
+   REAL(wp) ::   ks8    =    114.723
+   REAL(wp) ::   ks9    =  -2698.  
+   REAL(wp) ::   ks10   =   1776. 
+   REAL(wp) ::   ks11   =      1.
+   REAL(wp) ::   ks12   =     -0.001005 
+
+   REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides
+   REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 )
+   REAL(wp) ::   kf0    =  -12.641    
+   REAL(wp) ::   kf1    = 1590.2    
+   REAL(wp) ::   kf2    =    1.525    
+   REAL(wp) ::   kf3    =    1.0     
+   REAL(wp) ::   kf4    =   -0.001005
+
+   REAL(wp) ::   cb0    = -8966.90      ! Coeff. for 1. dissoc. of boric acid 
+   REAL(wp) ::   cb1    = -2890.53      ! (Dickson and Goyet, 1994)
+   REAL(wp) ::   cb2    =   -77.942
+   REAL(wp) ::   cb3    =     1.728
+   REAL(wp) ::   cb4    =    -0.0996
+   REAL(wp) ::   cb5    =   148.0248
+   REAL(wp) ::   cb6    =   137.1942
+   REAL(wp) ::   cb7    =     1.62142
+   REAL(wp) ::   cb8    =   -24.4344
+   REAL(wp) ::   cb9    =   -25.085
+   REAL(wp) ::   cb10   =    -0.2474 
+   REAL(wp) ::   cb11   =     0.053105
+
+   REAL(wp) ::   cw0    = -13847.26     ! Coeff. for dissoc. of water (Dickson and Riley, 1979 )
+   REAL(wp) ::   cw1    =    148.9652  
+   REAL(wp) ::   cw2    =    -23.6521
+   REAL(wp) ::   cw3    =    118.67 
+   REAL(wp) ::   cw4    =     -5.977 
+   REAL(wp) ::   cw5    =      1.0495  
+   REAL(wp) ::   cw6    =     -0.01615
+
+   !                                    ! volumetric solubility constants for o2 in ml/L  
+   REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992.
+   REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure
+   REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but 
+   REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2)
+   REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2
+   REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension.
+   REAL(wp) ::   ox6    = -6.24097e-3   
+   REAL(wp) ::   ox7    = -6.93498e-3 
+   REAL(wp) ::   ox8    = -6.90358e-3
+   REAL(wp) ::   ox9    = -4.29155e-3 
+   REAL(wp) ::   ox10   = -3.11680e-7 
+
+   REAL(wp), DIMENSION(5)  :: devk1, devk2, devk3, devk4, devk5   ! coeff. for seawater pressure correction 
+   !                                                              ! (millero 95)
+   DATA devk1 / -25.5    , -15.82    , -29.48  , -25.60     , -48.76    /   
+   DATA devk2 / 0.1271   , -0.0219   , 0.1622  , 0.2324     , 0.5304    /   
+   DATA devk3 / 0.       , 0.        , 2.608E-3,  -3.6246E-3, 0.        /   
+   DATA devk4 / -3.08E-3 , 1.13E-3   , -2.84E-3, -5.13E-3   , -11.76E-3 /   
+   DATA devk5 / 0.0877E-3, -0.1475E-3,  0.     , 0.0794E-3  , 0.3692E-3 /
+
+   !!* Substitution
+#include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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, zt   , zt2   , 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
+      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt
+      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw
+      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_che')
+      !
+      ! CHEMICAL CONSTANTS - SURFACE LAYER
+      ! ----------------------------------
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            !                             ! SET ABSOLUTE TEMPERATURE
+            ztkel = tsn(ji,jj,1,jp_tem) + 273.16
+            zt    = ztkel * 0.01
+            zt2   = zt * zt
+            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.
+            zsal2 = zsal * zsal
+            zlogt = LOG( zt )
+            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980)
+            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
+            zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 )
+            !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992)
+            ztgg  = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature
+            ztgg2 = ztgg  * ztgg
+            ztgg3 = ztgg2 * ztgg
+            ztgg4 = ztgg3 * ztgg
+            ztgg5 = ztgg4 * ztgg
+            zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   &
+                   + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2
+
+            !                             ! SET SOLUBILITIES OF O2 AND CO2 
+            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm)
+            chemc(ji,jj,2) = ( EXP( zoxy  ) * o2atm ) * oxyco              ! mol/(L atm)
+            !
+         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
+               zpres   = 1.025e-1 * fsdept(ji,jj,jk)
+
+               ! SET ABSOLUTE TEMPERATURE
+               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16
+               zsal    = tsn(ji,jj,jk,jp_sal) + ( 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     = tsn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20.
+
+               ! CHLORINITY (WOOSTER ET AL., 1969)
+               zcl     = zsal * salchl
+
+               ! TOTAL SULFATE CONCENTR. [MOLES/kg soln]
+               zst     = st1 * zcl * st2
+
+               ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln]
+               zft     = ft1 * zcl * ft2
+
+               ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990)
+               zcks    = EXP(  ks1 * ztr + ks0 + ks2 * zlogt                           &
+                  &                     + ( ks3 * ztr + ks4 + ks5 * zlogt ) * zisqrt   &
+                  &                     + ( ks6 * ztr + ks7 + ks8 * zlogt ) * zis      &
+                  &                     + ks9 * ztr * zis * zisqrt + ks10 * ztr *zis2 + LOG( ks11 + ks12 *zsal )  )
+
+               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79)
+               zckf    = EXP(  kf1 * ztr + kf0 + kf2 * zisqrt + LOG( kf3 + kf4 * zsal )  )
+
+               ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE
+               zckb    = ( cb0 + cb1 * zsqrt + cb2  * zsal + cb3 * zsal15 + cb4 * zsal * zsal ) * ztr   &
+                  &    + ( cb5 + cb6 * zsqrt + cb7  * zsal )                                            &
+                  &    + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel             &
+                  &    + LOG(  ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks )  )
+
+               zck1    = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal
+               zck2    = c20 * ztr + c21 + c22 * zsal   + c23 * zsal**2
+
+               ! PKW (H2O) (DICKSON AND RILEY, 1979)
+               zckw    = cw0 * ztr + cw1 + cw2 * zlogt + ( cw3 * ztr + cw4 + cw5 * zlogt ) * zsqrt + cw6 * 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  = 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) (LIT.?)
+               zak1    = 10**(zck1)
+               zak2    = 10**(zck2)
+               zakb    = EXP( zckb  )
+               zakw    = EXP( zckw )
+               zaksp1  = 10**(zaksp0)
+
+               ! 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 * zpres/(rgas*ztkel)
+
+               ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE
+               !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968)
+               !        (CF. BROECKER ET AL., 1982)
+
+               zbuf1  = -(devk1(1)+devk2(1)*ztc+devk3(1)*ztc*ztc)
+               zbuf2  = 0.5*(devk4(1)+devk5(1)*ztc)
+               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk1(2) + devk2(2) * ztc + devk3(2) * ztc * ztc )
+               zbuf2  = 0.5 * ( devk4(2) + devk5(2) * ztc )
+               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk1(3) + devk2(3) * ztc + devk3(3) * ztc * ztc )
+               zbuf2  = 0.5 * ( devk4(3) + devk5(3) * ztc )
+               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+               zbuf1  =     - ( devk1(4) + devk2(4) * ztc + devk3(4) * ztc * ztc )
+               zbuf2  = 0.5 * ( devk4(4) + devk5(4) * ztc )
+               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+
+               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 
+               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO
+               !        (P. 1285) AND BERNER (1976)
+               zbuf1  =     - ( devk1(5) + devk2(5) * ztc + devk3(5) * ztc * ztc )
+               zbuf2  = 0.5 * ( devk4(5) + devk5(5) * ztc )
+               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
+
+
+               ! TOTAL BORATE CONCENTR. [MOLES/L]
+               borat(ji,jj,jk) = bor1 * zcl * bor2
+
+               ! 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 / ( 273.15 + ztc ) )
+
+            END DO
+         END DO
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_che')
+      !
+   END SUBROUTINE p4z_che
+
+
+   INTEGER FUNCTION p4z_che_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_che_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( sio3eq(jpi,jpj,jpk) , fekeq(jpi,jpj,jpk) , chemc (jpi,jpj,2), STAT=p4z_che_alloc )
+      !
+      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_che_alloc
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_che( kt )                   ! Empty routine
+      INTEGER, INTENT(in) ::   kt
+      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt
+   END SUBROUTINE p4z_che
+#endif 
+
+   !!======================================================================
+END MODULE  p4zche
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90	(revision 3437)
@@ -0,0 +1,392 @@
+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 
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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
+#if defined key_cpl_carbon_cycle
+   USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2               
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_flx  
+   PUBLIC   p4z_flx_init  
+   PUBLIC   p4z_flx_alloc  
+
+   !                                      !!** Namelist  nampisext  **
+   REAL(wp)          ::  atcco2    = 278._wp       !: pre-industrial atmospheric [co2] (ppm) 	
+   LOGICAL           ::  ln_co2int = .FALSE.       !: flag to read in a file and interpolate atmospheric pco2 or not
+   CHARACTER(len=34) ::  clname    = 'atcco2.txt'  !: filename of pco2 values
+   INTEGER           ::  nn_offset = 0             !: 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 = .true.  !: ref. pressure: global mean Patm (F) or a constant (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)
+
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2 
+
+   REAL(wp) ::  t_oce_co2_flx               !: Total ocean carbon flux 
+   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2
+   REAL(wp) ::  area                        !: ocean surface
+   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion 
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_flx ( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_flx  ***
+      !!
+      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE
+      !!
+      !! ** Method  : 
+      !!              - Include total atm P correction via Esbensen & Kushnir (1981) 
+      !!              - Pressure correction NOT done for key_cpl_carbon_cycle
+      !!              - Remove Wanninkhof chemical enhancement;
+      !!              - Add option for time-interpolation of atcco2.txt  
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt   !
+      !
+      INTEGER  ::   ji, jj, jm, iind, iindm1
+      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan
+      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact
+      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2
+      REAL(wp) ::   zyr_dec, zdco2dt
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_flx')
+      !
+      CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )
+      !
+
+      ! 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 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs
+
+      IF( ln_co2int ) 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 = 2
+         DO WHILE( jm <= nmaxrec .AND. years(jm-1) < zyr_dec .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 defined key_cpl_carbon_cycle
+      satmco2(:,:) = atm_co2(:,:)
+#endif
+
+      DO jm = 1, 10
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+
+               ! DUMMY VARIABLES FOR DIC, H+, AND BORATE
+               zbot  = borat(ji,jj,1)
+               zfact = rhop(ji,jj,1) / 1000. + rtrn
+               zdic  = trn(ji,jj,1,jpdic) / zfact
+               zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact
+               zalka = trn(ji,jj,1,jptal) / zfact
+
+               ! CALCULATE [ALK]([CO3--], [HCO3-])
+               zalk  = zalka - (  akw3(ji,jj,1) / zph - zph + zbot / ( 1.+ zph / akb3(ji,jj,1) )  )
+
+               ! CALCULATE [H+] AND [H2CO3]
+               zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   &
+                  &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  )
+               zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 )
+               zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact
+               hi(ji,jj,1)   = zah2 * zfact
+            END DO
+         END DO
+      END DO
+
+
+      ! --------------
+      ! COMPUTE FLUXES
+      ! --------------
+
+      ! FIRST COMPUTE GAS EXCHANGE COEFFICIENTS
+      ! -------------------------------------------
+
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            ztc  = MIN( 35., tsn(ji,jj,1,jp_tem) )
+            ztc2 = ztc * ztc
+            ztc3 = ztc * ztc2 
+            ! Compute the schmidt Number both O2 and CO2
+            zsch_co2 = 2073.1 - 125.62 * ztc + 3.6276 * ztc2 - 0.043126 * ztc3
+            zsch_o2  = 1953.4 - 128.0  * ztc + 3.9918 * ztc2 - 0.050091 * ztc3
+            !  wind speed 
+            zws  = wndm(ji,jj) * wndm(ji,jj)
+            ! Compute the piston velocity for O2 and CO2
+            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 )
+            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)
+# if defined key_degrad
+            zkgwan = zkgwan * facvol(ji,jj,1)
+#endif 
+            ! 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
+            ! Compute CO2 flux for the sea and air
+            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s)
+            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ?
+            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000.
+            ! compute the trend
+            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1)
+
+            ! Compute O2 flux 
+            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s)
+            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj)
+            zoflx(ji,jj) = zfld16 - zflu16
+            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1)
+         END DO
+      END DO
+
+      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )            ! Cumulative Total Flux of Carbon
+      IF( kt == nitend ) THEN
+         t_atm_co2_flx = glob_sum( satmco2(:,:) * patm(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2
+         !
+         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15             ! Conversion in PgC ; negative for out of the ocean
+         t_atm_co2_flx = t_atm_co2_flx  / area                            ! global mean of atmospheric pCO2
+         !
+         IF( lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' Global mean of atmospheric pCO2 (ppm) at it= ', kt, ' date= ', ndastp
+            WRITE(numout,*) '------------------------------------------------------- :  ',t_atm_co2_flx
+            WRITE(numout,*)
+            WRITE(numout,*) ' Cumulative total Flux of Carbon out of the ocean (PgC) :'
+            WRITE(numout,*) '-------------------------------------------------------  ',t_oce_co2_flx
+         ENDIF
+         !
+      ENDIF
+
+      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( ln_diatrc ) THEN
+         IF( lk_iomput ) THEN
+            CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact ) 
+            CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1)  )
+            CALL iom_put( "Kg"   , zkgco2(:,:) * tmask(:,:,1) )
+            CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) )
+            CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) )
+         ELSE
+            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact 
+            trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 
+            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 
+            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 
+         ENDIF
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx )
+      !
+      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
+      !!----------------------------------------------------------------------
+      !
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, 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 ) THEN
+         IF(lwp) THEN                         ! control print
+            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2
+            WRITE(numout,*) ' '
+         ENDIF
+         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2
+      ELSE
+         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)
+      ENDIF
+      !
+      area = glob_sum( e1e2t(:,:) )        ! interior global domain surface
+      !
+      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon
+      t_atm_co2_flx = 0._wp
+      t_oce_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
+      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files
+      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read
+      !!
+      NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir
+
+      !                                         ! -------------------- !
+      IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 !
+         !                                      ! -------------------- !
+         !                                            !* set file information (default values)
+         ! ... default values (NB: frequency positive => hours, negative => months)
+         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_patm = FLD_N( 'pres'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       )
+         cn_dir  = './'          ! directory in which the Patm data are 
+
+         REWIND( numnatp )                             !* read in namlist nampisatm
+         READ  ( numnatp, 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,*)
+         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( .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
+      !
+   END SUBROUTINE p4z_patm
+
+   INTEGER FUNCTION p4z_flx_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_flx_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( oce_co2(jpi,jpj), 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
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_flx( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt
+   END SUBROUTINE p4z_flx
+#endif 
+
+   !!======================================================================
+END MODULE  p4zflx
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90	(revision 3437)
@@ -0,0 +1,80 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_int  ***
+      !!
+      !! ** Purpose :   interpolation and computation of various accessory fields
+      !!
+      !!---------------------------------------------------------------------
+      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 = trn(ji,jj,1,jpsil) * trn(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
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_int                   ! Empty routine
+      WRITE(*,*) 'p4z_int: You should not have seen this print! error?'
+   END SUBROUTINE p4z_int
+#endif 
+
+   !!======================================================================
+END MODULE  p4zint
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90	(revision 3437)
@@ -0,0 +1,236 @@
+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 
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zopt          ! Optical
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC p4z_lim    
+   PUBLIC p4z_lim_init    
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  conc0     = 2.e-6_wp      !:  NO3, PO4 half saturation   
+   REAL(wp), PUBLIC ::  conc1     = 8.e-6_wp      !:  Phosphate half saturation for diatoms  
+   REAL(wp), PUBLIC ::  conc2     = 1.e-9_wp      !:  Iron half saturation for nanophyto 
+   REAL(wp), PUBLIC ::  conc2m    = 3.e-9_wp      !:  Max iron half saturation for nanophyto 
+   REAL(wp), PUBLIC ::  conc3     = 2.e-9_wp      !:  Iron half saturation for diatoms  
+   REAL(wp), PUBLIC ::  conc3m    = 8.e-9_wp      !:  Max iron half saturation for diatoms 
+   REAL(wp), PUBLIC ::  xsizedia  = 5.e-7_wp      !:  Minimum size criteria for diatoms
+   REAL(wp), PUBLIC ::  xsizephy  = 1.e-6_wp      !:  Minimum size criteria for nanophyto
+   REAL(wp), PUBLIC ::  concnnh4  = 1.e-7_wp      !:  NH4 half saturation for phyto  
+   REAL(wp), PUBLIC ::  concdnh4  = 4.e-7_wp      !:  NH4 half saturation for diatoms
+   REAL(wp), PUBLIC ::  xksi1     = 2.E-6_wp      !:  half saturation constant for Si uptake 
+   REAL(wp), PUBLIC ::  xksi2     = 3.33e-6_wp    !:  half saturation constant for Si/C 
+   REAL(wp), PUBLIC ::  xkdoc     = 417.e-6_wp    !:  2nd half-sat. of DOC remineralization  
+   REAL(wp), PUBLIC ::  concfebac = 1.E-11_wp     !:  Fe half saturation for bacteria 
+   REAL(wp), PUBLIC ::  qnfelim   = 7.E-6_wp      !:  optimal Fe quota for nanophyto
+   REAL(wp), PUBLIC ::  qdfelim   = 7.E-6_wp      !:  optimal Fe quota for diatoms
+   REAL(wp), PUBLIC ::  caco3r    = 0.16_wp       !:  mean rainratio 
+
+   ! 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 
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_lim( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_lim  ***
+      !!
+      !! ** Purpose :   Compute the co-limitations by the various nutrients
+      !!              for the various phytoplankton species
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in)  :: kt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim
+      REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2
+      REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2
+      REAL(wp) ::   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    = trn(ji,jj,jk,jpno3) / 40.e-6
+               zferlim = MAX( 2e-11 * zno3 * zno3, 5e-12 )
+               zferlim = MIN( zferlim, 3e-11 )
+               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim )
+
+               ! Computation of a variable Ks for iron on diatoms taking into account
+               ! that increasing biomass is made of generally bigger cells
+               !------------------------------------------------
+               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia )
+               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd
+               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy )
+               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn
+               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn )
+               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn )
+
+               concdfe(ji,jj,jk) = MAX( conc3       , ( zconcd2 *      conc3    + conc3m        * zconcd ) * z1_trndia )
+               zconc1d           = MAX( 2.* conc0   , ( zconcd2 * 2. * conc0    + conc1         * zconcd ) * z1_trndia )
+               zconc1dnh4        = MAX( 2.* concnnh4, ( zconcd2 * 2. * concnnh4 + concdnh4      * zconcd ) * z1_trndia )
+
+               concnfe(ji,jj,jk) = MAX( conc2       , ( zconcn2 * conc2         + conc2m        * zconcn ) * z1_trnphy )
+               zconc0n           = MAX( conc0       , ( zconcn2 * conc0         + 2. * conc0    * zconcn ) * z1_trnphy )
+               zconc0nnh4        = MAX( concnnh4    , ( zconcn2 * concnnh4      + 2. * concnnh4 * zconcn ) * z1_trnphy )
+
+               ! Michaelis-Menten Limitation term for nutrients Small flagellates
+               ! -----------------------------------------------
+               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) )
+               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom
+               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom
+               !
+               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk)
+               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 )
+               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy 
+               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk)
+               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim )
+               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 )
+               xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 )
+               !
+               zlim1    = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) )
+               zlim3    = trn(ji,jj,jk,jpfer) / ( concfebac+ trn(ji,jj,jk,jpfer) )
+               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) )
+               xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4
+
+               !   Michaelis-Menten Limitation term for nutrients Diatoms
+               !   ----------------------------------------------
+               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) )
+               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom
+               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom
+               !
+               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk)
+               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  )
+               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) )
+               zratio   = trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn)
+               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk)
+               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim )
+               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 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * conc0 )    &
+                  &   / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)  + conc0 * trn(ji,jj,jk,jpnh4) ) 
+               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 )
+               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concfebac )
+               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) )
+               ztem2  = tsn(ji,jj,jk,jp_tem) - 10.
+               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) 
+               zetot2 = 1. / ( 30. + etot(ji,jj,jk) ) 
+
+               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  &
+                  &                       * ztem1 / ( 0.1 + ztem1 )                     &
+                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  &
+                  &                       * 2.325 * zetot1 * 30. * 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
+      !
+      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/nampislim/ conc0, conc1, conc2, conc2m, conc3, conc3m,   &
+         &                xsizedia, xsizephy, concnnh4, concdnh4,       &
+         &                xksi1, xksi2, xkdoc, concfebac, qnfelim, qdfelim, caco3r
+
+      REWIND( numnatp )                     ! read numnat
+      READ  ( numnatp, nampislim )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r
+         WRITE(numout,*) '    NO3, PO4 half saturation                 conc0     =  ', conc0
+         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1
+         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2
+         WRITE(numout,*) '    2nd half-sat. of DOC remineralization    xkdoc     = ', xkdoc
+         WRITE(numout,*) '    Phosphate half saturation for diatoms    conc1     = ', conc1
+         WRITE(numout,*) '    Iron half saturation for phyto           conc2     = ', conc2
+         WRITE(numout,*) '    Max iron half saturation for phyto       conc2m    = ', conc2m
+         WRITE(numout,*) '    Iron half saturation for diatoms         conc3     = ', conc3
+         WRITE(numout,*) '    Maxi iron half saturation for diatoms    conc3m    = ', conc3m
+         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia
+         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy
+         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4
+         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4
+         WRITE(numout,*) '    Fe half saturation for bacteria          concfebac = ', concfebac
+         WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim
+         WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim
+      ENDIF
+
+   END SUBROUTINE p4z_lim_init
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_lim                   ! Empty routine
+   END SUBROUTINE p4z_lim
+#endif 
+
+   !!======================================================================
+END MODULE  p4zlim
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90	(revision 3437)
@@ -0,0 +1,219 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 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 = 0.327e3_wp  !: diss. rate constant calcite
+   REAL(wp), PUBLIC :: nca  = 1.0_wp      !: 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$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_lys( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  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 ! ocean time step
+      INTEGER  ::   ji, jj, jk, jn
+      REAL(wp) ::   zalk, zdic, zph, zah2
+      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi
+      REAL(wp) ::   zomegaca, zexcess, zexcess0
+      REAL(wp) ::   zrfact2
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss   
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_lys')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss )
+      !
+      zco3    (:,:,:) = 0.
+      zcaldiss(:,:,:) = 0.
+      !     -------------------------------------------
+      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS
+      !     -------------------------------------------
+      
+      DO jn = 1, 5                               !  BEGIN OF ITERATION
+         !
+!CDIR NOVERRCHK
+         DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  zfact = rhop(ji,jj,jk) / 1000. + rtrn
+                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+]
+                  zdic  = trn(ji,jj,jk,jpdic) / zfact
+                  zalka = trn(ji,jj,jk,jptal) / zfact
+                  ! CALCULATE [ALK]([CO3--], [HCO3-])
+                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) )
+                  ! CALCULATE [H+] and [CO3--]
+                  zaldi = zdic - zalk
+                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) )
+                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 )
+                  !
+                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact
+                  hi(ji,jj,jk)   = zah2 * zfact
+               END DO
+            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 * ( tsn(ji,jj,jk,jp_sal) / 35._wp )
+               zfact    = rhop(ji,jj,jk) / 1000._wp
+               zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk) 
+
+               ! 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 * trn(ji,jj,jk,jpcal)
+# if defined key_degrad
+               zdispot = zdispot * facvol(ji,jj,jk)
+# endif
+              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
+              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
+              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution
+              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact
+              !
+              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( ln_diatrc )  THEN
+         !
+         IF( lk_iomput ) THEN
+            zrfact2 = 1.e3 * rfact2r
+            CALL iom_put( "PH"    , -1. * LOG10( hi(:,:,:) )                * tmask(:,:,:) )
+            CALL iom_put( "CO3"   ,        zco3    (:,:,:) * 1e+3           * tmask(:,:,:) )
+            CALL iom_put( "CO3sat",        aksp    (:,:,:) * 1e+3 / calcon  * tmask(:,:,:) )
+            CALL iom_put( "DCAL"  ,        zcaldiss(:,:,:) * zrfact2        * tmask(:,:,:) )
+         ELSE
+            trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:)
+            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:)
+            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon     * tmask(:,:,:)
+         ENDIF
+         !
+      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 )
+      !
+      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
+      !!
+      !!----------------------------------------------------------------------
+
+      NAMELIST/nampiscal/ kdca, nca
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, 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
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_lys( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'p4z_lys: You should not have seen this print! error?', kt
+   END SUBROUTINE p4z_lys
+#endif 
+   !!======================================================================
+END MODULE  p4zlys
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90	(revision 3437)
@@ -0,0 +1,295 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zsink         !  vertical flux of particulate matter due to sinking
+   USE p4zint          !  interpolation and computation of various fields
+   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       = 0.5_wp     !: part of calcite not dissolved in mesozoo guts
+   REAL(wp), PUBLIC ::  xprefc      = 1.0_wp     !: mesozoo preference for POC 
+   REAL(wp), PUBLIC ::  xprefp      = 0.3_wp     !: mesozoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xprefz      = 1.0_wp     !: mesozoo preference for diatoms
+   REAL(wp), PUBLIC ::  xprefpoc    = 0.3_wp     !: mesozoo preference for POC 
+   REAL(wp), PUBLIC ::  xthresh2zoo = 1E-8_wp    !: zoo feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2dia = 1E-8_wp    !: diatoms feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2phy = 2E-7_wp    !: nanophyto feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2poc = 1E-8_wp    !: poc feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  xthresh2    = 0._wp      !: feeding threshold for mesozooplankton 
+   REAL(wp), PUBLIC ::  resrat2     = 0.005_wp   !: exsudation rate of mesozooplankton
+   REAL(wp), PUBLIC ::  mzrat2      = 0.04_wp    !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat2    = 0.9_wp     !: maximal mesozoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz2     = 20E-6_wp   !: non assimilated fraction of P by mesozoo 
+   REAL(wp), PUBLIC ::  unass2      = 0.3_wp     !: Efficicency of mesozoo growth 
+   REAL(wp), PUBLIC ::  sigma2      = 0.6_wp     !: Fraction of mesozoo excretion as DOM 
+   REAL(wp), PUBLIC ::  epsher2     = 0.3_wp     !: half sturation constant for grazing 2
+   REAL(wp), PUBLIC ::  grazflux    = 3.E3_wp    !: mesozoo flux feeding rate
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_meso( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_meso  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for mesozooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
+      REAL(wp) :: zgraze2 , zdenom, zdenom2, zncratio
+      REAL(wp) :: zfact   , zstep, zfood, zfoodlim
+      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf
+      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat
+#if defined key_kriest
+      REAL znumpoc
+#endif
+      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof
+      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf
+      REAL(wp) :: zgrazfff, zgrazffe
+      CHARACTER (len=25) :: charout
+      REAL(wp) :: zrfact2
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_meso')
+      !
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 )
+# if defined key_degrad
+               zstep     = xstep * facvol(ji,jj,jk)
+# else
+               zstep     = xstep
+# endif
+               zfact     = zstep * tgfunc(ji,jj,jk) * zcompam
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(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 * trn(ji,jj,jk,jpmes)
+               !
+
+               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
+               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
+               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 )
+               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
+
+               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc 
+               zfoodlim  = MAX( 0., zfood - xthresh2 )
+               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
+               zdenom2   = zdenom / ( zfood + rtrn )
+               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(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   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn)
+               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn)
+               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn)
+
+               !  Mesozooplankton flux feeding on GOC
+               !  ----------------------------------
+# if ! defined key_kriest
+               zgrazffe  = grazflux * zstep * wsbio4(ji,jj,jk)          &
+                 &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)
+               zgrazfff  = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)
+# else
+               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     &
+               zgrazfff   = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
+# endif
+              !
+              zgraztot   = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe
+              zgraztotf  = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff 
+
+              ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
+              grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot
+              !    Mesozooplankton efficiency
+              !    --------------------------
+              zgrasrat   =  zgraztotf / ( zgraztot + rtrn )
+              zncratio   = (  xprefc   * zcompadi * quotad(ji,jj,jk)  &
+                  &         + xprefp   * zcompaph * quotan(ji,jj,jk)  &
+                  &         + xprefz   * zcompaz                      &
+                  &         + xprefpoc * zcompapoc   ) / ( zfood + rtrn )
+               zepshert  = epsher2 * MIN( 1., zncratio )
+               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 )
+               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 )
+               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert ) 
+               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
+               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              
+#if defined key_kriest
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2
+#else
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2
+#endif
+               zmortz2 = 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 * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn )
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trn(ji,jj,jk,jpdsi) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
+
+               zprcaca = xfracal(ji,jj,jk) * zgrazn
+               ! calcite production
+               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) - zprcaca
+               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca
+               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca
+#if defined key_kriest
+               znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 - zgrazpoc - zgrazffe
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc &
+                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn )
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof
+#else
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff
+#endif
+
+            END DO
+         END DO
+      END DO
+      !
+      IF( ln_diatrc .AND. lk_iomput ) THEN
+         zrfact2 = 1.e3 * rfact2r
+         grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:)   ! Total grazing of phyto by zoo
+         prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:)   ! Calcite production
+         IF( jnt == nrdttrc ) THEN
+            CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton
+            CALL iom_put( "PCAL" , prodcal  )  ! Calcite production
+         ENDIF
+      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
+      !
+      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/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   &
+         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, &
+         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampismes )
+
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' ' 
+         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes'
+         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
+
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_meso                    ! Empty routine
+   END SUBROUTINE p4z_meso
+#endif 
+
+   !!======================================================================
+END MODULE  p4zmeso
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90	(revision 3437)
@@ -0,0 +1,261 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zsink         !  vertical flux of particulate matter due to sinking
+   USE p4zint          !  interpolation and computation of various fields
+   USE p4zprod         !  production
+   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
+   PUBLIC   p4z_micro_alloc    ! called in trcsms_pisces.F90
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC ::  part       = 0.5_wp     !: part of calcite not dissolved in microzoo guts
+   REAL(wp), PUBLIC ::  xpref2c    = 0.2_wp     !: microzoo preference for POC 
+   REAL(wp), PUBLIC ::  xpref2p    = 1.0_wp     !: microzoo preference for nanophyto
+   REAL(wp), PUBLIC ::  xpref2d    = 0.6_wp     !: microzoo preference for diatoms
+   REAL(wp), PUBLIC ::  xthreshdia = 1E-8_wp    !: diatoms feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshphy = 2E-7_wp    !: nanophyto threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthreshpoc = 1E-8_wp    !: poc threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  xthresh    = 0._wp      !: feeding threshold for microzooplankton 
+   REAL(wp), PUBLIC ::  resrat     = 0.03_wp    !: exsudation rate of microzooplankton
+   REAL(wp), PUBLIC ::  mzrat      = 0.0_wp     !: microzooplankton mortality rate 
+   REAL(wp), PUBLIC ::  grazrat    = 3.0_wp     !: maximal microzoo grazing rate
+   REAL(wp), PUBLIC ::  xkgraz     = 20E-6_wp   !: non assimilated fraction of P by microzoo 
+   REAL(wp), PUBLIC ::  unass      = 0.3_wp     !: Efficicency of microzoo growth 
+   REAL(wp), PUBLIC ::  sigma1     = 0.6_wp     !: Fraction of microzoo excretion as DOM 
+   REAL(wp), PUBLIC ::  epsher     = 0.3_wp     !: half sturation constant for grazing 1 
+
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_micro( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_micro  ***
+      !!
+      !! ** Purpose :   Compute the sources/sinks for microzooplankton
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc
+      REAL(wp) :: zgraze  , zdenom, zdenom2, zncratio
+      REAL(wp) :: zfact   , zstep, zfood, zfoodlim
+      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf
+      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
+      REAL(wp) :: zrespz, ztortz, zgrasrat
+      REAL(wp) :: zgrazp, zgrazm, zgrazsd
+      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_micro')
+      !
+      grazing(:,:,:) = 0.  !: grazing set to zero
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 )
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz
+
+               !  Respiration rates of both zooplankton
+               !  -------------------------------------
+               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(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 * trn(ji,jj,jk,jpzoo)
+
+               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia )
+               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 )
+               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 )
+               
+               !     Microzooplankton grazing
+               !     ------------------------
+               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi
+               zfoodlim  = MAX( 0. , zfood - xthresh )
+               zdenom    = zfoodlim / ( xkgraz + zfoodlim )
+               zdenom2   = zdenom / ( zfood + rtrn )
+               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
+
+               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2 
+               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2 
+               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2 
+
+               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)
+               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)
+               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)
+               !
+               zgraztot  = zgrazp  + zgrazm  + zgrazsd 
+               zgraztotf = zgrazpf + zgrazsf + zgrazmf 
+
+               ! Grazing by microzooplankton
+               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot
+
+               !    Various remineralization and excretion terms
+               !    --------------------------------------------
+               zgrasrat  = zgraztotf / ( zgraztot + rtrn )
+               zncratio  = ( xpref2p * zcompaph * quotan(ji,jj,jk) &
+                  &        + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn )
+               zepshert  = epsher * MIN( 1., zncratio )
+               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 )
+               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert ) 
+               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
+               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
+               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
+#if defined key_kriest
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat
+#endif
+               !   Update the arrays TRA which contain the biological sources and sinks
+               !   --------------------------------------------------------------------
+               zmortz = ztortz + zrespz
+               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + 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  * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
+               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazsd * trn(ji,jj,jk,jpdsi)/(trn(ji,jj,jk,jpdia)+rtrn)
+               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf
+               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf
+               zprcaca = xfracal(ji,jj,jk) * zgrazp
+               !
+               ! calcite production
+               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
+#if defined key_kriest
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm ) * xkr_ddiat
+#endif
+            END DO
+         END DO
+      END DO
+      !
+      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
+      !
+      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/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, &
+         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, &
+         &                xthresh, xkgraz, epsher, sigma1, unass
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampiszoo )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo'
+         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
+
+   INTEGER FUNCTION p4z_micro_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_micro_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc )
+      IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.')
+
+   END FUNCTION p4z_micro_alloc
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_micro                    ! Empty routine
+   END SUBROUTINE p4z_micro
+#endif 
+
+   !!======================================================================
+END MODULE  p4zmicro
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90	(revision 3437)
@@ -0,0 +1,266 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zsink         !  vertical flux of particulate matter due to sinking
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_mort    
+   PUBLIC   p4z_mort_init    
+
+   !! * Shared module variables
+   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !:
+   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !:
+   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !:
+   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !:
+   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !:
+
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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) :: zcompaph
+      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal
+      REAL(wp) :: ztortp , zrespp , zmortp , zstep
+      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( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 )
+               zstep    = xstep
+# if defined key_degrad
+               zstep    = zstep * facvol(ji,jj,jk)
+# endif
+               !     Squared mortality of Phyto similar to a sedimentation term during
+               !     blooms (Doney et al. 1996)
+               zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy) 
+
+               !     Phytoplankton mortality. This mortality loss is slightly
+               !     increased when nutrients are limiting phytoplankton growth
+               !     as observed for instance in case of iron limitation.
+               ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph
+
+               zmortp = zrespp + ztortp
+
+               !   Update the arrays TRA which contains the biological sources and sinks
+
+               zfactfe = trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
+               zfactch = trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn)
+
+               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
+#if defined key_kriest
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe
+#else
+               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
+               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
+#endif
+            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, zstep
+      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( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. )
+
+               !    Aggregation term for diatoms is increased in case of nutrient
+               !    stress as observed in reality. The stressed cells become more
+               !    sticky and coagulate to sink quickly out of the euphotic zone
+               !     ------------------------------------------------------------
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               !  Phytoplankton respiration 
+               !     ------------------------
+               zrespp2  = 1.e6 * zstep * (  wchl + wchld * ( 1.- xlimdia(ji,jj,jk) )  )    &
+                  &       * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia)
+
+               !     Phytoplankton mortality. 
+               !     ------------------------
+               ztortp2  = mprat2 * zstep * trn(ji,jj,jk,jpdia)  / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 
+
+               zmortp2 = zrespp2 + ztortp2
+
+               !   Update the arrays tra which contains the biological sources and sinks
+               !   ---------------------------------------------------------------------
+               zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
+               zfactsi = trn(ji,jj,jk,jpdsi) / ( trn(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
+#if defined key_kriest
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2  
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe
+#else
+               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
+               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
+#endif
+            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/nampismort/ wchl, wchld, mprat, mprat2, mpratm
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampismort )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl
+         WRITE(numout,*) '    maximum quadratic mortality of diatoms    wchld     =', wchld
+         WRITE(numout,*) '    phytoplankton mortality rate              mprat     =', mprat
+         WRITE(numout,*) '    Diatoms mortality rate                    mprat2    =', mprat2
+         WRITE(numout,*) '    Phytoplankton minimum mortality rate      mpratm    =', mpratm
+      ENDIF
+
+   END SUBROUTINE p4z_mort_init
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_mort                    ! Empty routine
+   END SUBROUTINE p4z_mort
+#endif 
+
+   !!======================================================================
+END MODULE  p4zmort
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90	(revision 3437)
@@ -0,0 +1,288 @@
+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
+   !!----------------------------------------------------------------------
+#if defined  key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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
+
+   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
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot, enano, ediat   !: PAR for phyto, nano and diat 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy                 !: averaged PAR in the mixed layer
+
+   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m)
+   REAL(wp) ::   parlux = 0.43_wp / 3._wp
+
+   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption
+   
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_opt( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  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, jnt   ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk
+      INTEGER  ::   irgb
+      REAL(wp) ::   zchl, zxsi0r
+      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_opt')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2       )
+      CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+
+      !     Initialisation of variables used to compute PAR
+      !     -----------------------------------------------
+      ze1 (:,:,jpk) = 0._wp
+      ze2 (:,:,jpk) = 0._wp
+      ze3 (:,:,jpk) = 0._wp
+
+      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue)
+      DO jk = 1, jpkm1                         !  --------------------------------------------------------
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6
+               zchl = MIN(  10. , MAX( 0.05, zchl )  )
+               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn )
+               !                                                         
+               zekb(ji,jj,jk) = xkrgb(1,irgb) * fse3t(ji,jj,jk)
+               zekg(ji,jj,jk) = xkrgb(2,irgb) * fse3t(ji,jj,jk)
+               zekr(ji,jj,jk) = xkrgb(3,irgb) * fse3t(ji,jj,jk)
+            END DO
+         END DO
+      END DO
+
+
+      !                                        !* Photosynthetically Available Radiation (PAR)
+      !                                        !  --------------------------------------
+!CDIR NOVERRCHK
+      DO jj = 1, jpj
+!CDIR NOVERRCHK
+         DO ji = 1, jpi
+            zc1 = parlux * qsr(ji,jj) * EXP( -0.5 * zekb(ji,jj,1) )
+            zc2 = parlux * qsr(ji,jj) * EXP( -0.5 * zekg(ji,jj,1) )
+            zc3 = parlux * qsr(ji,jj) * EXP( -0.5 * zekr(ji,jj,1) )
+            ze1  (ji,jj,1) = zc1
+            ze2  (ji,jj,1) = zc2
+            ze3  (ji,jj,1) = zc3
+            etot (ji,jj,1) = (       zc1 +        zc2 +       zc3 )
+            enano(ji,jj,1) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
+            ediat(ji,jj,1) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
+         END DO
+      END DO
+
+    
+      DO jk = 2, nksrp      
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zc1 = ze1(ji,jj,jk-1) * EXP( -0.5 * ( zekb(ji,jj,jk-1) + zekb(ji,jj,jk) ) )
+               zc2 = ze2(ji,jj,jk-1) * EXP( -0.5 * ( zekg(ji,jj,jk-1) + zekg(ji,jj,jk) ) )
+               zc3 = ze3(ji,jj,jk-1) * EXP( -0.5 * ( zekr(ji,jj,jk-1) + zekr(ji,jj,jk) ) )
+               ze1  (ji,jj,jk) = zc1
+               ze2  (ji,jj,jk) = zc2
+               ze3  (ji,jj,jk) = zc3
+               etot (ji,jj,jk) = (       zc1 +        zc2 +       zc3 )
+               enano(ji,jj,jk) = ( 2.1 * zc1 + 0.42 * zc2 + 0.4 * zc3 )
+               ediat(ji,jj,jk) = ( 1.6 * zc1 + 0.69 * zc2 + 0.7 * zc3 )
+            END DO
+         END DO
+      END DO
+
+      IF( ln_qsr_bio ) THEN                    !* heat flux accros w-level (used in the dynamics)
+         !                                     !  ------------------------
+         zxsi0r = 1.e0 / rn_si0
+         !
+         ze0  (:,:,1) = rn_abs * qsr(:,:)
+         ze1  (:,:,1) = parlux * qsr(:,:)             ! surface value : separation in R-G-B + near surface 
+         ze2  (:,:,1) = parlux * qsr(:,:)
+         ze3  (:,:,1) = parlux * qsr(:,:)
+         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1)
+         !
+         DO jk = 2, nksrp + 1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  zc0 = ze0(ji,jj,jk-1) * EXP( -fse3t(ji,jj,jk-1) * zxsi0r )
+                  zc1 = ze1(ji,jj,jk-1) * EXP( -zekb(ji,jj,jk-1 ) )
+                  zc2 = ze2(ji,jj,jk-1) * EXP( -zekg(ji,jj,jk-1 ) )
+                  zc3 = ze3(ji,jj,jk-1) * EXP( -zekr(ji,jj,jk-1 ) )
+                  ze0(ji,jj,jk) = zc0
+                  ze1(ji,jj,jk) = zc1
+                  ze2(ji,jj,jk) = zc2
+                  ze3(ji,jj,jk) = zc3
+                  etot3(ji,jj,jk) = ( zc0 + zc1 + zc2 + zc3 ) * tmask(ji,jj,jk)
+              END DO
+              !
+            END DO
+            !
+        END DO
+        !
+      ENDIF
+
+      !                                        !* Euphotic depth and level
+      neln(:,:) = 1                            !  ------------------------
+      heup(:,:) = 300.
+
+      DO jk = 2, nksrp
+         DO jj = 1, jpj
+           DO ji = 1, jpi
+              IF( etot(ji,jj,jk) >= 0.0043 * qsr(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) = fsdepw(ji,jj,jk+1)      ! Euphotic layer depth
+              ENDIF
+           END DO
+        END DO
+      END DO
+ 
+      heup(:,:) = MIN( 300., heup(:,:) )
+
+      !                                        !* mean light over the mixed layer
+      zdepmoy(:,:)   = 0.e0                    !  -------------------------------
+      zetmp  (:,:)   = 0.e0
+      zetmp1 (:,:)   = 0.e0
+      zetmp2 (:,:)   = 0.e0
+
+      DO jk = 1, nksrp
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk)
+                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk)
+                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk)
+                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk)
+               ENDIF
+            END DO
+         END DO
+      END DO
+      !
+      emoy(:,:,:) = etot(:,:,:)
+      !
+      DO jk = 1, nksrp
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn )
+                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep
+                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep
+                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_diatrc ) THEN        ! save output diagnostics
+        !
+        IF( lk_iomput ) THEN
+           IF( jnt == nrdttrc ) THEN
+              CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht
+              CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation
+           ENDIF
+        ELSE
+           trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)  
+           trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:)
+        ENDIF
+        !
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt')
+      !
+   END SUBROUTINE p4z_opt
+
+
+   SUBROUTINE p4z_opt_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_opt_init  ***
+      !!
+      !! ** Purpose :   Initialization of tabulated attenuation coef
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_opt_init')
+      !
+      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_0(nksrp+1), ' m'
+      !
+                         etot (:,:,:) = 0._wp
+                         enano(:,:,:) = 0._wp
+                         ediat(:,:,:) = 0._wp
+      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp
+      ! 
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init')
+      !
+   END SUBROUTINE p4z_opt_init
+
+
+   INTEGER FUNCTION p4z_opt_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_opt_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) ,     &
+         &      ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc )
+         !
+      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_opt_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                   No PISCES bio-model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE p4z_opt                   ! Empty routine
+   END SUBROUTINE p4z_opt
+#endif 
+
+   !!======================================================================
+END MODULE  p4zopt
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90	(revision 3437)
@@ -0,0 +1,532 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   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 p4zopt          !  optical model
+   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 = .FALSE.
+   REAL(wp), PUBLIC ::  pislope    = 3.0_wp            !:
+   REAL(wp), PUBLIC ::  pislope2   = 3.0_wp            !:
+   REAL(wp), PUBLIC ::  excret     = 10.e-5_wp         !:
+   REAL(wp), PUBLIC ::  excret2    = 0.05_wp           !:
+   REAL(wp), PUBLIC ::  bresp      = 0.00333_wp        !:
+   REAL(wp), PUBLIC ::  chlcnm     = 0.033_wp          !:
+   REAL(wp), PUBLIC ::  chlcdm     = 0.05_wp           !:
+   REAL(wp), PUBLIC ::  chlcmin    = 0.00333_wp        !:
+   REAL(wp), PUBLIC ::  fecnm      = 10.E-6_wp         !:
+   REAL(wp), PUBLIC ::  fecdm      = 15.E-6_wp         !:
+   REAL(wp), PUBLIC ::  grosip     = 0.151_wp          !:
+
+   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) :: texcret                !: 1 - excret 
+   REAL(wp) :: texcret2               !: 1 - excret2        
+   REAL(wp) :: tpp                    !: Total primary production
+
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_prod( kt , jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_prod  ***
+      !!
+      !! ** Purpose :   Compute the phytoplankton production depending on
+      !!              light, temperature and nutrient availability
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: kt, jnt
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2
+      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap
+      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2
+      REAL(wp) ::   zmxltst, zmxlday, zmaxday
+      REAL(wp) ::   zpislopen  , zpislope2n
+      REAL(wp) ::   zrum, zcodel, zargu, zval
+      REAL(wp) ::   zrfact2
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt   
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd
+      !!---------------------------------------------------------------------
+      !
+      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, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
+      CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd )
+      !
+      zprorca (:,:,:) = 0._wp
+      zprorcad(:,:,:) = 0._wp
+      zprofed (:,:,:) = 0._wp
+      zprofen (:,:,:) = 0._wp
+      zprochln(:,:,:) = 0._wp
+      zprochld(:,:,:) = 0._wp
+      zpronew (:,:,:) = 0._wp
+      zpronewd(:,:,:) = 0._wp
+      zprdia  (:,:,:) = 0._wp
+      zprbio  (:,:,:) = 0._wp
+      zprdch  (:,:,:) = 0._wp
+      zprnch  (:,:,:) = 0._wp
+      zysopt  (:,:,:) = 0._wp
+
+      ! Computation of the optimal production
+      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 
+      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 
+
+      ! 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
+
+      IF( ln_newprod ) THEN
+         ! Impact of the day duration on phytoplankton growth
+         DO jk = 1, jpkm1
+            DO jj = 1 ,jpj
+               DO ji = 1, jpi
+                  zval = MAX( 1., zstrn(ji,jj) )
+                  zval = 1.5 * zval / ( 12. + zval )
+                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval
+                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      ! Maximum light intensity
+      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.
+      zstrn(:,:) = 24. / zstrn(:,:)
+
+      IF( ln_newprod ) THEN
+!CDIR NOVERRCHK
+         DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+
+                  ! Computation of the P-I slope for nanos and diatoms
+                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
+                      zadap  = ztn / ( 2.+ ztn )
+
+                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 )
+                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp
+
+                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
+                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
+
+                      zfact  = EXP( -0.21 * znanotot )
+                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  &
+                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn)
+
+                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   &
+                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn)
+
+                      ! Computation of production function for Carbon
+                      !  ---------------------------------------------
+                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcnm ) * rday + rtrn)
+                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcdm ) * rday + rtrn)
+                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  )
+                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  )
+
+                      !  Computation of production function for Chlorophyll
+                      !--------------------------------------------------
+                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn )
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ELSE
+!CDIR NOVERRCHK
+         DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+
+                  ! Computation of the P-I slope for nanos and diatoms
+                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. )
+                      zadap  = ztn / ( 2.+ ztn )
+
+                      zfact  = EXP( -0.21 * enano(ji,jj,jk) )
+                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )
+                      zpislopead2(ji,jj,jk) = pislope2
+
+                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                &
+                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   &
+                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn )
+
+                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                &
+                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   &
+                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn )
+
+                      ! Computation of production function for Carbon
+                      !  ---------------------------------------------
+                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) )
+                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) )
+
+                      !  Computation of production function for Chlorophyll
+                      !--------------------------------------------------
+                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) )
+                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !  Computation of a proxy of the N/C ratio
+      !  ---------------------------------------
+!CDIR NOVERRCHK
+      DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+                zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn )
+                quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
+                zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn )
+                quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval )
+            END DO
+         END DO
+      END DO
+
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+
+                IF( etot(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  = trn(ji,jj,jk,jpsil) / ( trn(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 = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) )
+                  zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 )
+                  zsilfac = MIN( 5.4, zsilfac * zsilfac2)
+                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac
+              ENDIF
+            END DO
+         END DO
+      END DO
+
+      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) )
+            zmxlday = zmxltst * zmxltst * r1_rday
+            zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday )
+            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday )
+         END DO
+      END DO
+ 
+      !  Mixed-layer effect on production                                                                               
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj)
+                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj)
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      ! Computation of the various production terms 
+!CDIR NOVERRCHK
+      DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                  !  production terms for nanophyto.
+                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2
+                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn )
+                  !
+                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn )
+                  zratio = zratio / fecnm 
+                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  &
+                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    &
+                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) )  &
+                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2
+                  !  production terms for diatomees
+                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2
+                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn )
+                  !
+                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn )
+                  zratio = zratio / fecdm 
+                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 
+                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  &
+                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    &
+                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) )  &
+                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_newprod ) THEN
+!CDIR NOVERRCHK
+         DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN
+                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj)
+                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj)
+                  ENDIF
+                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                     !  production terms for nanophyto. ( chlorophyll )
+                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
+                     zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk)
+                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk)
+                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / (  zpislopead(ji,jj,jk) * znanotot +rtrn)
+                     !  production terms for diatomees ( chlorophyll )
+                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
+                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk)
+                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk)
+                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ELSE
+!CDIR NOVERRCHK
+         DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+            DO jj = 1, jpj
+!CDIR NOVERRCHK
+               DO ji = 1, jpi
+                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN
+                     !  production terms for nanophyto. ( chlorophyll )
+                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj)
+                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk)
+                     zprochln(ji,jj,jk) = chlcnm * 144. * zprod / (  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn)
+                     !  production terms for diatomees ( chlorophyll )
+                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj)
+                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk)
+                     zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn )
+                  ENDIF
+               END DO
+            END DO
+         END DO
+      ENDIF
+
+      !   Update the arrays TRA which contain the biological sources and sinks
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+           DO ji =1 ,jpi
+              zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk)
+              zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk)
+              tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
+              tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(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) + zprorca(ji,jj,jk) * texcret
+              tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret
+              tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret
+              tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2
+              tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2
+              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2
+              tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2
+              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk)
+              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) &
+                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) )
+              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk)
+              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk)
+              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk)
+              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) &
+                 &                                      - rno3 * ( zproreg + zproreg2 )
+          END DO
+        END DO
+     END DO
+
+     ! Total primary production per year
+     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )
+
+     IF( kt == nitend .AND. jnt == nrdttrc ) THEN
+        WRITE(numout,*) 'Total PP (Gtc) :'
+        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12
+        WRITE(numout,*) 
+      ENDIF
+
+     IF( ln_diatrc ) THEN
+         !
+         zrfact2 = 1.e3 * rfact2r  ! conversion from mol/L/timestep into mol/m3/s
+         IF( lk_iomput ) THEN
+           IF( jnt == nrdttrc ) THEN
+              CALL iom_put( "PPPHY"   , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto
+              CALL iom_put( "PPPHY2"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom
+              CALL iom_put( "PPNEWN"  , zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto
+              CALL iom_put( "PPNEWD"  , zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom
+              CALL iom_put( "PBSi"    , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production
+              CALL iom_put( "PFeD"    , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom
+              CALL iom_put( "PFeN"    , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto
+              CALL iom_put( "Mumax"   , prmax   (:,:,:) * tmask(:,:,:) )  ! Maximum growth rate
+              CALL iom_put( "MuN"     , zprbio  (:,:,:) * xlimphy(:,:,:) * tmask(:,:,:) )  ! Realized growth rate for nanophyto
+              CALL iom_put( "MuD"     , zprdia  (:,:,:) * xlimdia(:,:,:) * tmask(:,:,:) )  ! Realized growth rate for diatoms
+              CALL iom_put( "MuNlight", zprbio  (:,:,:) * tmask(:,:,:) )  ! Light limited growth rate phytoplankton
+              CALL iom_put( "MuDlight", zprdia  (:,:,:) * tmask(:,:,:) )  ! Light limited growth rate diatoms
+              CALL iom_put( "LNnut"   , xlimphy (:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+              CALL iom_put( "LDnut"   , xlimdia (:,:,:) * tmask(:,:,:) )  ! Nutrient limitation term
+              CALL iom_put( "LNFe"    , xlimnfe (:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+              CALL iom_put( "LDFe"    , xlimdfe (:,:,:) * tmask(:,:,:) )  ! Iron limitation term
+              CALL iom_put( "LNlight" , zprbio  (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) )  ! light limitation term
+              CALL iom_put( "LDlight" , zprdia  (:,:,:) / (prmax(:,:,:) + rtrn) * tmask(:,:,:) )  ! light limitation term
+           ENDIF
+         ELSE
+              trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:)
+              trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:)
+              trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:)
+              trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:)
+              trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:)
+              trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:)
+#  if ! defined key_kriest
+              trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:)
+#  endif
+         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, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            ) 
+      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, 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/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  &
+         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip
+      !!----------------------------------------------------------------------
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampisprod )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod'
+         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                                 pislope      =', pislope
+         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret
+         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2
+         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                    pislope2     =', pislope2
+         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 
+      texcret   = 1._wp - excret
+      texcret2  = 1._wp - excret2
+      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
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_prod                    ! Empty routine
+   END SUBROUTINE p4z_prod
+#endif 
+
+   !!======================================================================
+END MODULE  p4zprod
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90	(revision 3437)
@@ -0,0 +1,461 @@
+MODULE p4zrem
+   !!======================================================================
+   !!                         ***  MODULE p4zrem  ***
+   !! TOP :   PISCES Compute remineralization/scavenging 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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_top'       and                                      TOP models
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   p4z_rem       :  Compute remineralization/scavenging 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 p4zopt          !  optical model
+   USE p4zche          !  chemical model
+   USE p4zprod         !  Growth rate of the 2 phyto groups
+   USE p4zmeso         !  Sources and sinks of mesozooplankton
+   USE p4zint          !  interpolation and computation of various fields
+   USE prtctl_trc      !  print control for debugging
+
+   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 ::  xremik    = 0.3_wp     !: remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  xremip    = 0.025_wp   !: remineralisation rate of DOC
+   REAL(wp), PUBLIC ::  nitrif    = 0.05_wp    !: NH4 nitrification rate 
+   REAL(wp), PUBLIC ::  xsirem    = 0.003_wp   !: remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  xsiremlab = 0.025_wp   !: fast remineralisation rate of POC 
+   REAL(wp), PUBLIC ::  xsilab    = 0.31_wp    !: fraction of labile biogenic silica 
+   REAL(wp), PUBLIC ::  xlam1     = 0.005_wp   !: scavenging rate of Iron 
+   REAL(wp), PUBLIC ::  oxymin    = 1.e-6_wp   !: halk saturation constant for anoxia 
+   REAL(wp), PUBLIC ::  ligand    = 0.6E-9_wp  !: ligand concentration in the ocean 
+
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   -
+
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE p4z_rem( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_rem  ***
+      !!
+      !! ** Purpose :   Compute remineralization/scavenging of organic compounds
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) ::   kt ! ocean time step
+      !
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zremip, zremik , zlam1b, zdepbac2
+      REAL(wp) ::   zkeq  , zfeequi, zsiremin, zfesatur
+      REAL(wp) ::   zsatur, zsatur2, znusil, zdep, zfactdep
+      REAL(wp) ::   zbactfer, zorem, zorem2, zofer
+      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe, zcoag
+#if ! defined key_kriest
+      REAL(wp) ::   zofer2, zdenom, zdenom2
+#endif
+      REAL(wp) ::   zlamfac, zonitr, zstep
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac 
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zolimi2
+      !!---------------------------------------------------------------------
+      !
+      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, zolimi, zolimi2 )
+
+       ! Initialisation of temprary arrys
+       zdepbac (:,:,:) = 0._wp
+       zolimi  (:,:,:) = 0._wp
+       zolimi2 (:,:,:) = 0._wp
+       ztempbac(:,:)   = 0._wp
+
+      !  Computation of the mean phytoplankton concentration as
+      !  a crude estimate of the bacterial biomass
+      !   --------------------------------------------------
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zdep = MAX( hmld(ji,jj), heup(ji,jj) )
+               IF( fsdept(ji,jj,jk) < zdep ) THEN
+                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 )
+                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
+               ELSE
+                  zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj)
+               ENDIF
+            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  - trn(ji,jj,jk,jpoxy) )    &
+                  &                                / ( oxymin + trn(ji,jj,jk,jpoxy) )  )
+               nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) )
+            END DO
+         END DO
+      END DO
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               ! DOC ammonification. Depends on depth, phytoplankton biomass
+               !     and a limitation term which is supposed to be a parameterization
+               !     of the bacterial activity. 
+               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
+               zremik = MAX( zremik, 2.e-4 * xstep )
+               !     Ammonification in oxic waters with oxygen consumption
+               !     -----------------------------------------------------
+               zolimi (ji,jj,jk) = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) 
+               zolimi2(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimi(ji,jj,jk) ) 
+               !     Ammonification in suboxic waters with denitrification
+               !     -------------------------------------------------------
+               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
+                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  )
+               !
+               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
+               zolimi2(ji,jj,jk) = MAX( 0.e0, zolimi2(ji,jj,jk) )
+               denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
+               !
+            END DO
+         END DO
+      END DO
+
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               !    NH4 nitrification to NO3. Ceased for oxygen concentrations
+               !    below 2 umol/L. Inhibited at strong light 
+               !    ----------------------------------------------------------
+               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
+               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
+               !   Update of the tracers trends
+               !   ----------------------------
+               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk)
+               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk)
+               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. ) * denitnh4(ji,jj,jk)
+            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
+               !    ----------------------------------------------------------
+               zdepbac2 = zdepbac(ji,jj,jk) * zdepbac(ji,jj,jk)
+               zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk)                                 &
+                  &              * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) )    &
+                  &              * zdepbac2 / ( xkgraz2 + zdepbac(ji,jj,jk) )               &
+                  &              * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  )
+
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer
+#if defined key_kriest
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer
+#else
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer
+#endif
+            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
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               !    POC disaggregation by turbulence and bacterial activity. 
+               !    -------------------------------------------------------------
+               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.7 * nitrfac(ji,jj,jk) ) 
+
+               !    POC disaggregation rate is reduced in anoxic zone as shown by
+               !    sediment traps data. In oxic area, the exponent of the martin s
+               !    law is around -0.87. In anoxic zone, it is around -0.35. This
+               !    means a disaggregation constant about 0.5 the value in oxic zones
+               !    -----------------------------------------------------------------
+               zorem  = zremip * trn(ji,jj,jk,jppoc)
+               zofer  = zremip * trn(ji,jj,jk,jpsfe)
+#if ! defined key_kriest
+               zorem2 = zremip * trn(ji,jj,jk,jpgoc)
+               zofer2 = zremip * trn(ji,jj,jk,jpbfe)
+#else
+               zorem2 = zremip * trn(ji,jj,jk,jpnum)
+#endif
+
+               !  Update the appropriate tracers trends
+               !  -------------------------------------
+
+               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer
+#if defined key_kriest
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem
+               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
+#else
+               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem
+               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2
+#endif
+
+            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
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               !     Remineralization rate of BSi depedant on T and saturation
+               !     ---------------------------------------------------------
+               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
+               zsatur   = MAX( rtrn, zsatur )
+               zsatur2  = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4
+               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9.25
+               zdep     = MAX( hmld(ji,jj), heup(ji,jj) ) 
+               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep )
+               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 )
+               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
+               zosil    = zsiremin * trn(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="('rem4')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+       ENDIF
+
+      zfesatur = ligand
+!CDIR NOVERRCHK
+      DO jk = 1, jpkm1
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zstep   = xstep
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               !  Compute de different ratios for scavenging of iron
+               !  --------------------------------------------------
+
+#if  defined key_kriest
+               zdenom1 = trn(ji,jj,jk,jppoc) / &
+           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgsi) + trn(ji,jj,jk,jpcal) + rtrn )
+#else
+               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpgsi) + trn(ji,jj,jk,jpcal) + rtrn )
+               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom
+               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom
+#endif
+               !  scavenging rate of iron. this scavenging rate depends on the load in particles
+               !  on which they are adsorbed. The  parameterization has been taken from studies on Th
+               !     ------------------------------------------------------------
+               zkeq = fekeq(ji,jj,jk)
+               zfeequi = ( -( 1. + zfesatur * zkeq - zkeq * trn(ji,jj,jk,jpfer) )               &
+                  &        + SQRT( ( 1. + zfesatur * zkeq - zkeq * trn(ji,jj,jk,jpfer) )**2       &
+                  &               + 4. * trn(ji,jj,jk,jpfer) * zkeq) ) / ( 2. * zkeq )
+
+#if defined key_kriest
+               zlam1b = 3.e-5 + xlam1 * (  trn(ji,jj,jk,jppoc)                   &
+                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi)  ) * 1.e6
+#else
+               zlam1b = 3.e-5 + xlam1 * (  trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)   &
+                  &                      + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpgsi)  ) * 1.e6
+#endif
+               zscave = zfeequi * zlam1b * zstep
+
+               !  Increased scavenging for very high iron concentrations
+               !  found near the coasts due to increased lithogenic particles
+               !  and let say it is unknown processes (precipitation, ...)
+               !  -----------------------------------------------------------
+               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1. ) )
+               zcoag   = zfeequi * zlam1b * zstep
+               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. )
+               zlamfac = MIN( 1.  , zlamfac )
+               zdep    =  MIN(1., 1000. / fsdept(ji,jj,jk) )
+#if ! defined key_kriest
+               zlam1b = (  80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 )                           &
+                  &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )    &
+                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep
+#else
+               zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)              &
+                  &     + 698.*  trn(ji,jj,jk,jppoc)  )                    &
+                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep
+#endif
+               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi )
+               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag
+#if defined key_kriest
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1
+#else
+               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1
+               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2
+#endif
+            END DO
+         END DO
+      END DO
+      !
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rem5')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+
+      !     Update the arrays TRA which contain the biological sources and sinks
+      !     --------------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)
+         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)
+         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit
+         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)
+         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi2(:,:,jk) * o2ut
+         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)
+         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) )
+      END DO
+
+      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
+         WRITE(charout, FMT="('rem6')")
+         CALL prt_ctl_trc_info(charout)
+         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      ztempbac                 )
+      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 )
+      !
+      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, xremip, nitrif, xsirem, xsiremlab, xsilab,   &
+      &                   xlam1, oxymin, ligand 
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampisrem )
+
+      IF(lwp) THEN                         ! control print
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip
+         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
+         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,*) '    scavenging rate of Iron                   xlam1     =', xlam1
+         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif
+         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin
+         WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand
+      ENDIF
+      !
+      nitrfac (:,:,:) = 0._wp
+      denitr  (:,:,:) = 0._wp
+      denitnh4(:,:,:) = 0._wp
+      !
+   END SUBROUTINE p4z_rem_init
+
+
+   INTEGER FUNCTION p4z_rem_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_rem_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(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
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_rem                    ! Empty routine
+   END SUBROUTINE p4z_rem
+#endif 
+
+   !!======================================================================
+END MODULE p4zrem
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90	(revision 3437)
@@ -0,0 +1,641 @@
+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  (O. Aumont, C. Ethe) USE of fldread
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   p4z_sed        :  Compute loss of organic matter in the sediments
+   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
+   !!   p4z_sed_init   :  Initialization of p4z_sed
+   !!----------------------------------------------------------------------
+   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 p4zrem          !  Remineralisation of organic matter
+   USE p4zint          !  interpolation and computation of various fields
+   USE iom             !  I/O manager
+   USE fldread         !  time interpolation
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_sed   
+   PUBLIC   p4z_sed_init   
+   PUBLIC   p4z_sed_alloc
+
+   !! * Shared module variables
+   LOGICAL  :: ln_dust     = .FALSE.    !: boolean for dust input from the atmosphere
+   LOGICAL  :: ln_river    = .FALSE.    !: boolean for river input of nutrients
+   LOGICAL  :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N
+   LOGICAL  :: ln_ironsed  = .FALSE.    !: boolean for Fe input from sediments
+
+   REAL(wp) :: sedfeinput  = 1.E-9_wp   !: Coastal release of Iron
+   REAL(wp) :: dustsolub   = 0.014_wp   !: Solubility of the dust
+   REAL(wp) :: wdust       = 2.0_wp     !: Sinking speed of the dust 
+   REAL(wp) :: nitrfix     = 1E-7_wp    !: Nitrogen fixation rate   
+   REAL(wp) :: diazolight  = 50._wp     !: Nitrogen fixation sensitivty to light 
+   REAL(wp) :: concfediaz  = 1.E-10_wp  !: Fe half-saturation Cste for diazotrophs 
+
+
+   !! * Module variables
+   REAL(wp) :: ryyss                  !: number of seconds per year 
+   REAL(wp) :: r1_ryyss                 !: inverse of ryyss
+   REAL(wp) :: rmtss                  !: number of seconds per month
+   REAL(wp) :: r1_rday                  !: inverse of rday
+   LOGICAL  :: ll_sbc
+
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdic  ! structure of input riverdic
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdoc  ! structure of input riverdoc
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
+
+   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
+
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust      !: dust fields
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivinp, cotdep    !: river input fields
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition 
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron
+
+   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header:$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE p4z_sed( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  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, jnt ! ocean time step
+      INTEGER  ::   ji, jj, jk, ikt
+#if ! defined key_sed
+      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
+      REAL(wp) ::   zrivalk, zrivsil, zrivpo4
+#endif
+      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact, zfactcal
+      REAL(wp) ::   zsiloss, zcaloss, zwsbio3, zwsbio4, zwscal, zdep
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sed')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 )
+      CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zirondep             )
+
+      IF( jnt == 1 .AND. ll_sbc ) CALL p4z_sbc( kt )
+
+      zirondep(:,:,:) = 0.e0          ! Initialisation of variables USEd to compute deposition
+      zsidep  (:,:)   = 0.e0
+
+      ! Iron and Si deposition at the surface
+      ! -------------------------------------
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            zdep  = rfact2 / fse3t(ji,jj,1)
+            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss ) * zdep
+            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * zdep / ( 28.1 * rmtss )
+         END DO
+      END DO
+
+      ! Iron solubilization of particles in the water column
+      ! ----------------------------------------------------
+      DO jk = 2, jpkm1
+         zirondep(:,:,jk) = dust(:,:) / ( wdust * 55.85 * rmtss ) * rfact2 * 1.e-4 * EXP( -fsdept(:,:,jk) / 1000. )
+      END DO
+
+      ! Add the external input of nutrients, carbon and alkalinity
+      ! ----------------------------------------------------------
+      trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2 
+      trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2
+      trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivinp(:,:) * 3.e-5 * rfact2
+      trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) + cotdep(:,:)   * rfact2 / 6.
+      trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivinp(:,:) * 2.631 * rfact2
+      trn(:,:,1,jptal) = trn(:,:,1,jptal) + (cotdep(:,:) - rno3*(rivinp(:,:) +  nitdep(:,:) ) ) * rfact2
+
+
+      ! Add the external input of iron which is 3D distributed
+      ! (dust, river and sediment mobilization)
+      ! ------------------------------------------------------
+      DO jk = 1, jpkm1
+         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2
+      END DO
+
+#if ! defined key_sed
+      ! 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
+            ikt = mbkt(ji,jj) 
+# if defined key_kriest
+            zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * wscal (ji,jj,ikt)
+            zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
+# else
+            zwork1(ji,jj) = trn(ji,jj,ikt,jpgsi) * wsbio4(ji,jj,ikt)
+            zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
+# endif
+            ! For calcite, burial efficiency is made a function of saturation
+            zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
+            zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
+            zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 * zfactcal
+         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
+
+      ! THEN 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 ! defined key_sed
+      zrivsil =  1._wp - ( sumdepsi + rivalkinput * r1_ryyss / 6. ) / zsumsedsi 
+      zrivpo4 =  1._wp - ( rivpo4input * r1_ryyss ) / zsumsedpo4 
+#endif
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / fse3t(ji,jj,ikt)
+            zwsbio4 = wsbio4(ji,jj,ikt) * zdep
+            zwscal  = wscal (ji,jj,ikt) * zdep
+# if defined key_kriest
+            zsiloss = trn(ji,jj,ikt,jpgsi) * zwsbio4
+# else
+            zsiloss = trn(ji,jj,ikt,jpgsi) * zwscal
+# endif
+            zcaloss = trn(ji,jj,ikt,jpcal) * zwscal
+            !
+            trn(ji,jj,ikt,jpgsi) = trn(ji,jj,ikt,jpgsi) - zsiloss
+            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss
+#if ! defined key_sed
+            trn(ji,jj,ikt,jpsil) = trn(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 
+            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
+            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk
+#endif
+         END DO
+      END DO
+
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            ikt  = mbkt(ji,jj)
+            zdep = xstep / fse3t(ji,jj,ikt)
+            zwsbio4 = wsbio4(ji,jj,ikt) * zdep
+            zwsbio3 = wsbio3(ji,jj,ikt) * zdep
+# if ! defined key_kriest
+            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zwsbio4
+            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3
+            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zwsbio4
+            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3
+#if ! defined key_sed
+            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) &
+               &               + ( trn(ji,jj,ikt,jpgoc) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4
+#endif
+
+# else
+            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zwsbio4
+            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3
+            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3
+#if ! defined key_sed
+            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) &
+               &               + ( trn(ji,jj,ikt,jpnum) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4
+#endif
+
+# endif
+         END DO
+      END DO
+
+
+      ! Nitrogen fixation (simple parameterization). The total gain
+      ! from nitrogen fixation is scaled to balance the loss by 
+      ! denitrification
+      ! -------------------------------------------------------------
+
+      zdenitot = glob_sum(  ( denitr(:,:,:) * rdenit + denitnh4(:,:,:) * rdenita ) * cvol(:,:,:) ) 
+
+      ! Potential nitrogen fixation dependant on temperature and iron
+      ! -------------------------------------------------------------
+
+!CDIR NOVERRCHK
+      DO jk = 1, jpk
+!CDIR NOVERRCHK
+         DO jj = 1, jpj
+!CDIR NOVERRCHK
+            DO ji = 1, jpi
+               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
+               IF( zlim <= 0.2 )   zlim = 0.01
+#if defined key_degrad
+               zfact = zlim * rfact2 * facvol(ji,jj,jk)
+#else
+               zfact = zlim * rfact2 
+#endif
+               znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
+                 &                 *  zfact * trn(ji,jj,jk,jpfer) / ( concfediaz + trn(ji,jj,jk,jpfer) ) &
+                 &                 * ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) )
+            END DO
+         END DO 
+      END DO
+
+      znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) )
+
+      ! Nitrogen change due to nitrogen fixation
+      ! ----------------------------------------
+      DO jk = 1, jpk
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zfact = znitrpot(ji,jj,jk) * nitrfix
+               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
+               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact
+               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit
+               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30. / 46. * zfact
+           !    trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + zfact
+           END DO
+         END DO 
+      END DO
+      !
+      IF( ln_diatrc ) THEN
+         zfact = 1.e+3 * rfact2r
+         IF( lk_iomput ) THEN
+            zwork1(:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 
+            zwork2(:,:)  =    znitrpot(:,:,1) * nitrfix                   * zfact * fse3t(:,:,1) * tmask(:,:,1)
+            IF( jnt == nrdttrc ) THEN
+               CALL iom_put( "Irondep", zwork1  )  ! surface downward net flux of iron
+               CALL iom_put( "Nfix"   , zwork2 )  ! nitrogen fixation at surface
+            ENDIF
+         ELSE
+            trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)           * zfact * fse3t(:,:,1) * tmask(:,:,1)
+            trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1)
+         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=trn, mask=tmask, clinfo=ctrcnm)
+      ENDIF
+      !
+      CALL wrk_dealloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 )
+      CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zirondep             )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
+      !
+   END SUBROUTINE p4z_sed
+
+   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
+      !!---------------------------------------------------------------------
+      !
+      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 )
+            dust(:,:) = sf_dust(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_riverdic )
+            CALL fld_read( kt, 1, sf_riverdoc )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  zcoef = ryyss * cvol(ji,jj,1) 
+                  cotdep(ji,jj) =   sf_riverdic(1)%fnow(ji,jj,1)                                  * 1E9 / ( 12. * zcoef + rtrn )
+                  rivinp(ji,jj) = ( sf_riverdic(1)%fnow(ji,jj,1) + sf_riverdoc(1)%fnow(ji,jj,1) ) * 1E9 / ( 31.6* zcoef + rtrn )
+               END DO
+            END DO
+         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
+            CALL fld_read( kt, 1, sf_ndepo )
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  nitdep(ji,jj) = 7.6 * sf_ndepo(1)%fnow(ji,jj,1) / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )
+               END DO
+            END DO
+         ENDIF
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc')
+      !
+   END SUBROUTINE p4z_sbc
+
+   SUBROUTINE p4z_sed_init
+
+      !!----------------------------------------------------------------------
+      !!                  ***  routine p4z_sed_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
+      INTEGER  :: numdust, numriv, numiron, numdepo
+      INTEGER  :: ierr, ierr1, ierr2, ierr3
+      REAL(wp) :: zexpide, zdenitide, zmaskt
+      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
+      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriverdic, zriverdoc, zcmask
+      !
+      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
+      TYPE(FLD_N) ::   sn_dust, sn_riverdoc, sn_riverdic, sn_ndepo, sn_ironsed        ! informations about the fields to be read
+      NAMELIST/nampissed/cn_dir, sn_dust, sn_riverdic, sn_riverdoc, sn_ndepo, sn_ironsed, &
+        &                ln_dust, ln_river, ln_ndepo, ln_ironsed,         &
+        &                sedfeinput, dustsolub, wdust, nitrfix, diazolight, concfediaz 
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sed_init')
+      !
+      !                                    ! number of seconds per year and per month
+      ryyss    = nyear_len(1) * rday
+      rmtss    = ryyss / raamo
+      r1_rday  = 1. / rday
+      r1_ryyss = 1. / ryyss
+      !                            !* set file information
+      cn_dir  = './'            ! directory in which the model is executed
+      ! ... default values (NB: frequency positive => hours, negative => months)
+      !                  !   file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   !
+      !                  !   name       !  (hours)  !   name      !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      !
+      sn_dust     = FLD_N( 'dust'       ,    -1     ,  'dust'     ,  .true.    , .true.  ,   'yearly'  , ''       , ''         )
+      sn_riverdic = FLD_N( 'river'      ,   -12     ,  'riverdic' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         )
+      sn_riverdoc = FLD_N( 'river'      ,   -12     ,  'riverdoc' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         )
+      sn_ndepo    = FLD_N( 'ndeposition',   -12     ,  'ndep'     ,  .false.   , .true.  ,   'yearly'  , ''       , ''         )
+      sn_ironsed  = FLD_N( 'ironsed'    ,   -12     ,  'bathy'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''         )
+
+      REWIND( numnatp )                     ! read numnatp
+      READ  ( numnatp, nampissed )
+
+      IF(lwp) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) ' namelist : nampissed '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
+         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust
+         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_sedinput = ', ln_ironsed
+         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput
+         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub
+         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
+       END IF
+
+      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN
+          ll_sbc = .TRUE.
+      ELSE
+          ll_sbc = .FALSE.
+      ENDIF
+
+      ! dust input from the atmosphere
+      ! ------------------------------
+      IF( ln_dust ) THEN 
+         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
+         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
+         !
+         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_apr structure' )
+         !
+         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' )
+                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
+         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
+         !
+         ! 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 )
+         sumdepsi = 0.e0
+         DO jm = 1, ntimes_dust
+            sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) ) 
+         ENDDO
+         sumdepsi = sumdepsi * r1_ryyss * 8.8 * 0.075 / 28.1 
+         DEALLOCATE( zdust)
+      ELSE
+         dust(:,:) = 0._wp
+         sumdepsi  = 0._wp
+      END IF
+
+      ! nutrient input from rivers
+      ! --------------------------
+      IF( ln_river ) THEN
+         ALLOCATE( sf_riverdic(1), STAT=ierr1 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         ALLOCATE( sf_riverdoc(1), STAT=ierr2 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
+         IF( ierr1 + ierr2 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' )
+         !
+         CALL fld_fill( sf_riverdic, (/ sn_riverdic /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' )
+         CALL fld_fill( sf_riverdoc, (/ sn_riverdoc /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' )
+                                   ALLOCATE( sf_riverdic(1)%fnow(jpi,jpj,1)   )
+                                   ALLOCATE( sf_riverdoc(1)%fnow(jpi,jpj,1)   )
+         IF( sn_riverdic%ln_tint ) ALLOCATE( sf_riverdic(1)%fdta(jpi,jpj,1,2) )
+         IF( sn_riverdoc%ln_tint ) ALLOCATE( sf_riverdoc(1)%fdta(jpi,jpj,1,2) )
+         ! Get total input rivers ; need to compute total river supply in a year
+         CALL iom_open ( TRIM( sn_riverdic%clname ), numriv )
+         CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv)
+         ALLOCATE( zriverdic(jpi,jpj,ntimes_riv) )   ;     ALLOCATE( zriverdoc(jpi,jpj,ntimes_riv) )
+         DO jm = 1, ntimes_riv
+            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdic%clvar ), zriverdic(:,:,jm), jm )
+            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdoc%clvar ), zriverdoc(:,:,jm), jm )
+         END DO
+         CALL iom_close( numriv )
+         ! N/P and Si releases due to coastal rivers
+         ! -----------------------------------------
+         rivpo4input = 0._wp 
+         rivalkinput = 0._wp 
+         DO jm = 1, ntimes_riv
+            rivpo4input = rivpo4input + glob_sum( ( zriverdic(:,:,jm) + zriverdoc(:,:,jm) ) * tmask(:,:,1) ) 
+            rivalkinput = rivalkinput + glob_sum(   zriverdic(:,:,jm)                       * tmask(:,:,1) ) 
+         END DO
+         rivpo4input = rivpo4input * 1E9 / 31.6_wp
+         rivalkinput = rivalkinput * 1E9 / 12._wp 
+         DEALLOCATE( zriverdic)   ;    DEALLOCATE( zriverdoc) 
+      ELSE
+         rivinp(:,:) = 0._wp
+         cotdep(:,:) = 0._wp
+         rivpo4input = 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( 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_apr structure' )
+         !
+         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' )
+                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   )
+         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
+         !
+         ! 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 )
+         nitdepinput = 0._wp
+         DO jm = 1, ntimes_ndep
+           nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) ) 
+         ENDDO
+         nitdepinput = nitdepinput * 7.6 / 14E6 
+         DEALLOCATE( zndepo)
+      ELSE
+         nitdep(:,:) = 0._wp
+         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,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         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 )
+         !
+         DO jk = 1, 5
+            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.,( fsdept(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) / ( fse3t(:,:,jk) * rday )
+         END DO
+         DEALLOCATE( zcmask)
+      ELSE
+         ironsed(:,:,:) = 0._wp
+      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   : ', rivpo4input/7.6*1E3/1E12*14.,' TgN/yr'
+         WRITE(numout,*) '    Si Supply  : ', rivalkinput/6.*1E3/1E12*32.,' TgSi/yr'
+         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr'
+         WRITE(numout,*) '    DIC Supply : ', rivpo4input*2.631*1E3*12./1E12,'TgC/yr'
+         WRITE(numout,*) 
+         WRITE(numout,*) '    Total input of elements from atmospheric supply'
+         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+         WRITE(numout,*) '    N Supply   : ', nitdepinput/7.6*1E3/1E12*14.,' TgN/yr'
+         WRITE(numout,*) 
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed_init')
+      !
+   END SUBROUTINE p4z_sed_init
+
+   INTEGER FUNCTION p4z_sed_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sed_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( dust  (jpi,jpj), rivinp(jpi,jpj)     , cotdep(jpi,jpj),      &
+        &       nitdep(jpi,jpj), ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )  
+
+      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.')
+
+   END FUNCTION p4z_sed_alloc
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_sed                         ! Empty routine
+   END SUBROUTINE p4z_sed
+#endif 
+
+   !!======================================================================
+END MODULE  p4zsed
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90	(revision 3437)
@@ -0,0 +1,740 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   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
+
+   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(:,:,:) ::   wsbio3   !: POC sinking speed 
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes 
+   !                                                          !  (different meanings depending on the parameterization)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes
+#if ! defined key_kriest
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes
+#endif
+
+   INTEGER  :: iksed  = 10
+
+#if  defined key_kriest
+   REAL(wp) ::  xkr_sfact    = 250.     !: Sinking factor
+   REAL(wp) ::  xkr_stick    = 0.2      !: Stickiness
+   REAL(wp) ::  xkr_nnano    = 2.337    !: Nbr of cell in nano size class
+   REAL(wp) ::  xkr_ndiat    = 3.718    !: Nbr of cell in diatoms size class
+   REAL(wp) ::  xkr_nmeso    = 7.147    !: Nbr of cell in mesozoo  size class
+   REAL(wp) ::  xkr_naggr    = 9.877    !: Nbr of cell in aggregates  size class
+
+   REAL(wp) ::  xkr_frac 
+
+   REAL(wp), PUBLIC ::  xkr_dnano       !: Size of particles in nano pool
+   REAL(wp), PUBLIC ::  xkr_ddiat       !: Size of particles in diatoms pool
+   REAL(wp), PUBLIC ::  xkr_dmeso       !: Size of particles in mesozoo pool
+   REAL(wp), PUBLIC ::  xkr_daggr       !: Size of particles in aggregates pool
+   REAL(wp), PUBLIC ::  xkr_wsbio_min   !: min vertical particle speed
+   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed
+
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates
+#endif
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+#if defined key_kriest
+   !!----------------------------------------------------------------------
+   !!   'key_kriest'                                                    ???
+   !!----------------------------------------------------------------------
+
+   SUBROUTINE p4z_sink ( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                ***  ROUTINE p4z_sink  ***
+      !!
+      !! ** Purpose :   Compute vertical flux of particulate matter due to
+      !!              gravitational sinking - Kriest parameterization
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT(in) :: kt, jnt
+      !
+      INTEGER  :: ji, jj, jk
+      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh
+      REAL(wp) :: zagg , zaggdoc, znumdoc
+      REAL(wp) :: znum , zeps, zfm, zgm, zsm
+      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5
+      REAL(wp) :: zval1, zval2, zval3, zval4
+      REAL(wp) :: zrfact2
+      INTEGER  :: ik1
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink')
+      !
+      CALL wrk_alloc( jpi, jpj, jpk, znum3d )
+      !
+      !     Initialisation of variables used to compute Sinking Speed
+      !     ---------------------------------------------------------
+
+      znum3d(:,:,:) = 0.e0
+      zval1 = 1. + xkr_zeta
+      zval2 = 1. + xkr_zeta + xkr_eta
+      zval3 = 1. + xkr_eta
+
+      !     Computation of the vertical sinking speed : Kriest et Evans, 2000
+      !     -----------------------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
+                  znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp
+                  ! -------------- To avoid sinking speed over 50 m/day -------
+                  znum  = MIN( xnumm(jk), znum )
+                  znum  = MAX( 1.1      , znum )
+                  znum3d(ji,jj,jk) = znum
+                  !------------------------------------------------------------
+                  zeps  = ( zval1 * znum - 1. )/ ( znum - 1. )
+                  zfm   = xkr_frac**( 1. - zeps )
+                  zgm   = xkr_frac**( zval1 - zeps )
+                  zdiv  = MAX( 1.e-4, ABS( zeps - zval2 ) ) * SIGN( 1., ( zeps - zval2 ) )
+                  zdiv1 = zeps - zval3
+                  wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    &
+                     &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv
+                  wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   &
+                     &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1
+                  IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk)
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50._wp )
+
+      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS
+      !   -----------------------------------------
+
+      sinking (:,:,:) = 0.e0
+      sinking2(:,:,:) = 0.e0
+      sinkcal (:,:,:) = 0.e0
+      sinkfer (:,:,:) = 0.e0
+      sinksil (:,:,:) = 0.e0
+
+     !   Compute the sedimentation term using p4zsink2 for all the sinking particles
+     !   -----------------------------------------------------
+
+      CALL p4z_sink2( wsbio3, sinking , jppoc )
+      CALL p4z_sink2( wsbio4, sinking2, jpnum )
+      CALL p4z_sink2( wsbio3, sinkfer , jpsfe )
+      CALL p4z_sink2( wscal , sinksil , jpgsi )
+      CALL p4z_sink2( wscal , sinkcal , jpcal )
+
+     !  Exchange between organic matter compartments due to coagulation/disaggregation
+     !  ---------------------------------------------------
+
+      zval1 = 1. + xkr_zeta
+      zval2 = 1. + xkr_eta
+      zval3 = 3. + xkr_eta
+      zval4 = 4. + xkr_eta
+
+      DO jk = 1,jpkm1
+         DO jj = 1,jpj
+            DO ji = 1,jpi
+               IF( tmask(ji,jj,jk) /= 0.e0 ) THEN
+
+                  znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp
+                  !-------------- To avoid sinking speed over 50 m/day -------
+                  znum  = min(xnumm(jk),znum)
+                  znum  = MAX( 1.1,znum)
+                  !------------------------------------------------------------
+                  zeps  = ( zval1 * znum - 1.) / ( znum - 1.)
+                  zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 )
+                  zdiv1 = MAX( 1.e-4, ABS( zeps - 4.   ) ) * SIGN( 1., zeps - 4.    )
+                  zdiv2 = zeps - 2.
+                  zdiv3 = zeps - 3.
+                  zdiv4 = zeps - zval2
+                  zdiv5 = 2.* zeps - zval4
+                  zfm   = xkr_frac**( 1.- zeps )
+                  zsm   = xkr_frac**xkr_eta
+
+                  !    Part I : Coagulation dependant on turbulence
+                  !    ----------------------------------------------
+
+                  zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2               &
+                     &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    &
+                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    &
+                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  &
+                     &            * (zeps-1.)**2/(zdiv2*zdiv3)) 
+                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       &
+                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          &
+                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 &
+                     &                    +xkr_mass_max*xkr_mass_min**2*(zeps-1.)/zdiv3)    &
+                     &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  &
+                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           &
+                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))    
+
+                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3  
+                  
+                 !    Aggregation of small into large particles
+                 !    Part II : Differential settling
+                 !    ----------------------------------------------
+
+                  zagg4 =  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       &
+                     &                 xkr_wsbio_min*(zeps-1.)**2                         &
+                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      &
+                     &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       &
+                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     &
+                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )   
+
+                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         &
+                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        &
+                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         &
+                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    &
+                     &                 /zdiv)  
+                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10.
+
+                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
+
+                  !     Aggregation of DOC to small particles
+                  !     --------------------------------------
+
+                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               &
+                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    &
+                     &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc)
+
+# if defined key_degrad
+                   zagg1   = zagg1   * facvol(ji,jj,jk)                 
+                   zagg2   = zagg2   * facvol(ji,jj,jk)                 
+                   zagg3   = zagg3   * facvol(ji,jj,jk)                 
+                   zagg4   = zagg4   * facvol(ji,jj,jk)                 
+                   zagg5   = zagg5   * facvol(ji,jj,jk)                 
+                   zaggdoc = zaggdoc * facvol(ji,jj,jk)                 
+# endif
+                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000.
+                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10.
+                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi )
+                  !
+                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn )
+                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc
+                  tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zaggdoc * znumdoc - zagg
+                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc
+
+               ENDIF
+            END DO
+         END DO
+      END DO
+
+      IF( ln_diatrc ) THEN
+         !
+         ik1 = iksed + 1
+         zrfact2 = 1.e3 * rfact2r
+         IF( jnt == nrdttrc ) THEN
+           CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export
+           CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export
+           CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export
+           CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export
+           CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats
+           CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC
+           CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats
+           CALL iom_put( "PMO"     , sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! POC export at 100m
+           CALL iom_put( "PMO2"    , sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Num export at 100m
+           CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m
+           CALL iom_put( "ExpSi"   , sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m
+           CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m
+         ENDIF
+# if ! defined key_iomput
+         trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1)
+         trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1)
+         trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1)
+         trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1)
+         trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1)
+         trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:)
+         trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:)
+# 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
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, znum3d )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink')
+      !
+   END SUBROUTINE p4z_sink
+
+
+   SUBROUTINE p4z_sink_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE p4z_sink_init  ***
+      !!
+      !! ** Purpose :   Initialization of sinking parameters
+      !!                Kriest parameterization only
+      !!
+      !! ** Method  :   Read the nampiskrs namelist and check the parameters
+      !!      called at the first timestep 
+      !!
+      !! ** input   :   Namelist nampiskrs
+      !!----------------------------------------------------------------------
+      INTEGER  ::   jk, jn, kiter
+      REAL(wp) ::   znum, zdiv
+      REAL(wp) ::   zws, zwr, zwl,wmax, znummax
+      REAL(wp) ::   zmin, zmax, zl, zr, xacc
+      !
+      NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  &
+         &                xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink_init')
+      !
+      REWIND( numnatp )                     ! read nampiskrs
+      READ  ( numnatp, nampiskrs )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : nampiskrs'
+         WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact
+         WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick
+         WRITE(numout,*) '    Nbr of cell in nano size class           xkr_nnano    = ', xkr_nnano
+         WRITE(numout,*) '    Nbr of cell in diatoms size class        xkr_ndiat    = ', xkr_ndiat
+         WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso
+         WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr
+      ENDIF
+
+
+      ! max and min vertical particle speed
+      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta
+      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta
+      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max
+
+      !
+      !    effect of the sizes of the different living pools on particle numbers
+      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337
+      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718
+      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147
+      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877
+      !    doc aggregates = 1um
+      ! ----------------------------------------------------------
+
+      xkr_dnano = 1. / ( xkr_massp * xkr_nnano )
+      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat )
+      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso )
+      xkr_daggr = 1. / ( xkr_massp * xkr_naggr )
+
+      !!---------------------------------------------------------------------
+      !!    'key_kriest'                                                  ???
+      !!---------------------------------------------------------------------
+      !  COMPUTATION OF THE VERTICAL PROFILE OF MAXIMUM SINKING SPEED
+      !  Search of the maximum number of particles in aggregates for each k-level.
+      !  Bissection Method
+      !--------------------------------------------------------------------
+      WRITE(numout,*)
+      WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates'
+
+      xacc     =  0.001_wp
+      kiter    = 50
+      zmin     =  1.10_wp
+      zmax     = xkr_mass_max / xkr_mass_min
+      xkr_frac = zmax
+
+      DO jk = 1,jpk
+         zl = zmin
+         zr = zmax
+         wmax = 0.5 * fse3t(1,1,jk) * rday / rfact2
+         zdiv = xkr_zeta + xkr_eta - xkr_eta * zl
+         znum = zl - 1.
+         zwl =  xkr_wsbio_min * xkr_zeta / zdiv &
+            & - ( xkr_wsbio_max * xkr_eta * znum * &
+            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
+            & - wmax
+
+         zdiv = xkr_zeta + xkr_eta - xkr_eta * zr
+         znum = zr - 1.
+         zwr =  xkr_wsbio_min * xkr_zeta / zdiv &
+            & - ( xkr_wsbio_max * xkr_eta * znum * &
+            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
+            & - wmax
+iflag:   DO jn = 1, kiter
+            IF    ( zwl == 0._wp ) THEN   ;   znummax = zl
+            ELSEIF( zwr == 0._wp ) THEN   ;   znummax = zr
+            ELSE
+               znummax = ( zr + zl ) / 2.
+               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax
+               znum = znummax - 1.
+               zws =  xkr_wsbio_min * xkr_zeta / zdiv &
+                  & - ( xkr_wsbio_max * xkr_eta * znum * &
+                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
+                  & - wmax
+               IF( zws * zwl < 0. ) THEN   ;   zr = znummax
+               ELSE                        ;   zl = znummax
+               ENDIF
+               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl
+               znum = zl - 1.
+               zwl =  xkr_wsbio_min * xkr_zeta / zdiv &
+                  & - ( xkr_wsbio_max * xkr_eta * znum * &
+                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
+                  & - wmax
+
+               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr
+               znum = zr - 1.
+               zwr =  xkr_wsbio_min * xkr_zeta / zdiv &
+                  & - ( xkr_wsbio_max * xkr_eta * znum * &
+                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) &
+                  & - wmax
+               !
+               IF ( ABS ( zws )  <= xacc ) EXIT iflag
+               !
+            ENDIF
+            !
+         END DO iflag
+
+         xnumm(jk) = znummax
+         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk)
+         !
+      END DO
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink_init')
+      !
+  END SUBROUTINE p4z_sink_init
+
+#else
+
+   SUBROUTINE p4z_sink ( kt, jnt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sink  ***
+      !!
+      !! ** Purpose :   Compute vertical flux of particulate matter due to 
+      !!                gravitational sinking
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) :: kt, jnt
+      INTEGER  ::   ji, jj, jk
+      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4
+      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
+      REAL(wp) ::   zfact, zwsmax, zmax, zstep
+      REAL(wp) ::   zrfact2
+      INTEGER  ::   ik1
+      CHARACTER (len=25) :: charout
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink')
+      !
+      !    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(ji,jj), hmld(ji,jj) )
+      !         zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp
+               zmax = hmld(ji,jj)
+               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 4000._wp
+               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact
+            END DO
+         END DO
+      END DO
+
+      ! limit the values of the sinking speeds to avoid numerical instabilities  
+      wsbio3(:,:,:) = wsbio
+      !
+      ! OA Below, this is garbage. the ideal would be to find a time-splitting 
+      ! OA algorithm that does not increase the computing cost by too much
+      ! OA In ROMS, I have included a time-splitting procedure. But it is 
+      ! OA too expensive as the loop is computed globally. Thus, a small e3t
+      ! OA at one place determines the number of subtimesteps globally
+      ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !!
+
+      DO jk = 1,jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               zwsmax = 0.8 * fse3t(ji,jj,jk) / xstep
+               wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax )
+               wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax )
+            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
+      !   -----------------------------------------------------
+
+      CALL p4z_sink2( wsbio3, sinking , jppoc )
+      CALL p4z_sink2( wsbio3, sinkfer , jpsfe )
+      CALL p4z_sink2( wsbio4, sinking2, jpgoc )
+      CALL p4z_sink2( wsbio4, sinkfer2, jpbfe )
+      CALL p4z_sink2( wsbio4, sinksil , jpgsi )
+      CALL p4z_sink2( wscal , sinkcal , jpcal )
+
+      !  Exchange between organic matter compartments due to coagulation/disaggregation
+      !  ---------------------------------------------------
+
+      DO jk = 1, jpkm1
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               !
+               zstep = xstep 
+# if defined key_degrad
+               zstep = zstep * facvol(ji,jj,jk)
+# endif
+               zfact = zstep * xdiss(ji,jj,jk)
+               !  Part I : Coagulation dependent on turbulence
+               zagg1 = 354.  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+
+               ! Part II : Differential settling
+
+               !  Aggregation of small into large particles
+               zagg3 =  4.7 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)
+               zagg4 =  0.4 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)
+
+               zagg   = zagg1 + zagg2 + zagg3 + zagg4
+               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn )
+
+               ! Aggregation of DOC to small particles
+               zaggdoc  = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc)
+               zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc)
+               zaggdoc3 =   0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(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
+               !
+            END DO
+         END DO
+      END DO
+
+      IF( ln_diatrc ) THEN
+         zrfact2 = 1.e3 * rfact2r
+         ik1  = iksed + 1
+         IF( lk_iomput ) THEN
+           IF( jnt == nrdttrc ) THEN
+              CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m
+              CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m
+              CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m
+              CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m
+           ENDIF
+         ELSE
+           trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1)
+           trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1)
+           trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1)
+           trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1)
+           trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1)
+           trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1)
+         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  ***
+      !!----------------------------------------------------------------------
+   END SUBROUTINE p4z_sink_init
+
+#endif
+
+
+
+   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra )
+      !!---------------------------------------------------------------------
+      !!                     ***  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      
+      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 
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('p4z_sink2')
+      !
+      ! Allocate temporary workspace
+      CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 )
+
+      zstep = rfact2 / 2.
+
+      ztraz(:,:,:) = 0.e0
+      zakz (:,:,:) = 0.e0
+
+      DO jk = 1, jpkm1
+         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 
+      END DO
+      zwsink2(:,:,1) = 0.e0
+      IF( lk_degrad ) THEN
+         zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:)
+      ENDIF
+
+
+      ! Vertical advective flux
+      DO jn = 1, 2
+         !  first guess of the slopes interior values
+         DO jk = 2, jpkm1
+            ztraz(:,:,jk) = ( trn(:,:,jk-1,jp_tra) - trn(:,:,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 / fse3w(ji,jj,jk+1)
+                  zew   = zwsink2(ji,jj,jk+1)
+                  psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep
+               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) ) / fse3t(ji,jj,jk)
+                  trn(ji,jj,jk,jp_tra) = trn(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) ) / fse3t(ji,jj,jk)
+               trb(ji,jj,jk,jp_tra) = trb(ji,jj,jk,jp_tra) + 2. * zflx
+            END DO
+         END DO
+      END DO
+
+      trn     (:,:,:,jp_tra) = trb(:,:,:,jp_tra)
+      psinkflx(:,:,:)        = 2. * psinkflx(:,:,:)
+      !
+      CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 )
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink2')
+      !
+   END SUBROUTINE p4z_sink2
+
+
+   INTEGER FUNCTION p4z_sink_alloc()
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_sink_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4  (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) ,     &
+         &      sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                      ,     &                
+         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                      ,     &                
+#if defined key_kriest
+         &      xnumm(jpk)                                                        ,     &                
+#else
+         &      sinkfer2(jpi,jpj,jpk)                                             ,     &                
+#endif
+         &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                
+         !
+      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.')
+      !
+   END FUNCTION p4z_sink_alloc
+   
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_sink                    ! Empty routine
+   END SUBROUTINE p4z_sink
+#endif 
+
+   !!======================================================================
+END MODULE  p4zsink
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90	(revision 3437)
@@ -0,0 +1,125 @@
+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)
+   !!----------------------------------------------------------------------
+   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_2d   !: number of 2D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_3d   !: number of 3D diag in LOBSTER
+   USE par_lobster, ONLY : jp_lobster_trd  !: number of biological diag in LOBSTER
+
+   IMPLICIT NONE
+
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !:
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !:
+   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !:
+
+#if defined key_pisces  &&  defined key_kriest
+   !!---------------------------------------------------------------------
+   !!   'key_pisces' & 'key_kriest'                 PISCES bio-model + ???
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag 
+   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES
+
+   ! assign an index in trc arrays for each LOBSTER prognostic variables
+   !    WARNING: be carefull about the order when reading the restart
+        !   !!gm  this warning should be obsolet with IOM
+   INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp +  1    !: dissolved inoganic carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp +  2    !: total alkalinity 
+   INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp +  3    !: oxygen carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp +  4    !: calcite  concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp +  5    !: phosphate concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp +  6    !: small particulate organic phosphate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp +  7    !: silicate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp +  8    !: phytoplancton concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp +  9    !: zooplancton concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnum = jp_lp + 15    !: Big iron particles Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 16    !: number of particulate organic phosphate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 17    !: Diatoms iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = jp_lp + 18    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 19    !: Nano iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 20    !: Nano Chlorophyll Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 21    !: Diatoms Chlorophyll Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 22    !: Nitrates Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 23    !: Ammonium Concentration
+
+#elif defined key_pisces
+   !!---------------------------------------------------------------------
+   !!   'key_pisces'   :                         standard PISCES bio-model
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag 
+   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES
+
+   ! assign an index in trc arrays for each LOBSTER prognostic variables
+   !    WARNING: be carefull about the order when reading the restart
+        !   !!gm  this warning should be obsolet with IOM
+   INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp +  1    !: dissolved inoganic carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp +  2    !: total alkalinity 
+   INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp +  3    !: oxygen carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp +  4    !: calcite  concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp +  5    !: phosphate concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp +  6    !: small particulate organic phosphate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp +  7    !: silicate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp +  8    !: phytoplancton concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp +  9    !: zooplancton concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration 
+   INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 13    !: (big) Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpbfe = jp_lp + 15    !: Big iron particles Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgoc = jp_lp + 16    !: big particulate organic phosphate concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 17    !: Small iron particles Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 18    !: Diatoms iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpgsi = jp_lp + 19    !: Diatoms Silicate Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 20    !: Nano iron Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 21    !: Nano Chlorophyll Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 22    !: Diatoms Chlorophyll Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 23    !: Nitrates Concentration
+   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 24    !: Ammonium Concentration
+
+#else
+   !!---------------------------------------------------------------------
+   !!   Default                                   No CFC geochemical model
+   !!---------------------------------------------------------------------
+   LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .FALSE.  !: CFC flag 
+   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE.  !: Kriest flag 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  0       !: No CFC tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  0       !: No CFC additional 2d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  0       !: No CFC additional 3d output arrays 
+   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  0       !: number of sms trends for PISCES
+#endif
+
+   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done)
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = jp_lp + 1                  !: First index of PISCES tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_lp + jp_pisces          !: Last  index of PISCES tracers
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = jp_lp_2d + 1               !: First index of 2D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_lp_2d + jp_pisces_2d    !: Last  index of 2D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = jp_lp_3d + 1               !: First index of 3D diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_lp_3d + jp_pisces_3d    !: Last  index of 3d diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = jp_lp_trd + 1              !: First index of bio diag
+   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_lp_trd + jp_pisces_trd  !: Last  index of bio diag
+
+
+   !!======================================================================
+END MODULE par_pisces
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90	(revision 3437)
@@ -0,0 +1,155 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                         PISCES model
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+
+   IMPLICIT NONE
+   PUBLIC
+
+   INTEGER ::   numnatp
+
+   !!*  Time variables
+   INTEGER  ::   nrdttrc           !: ???
+   INTEGER  ::   ndayflxtr         !: ???
+   REAL(wp) ::   rfact , rfactr    !: ???
+   REAL(wp) ::   rfact2, rfact2r   !: ???
+   REAL(wp) ::   xstep             !: Time step duration for biology
+
+   !!*  Biological parameters 
+   REAL(wp) ::   rno3              !: ???
+   REAL(wp) ::   o2ut              !: ???
+   REAL(wp) ::   po4r              !: ???
+   REAL(wp) ::   rdenit            !: ???
+   REAL(wp) ::   rdenita           !: ???
+   REAL(wp) ::   o2nit             !: ???
+   REAL(wp) ::   wsbio, wsbio2     !: ???
+   REAL(wp) ::   xkmort            !: ???
+   REAL(wp) ::   ferat3            !: ???
+
+   !!* Damping 
+   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value
+   INTEGER  ::   nn_pisdmp         !: frequency of relaxation or not of nutrients to a mean value
+   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value
+                                   !: on close seas
+
+   !!*  Biological fluxes for light
+   INTEGER , ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  neln       !: number of T-levels + 1 in the euphotic layer
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  heup       !: euphotic layer depth
+
+   !!*  Biological fluxes for primary production
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksi       !: ???
+   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ???
+
+
+   !!*  SMS for the organic matter
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ??
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ??
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production
+    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing
+
+   !!* Variable for chemistry of the CO2 cycle
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ???
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ???
+
+   !!* 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
+
+   !!* Array used to indicate negative tracer values
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ???
+
+#if defined key_kriest
+   !!*  Kriest parameter for aggregation
+   REAL(wp) ::   xkr_eta                            !: ???
+   REAL(wp) ::   xkr_zeta                           !: ???
+   REAL(wp) ::   xkr_massp                          !: ???
+   REAL(wp) ::   xkr_mass_min, xkr_mass_max         !: ???
+#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(6)        ! Local variables
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !*  Biological fluxes for light
+      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                   STAT=ierr(1) )
+      !
+      !*  Biological fluxes for primary production
+      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,       &
+         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       &
+         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       &
+         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       &
+         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       &
+         &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       &
+         &      concnfe (jpi,jpj,jpk),                          STAT=ierr(2) ) 
+         !
+      !*  SMS for the organic matter
+      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       &
+         &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk),       &
+         &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),   STAT=ierr(3) )  
+         !
+      !* Variable for chemistry of the CO2 cycle
+      ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       &
+         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       &
+         &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       &
+         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,   STAT=ierr(4) )
+         !
+      !* Temperature dependancy of SMS terms
+      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,   STAT=ierr(5) )
+         !
+      !* Array used to indicate negative tracer values  
+      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                          STAT=ierr(6) )
+      !
+      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
+
+#else
+   !!----------------------------------------------------------------------   
+   !!  Empty module :                                     NO PISCES model
+   !!----------------------------------------------------------------------
+#endif
+   
+   !!======================================================================   
+END MODULE sms_pisces    
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90	(revision 3437)
@@ -0,0 +1,212 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !! 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 sms_pisces      !  PISCES Source Minus Sink variables
+   USE p4zche          !  Chemical model
+   USE p4zsink         !  vertical flux of particulate matter due to sinking
+   USE p4zopt          !  optical model
+   USE p4zrem          !  Remineralisation of organic matter
+   USE p4zflx          !  Gas exchange
+   USE p4zsed          !  Sedimentation
+   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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module
+
+   REAL(wp) :: sco2   =  2.312e-3_wp
+   REAL(wp) :: alka0  =  2.423e-3_wp
+   REAL(wp) :: oxyg0  =  177.6e-6_wp 
+   REAL(wp) :: po4    =  2.174e-6_wp 
+   REAL(wp) :: bioma0 =  1.000e-8_wp  
+   REAL(wp) :: silic1 =  91.65e-6_wp  
+   REAL(wp) :: no3    =  31.04e-6_wp * 7.625_wp
+
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_ini_pisces
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_ini_pisces ***
+      !!
+      !! ** Purpose :   Initialisation of the PISCES biochemical model
+      !!----------------------------------------------------------------------
+      !
+      INTEGER  ::  ji, jj, jk
+      REAL(wp) ::  zcaralk, zbicarb, zco3
+      REAL(wp) ::  ztmas, ztmas1
+      !!----------------------------------------------------------------------
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      CALL pisces_alloc()                          ! Allocate PISCES arrays
+
+      !                                            ! Time-step
+      rfact   = rdttrc(1)                          ! ---------
+      rfactr  = 1. / rfact
+      rfact2  = rfact / FLOAT( nrdttrc )
+      rfact2r = 1. / rfact2
+
+      IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdttra(1)
+      IF(lwp) write(numout,*) '    PISCES  Biology time step    rfact2 = ', rfact2
+
+
+
+      ! Set biological ratios
+      ! ---------------------
+      rno3    =  16._wp / 122._wp
+      po4r    =   1._wp / 122._wp
+      o2nit   =  32._wp / 122._wp
+      rdenit  = 105._wp /  16._wp
+      rdenita =   3._wp /  5._wp
+      o2ut    = 131._wp / 122._wp
+
+      CALL p4z_che        ! initialize the chemical constants
+
+      ! 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
+#  if ! defined key_kriest
+         trn(:,:,:,jpgoc) = bioma0
+         trn(:,:,:,jpbfe) = bioma0 * 5.e-6
+#  else
+         trn(:,:,:,jpnum) = bioma0 / ( 6. * xkr_massp )
+#  endif
+         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
+
+         ! initialize the half saturation constant for silicate
+         ! ----------------------------------------------------
+         xksi(:,:)    = 2.e-6
+         xksimax(:,:) = xksi(:,:)
+
+      ENDIF
+
+      IF( .NOT. ln_rsttr ) THEN
+         ! Initialization of chemical variables of the carbon cycle
+         ! --------------------------------------------------------
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmas   = tmask(ji,jj,jk)
+                  ztmas1  = 1. - tmask(ji,jj,jk)
+                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
+                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
+                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
+                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
+               END DO
+            END DO
+         END DO
+         !
+      END IF
+
+      ! Time step duration for biology
+      xstep = rfact2 / rday
+
+      CALL p4z_sink_init      !  vertical flux of particulate organic matter
+      CALL p4z_opt_init       !  Optic: PAR in the water column
+      CALL p4z_lim_init       !  co-limitations by the various nutrients
+      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.
+      CALL p4z_rem_init       !  remineralisation
+      CALL p4z_mort_init      !  phytoplankton mortality 
+      CALL p4z_micro_init     !  microzooplankton
+      CALL p4z_meso_init      !  mesozooplankton
+      CALL p4z_sed_init       !  sedimentation 
+      CALL p4z_lys_init       !  calcite saturation
+      CALL p4z_flx_init       !  gas exchange 
+
+      ndayflxtr = 0
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done'
+      IF(lwp) WRITE(numout,*) 
+      !
+   END SUBROUTINE trc_ini_pisces
+
+
+   SUBROUTINE pisces_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE pisces_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of PISCES 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines...
+      ierr = ierr +  p4z_che_alloc()
+      ierr = ierr +  p4z_sink_alloc()
+      ierr = ierr +  p4z_opt_alloc()
+      ierr = ierr +  p4z_prod_alloc()
+      ierr = ierr +  p4z_rem_alloc()
+      ierr = ierr +  p4z_sed_alloc()
+      ierr = ierr +  p4z_flx_alloc()
+      !
+      IF( lk_mpp    )   CALL mpp_sum( ierr )
+      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' )
+      !
+   END SUBROUTINE pisces_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module                            No PISCES biochemical model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ini_pisces             ! Empty routine
+   END SUBROUTINE trc_ini_pisces
+#endif
+
+   !!======================================================================
+END MODULE trcini_pisces
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90	(revision 3437)
@@ -0,0 +1,188 @@
+MODULE trcnam_pisces
+   !!======================================================================
+   !!                      ***  MODULE trcnam_lobster  ***
+   !! TOP :   initialisation of some run parameters for PISCES bio-model
+   !!======================================================================
+   !! History :    -   !  1999-10 (M.A. Foujols, M. Levy) original code
+   !!              -   !  2000-01 (L. Bopp) hamocc3, p3zd
+   !!             1.0  !  2003-08 (C. Ethe)  module F90
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'   :                                   PISCES bio-model
+   !!----------------------------------------------------------------------
+   !! trc_nam_pisces       : PISCES model namelist read
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE sms_pisces      ! sms trends
+   USE 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
+      !!                       natkriest ("key_kriest")
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER :: jl, jn
+      TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d
+      TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d
+      !!
+      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2
+#if defined key_kriest
+      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max
+#endif
+      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics
+      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo
+
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelists'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+
+      !                               ! Open the namelist file
+      !                               ! ----------------------
+      CALL ctl_opn( numnatp, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
+
+      REWIND( numnatp )                    
+      READ  ( numnatp, 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
+         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3
+         WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2
+      ENDIF
+
+#if defined key_kriest
+
+      !                               ! nampiskrp : kriest parameters
+      !                               ! -----------------------------
+      xkr_eta      = 0.62        
+      xkr_zeta     = 1.62        
+      xkr_mass_min = 0.0002     
+      xkr_mass_max = 1.      
+
+      REWIND( numnatp )                     ! read natkriest
+      READ  ( numnatp, nampiskrp )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : nampiskrp'
+         WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta
+         WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta
+         WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min
+         WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max
+         WRITE(numout,*)
+     ENDIF
+
+
+     ! Computation of some variables
+     xkr_massp = 5.7E-6 * 7.6 * xkr_mass_min**xkr_zeta
+
+#endif
+      !
+      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN
+         !
+         ! Namelist nampisdia
+         ! -------------------
+         DO jl = 1, jp_pisces_2d
+            WRITE(pisdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name
+            WRITE(pisdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            pisdia2d(jl)%units = ' '                                       ! units
+         END DO
+         !                                 ! 3D output arrays
+         DO jl = 1, jp_pisces_3d
+            WRITE(pisdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name
+            WRITE(pisdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name
+            pisdia3d(jl)%units = ' '                                       ! units
+         END DO
+
+         REWIND( numnatp )               ! 
+         READ  ( numnatp, nampisdia )
+
+         DO jl = 1, jp_pisces_2d
+            jn = jp_pcs0_2d + jl - 1
+            ctrc2d(jn) = pisdia2d(jl)%sname
+            ctrc2l(jn) = pisdia2d(jl)%lname
+            ctrc2u(jn) = pisdia2d(jl)%units
+         END DO
+
+         DO jl = 1, jp_pisces_3d
+            jn = jp_pcs0_3d + jl - 1
+            ctrc3d(jn) = pisdia3d(jl)%sname
+            ctrc3l(jn) = pisdia3d(jl)%lname
+            ctrc3u(jn) = pisdia3d(jl)%units
+         END DO
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) ' Namelist : natadd'
+            DO jl = 1, jp_pisces_3d
+               jn = jp_pcs0_3d + jl - 1
+               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), &
+                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn)
+            END DO
+            WRITE(numout,*) ' '
+
+            DO jl = 1, jp_pisces_2d
+               jn = jp_pcs0_2d + jl - 1
+               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), &
+                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn)
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+         !
+      ENDIF
+
+      REWIND( numnatp )
+      READ  ( numnatp, 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,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo
+         WRITE(numout,*) ' '
+      ENDIF
+
+   END SUBROUTINE trc_nam_pisces
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                   No PISCES bio-model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_pisces                      ! Empty routine
+   END  SUBROUTINE  trc_nam_pisces
+#endif  
+
+   !!======================================================================
+END MODULE trcnam_pisces
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90	(revision 3437)
@@ -0,0 +1,236 @@
+MODULE trcrst_pisces
+   !!======================================================================
+   !!                       ***  MODULE trcrst_pisces  ***
+   !! TOP :   create, write, read the restart files of PISCES tracer
+   !!======================================================================
+   !! History :   1.0  !  2010-01 (C. Ethe) Original
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                               pisces tracers
+   !!----------------------------------------------------------------------
+   !!   trc_rst_read_pisces   : read  restart file
+   !!   trc_rst_wri_pisces    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! Ocean variables
+   USE par_trc         ! TOP parameters
+   USE trc             ! TOP variables
+   USE trcsms_pisces          ! pisces sms trends
+   USE sms_pisces          ! pisces sms variables
+   USE iom
+   USE trcdta
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC  trc_rst_read_pisces   ! called by trcini.F90 module
+   PUBLIC  trc_rst_wri_pisces   ! called by trcini.F90 module
+
+CONTAINS
+   
+   SUBROUTINE trc_rst_read_pisces( knum ) 
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_pisces  ***  
+      !!
+      !! ** Purpose : Read in restart file specific variables from pisces model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: knum  ! unit of the restart file
+      INTEGER  ::  ji, jj, jk
+      REAL(wp) ::  zcaralk, zbicarb, zco3
+      REAL(wp) ::  ztmas, ztmas1
+      !!----------------------------------------------------------------------
+
+      !
+      IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_read_pisces : Read specific variables from pisces model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+      ! 
+      IF( iom_varid( knum, 'PH', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:)  )
+      ELSE
+!         hi(:,:,:) = 1.e-9 
+         ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???)
+         ! --------------------------------------------------------
+         DO jk = 1, jpk
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ztmas   = tmask(ji,jj,jk)
+                  ztmas1  = 1. - tmask(ji,jj,jk)
+                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  )
+                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1
+                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk )
+                 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1
+               END DO
+            END DO
+         END DO
+      ENDIF
+      CALL iom_get( knum, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
+      IF( iom_varid( knum, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
+         CALL iom_get( knum, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
+      ELSE
+         xksimax(:,:) = xksi(:,:)
+      ENDIF
+
+   END SUBROUTINE trc_rst_read_pisces
+
+   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
+      !!----------------------------------------------------------------------
+      !!                     ***  trc_rst_read_pisces  ***
+      !!
+      !! ** Purpose : Read in restart file specific variables from pisces model
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in)  :: kt      ! time step
+      INTEGER, INTENT(in)  :: kitrst  ! time step of restart write
+      INTEGER, INTENT(in)  :: knum    ! unit of the restart file
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_rst_wri_pisces : Write specific variables from pisces model '
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
+
+      CALL iom_rstput( kt, kitrst, knum, 'PH', hi(:,:,:) )
+      CALL iom_rstput( kt, kitrst, knum, 'Silicalim', xksi(:,:) ) 
+      CALL iom_rstput( kt, kitrst, knum, 'Silicamax', xksimax(:,:) )
+
+   END SUBROUTINE trc_rst_wri_pisces
+
+   SUBROUTINE pis_dmp_clo   
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE pis_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  :   ictsi1(), ictsj1() : south-west closed sea limits (i,j)
+      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j)
+      !!----------------------------------------------------------------------
+      INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea
+      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j)
+      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j)
+      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices
+      INTEGER :: ierr                                       ! local integer
+      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta ! 4D  workspace
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 
+      IF(lwp) WRITE(numout,*)' pis_dmp_clo : closed seas '
+      IF(lwp) WRITE(numout,*)'~~~~~~~'
+
+      ! initial values
+      ictsi1(:) = 1  ;  ictsi2(:) = 1
+      ictsj1(:) = 1  ;  ictsj2(:) = 1
+
+      ! set the closed seas (in data domain indices)
+      ! -------------------
+
+      IF( cp_cfg == "orca" ) THEN
+         !
+         SELECT CASE ( jp_cfg )
+         !                                           ! =======================
+         CASE ( 2 )                                  !  ORCA_R2 configuration
+            !                                        ! =======================
+            !                                            ! Caspian Sea
+            ictsi1(1)   =  11  ;  ictsj1(1)   = 103
+            ictsi2(1)   =  17  ;  ictsj2(1)   = 112
+            !                                            ! Great North American Lakes
+            ictsi1(2)   =  97  ;  ictsj1(2)   = 107
+            ictsi2(2)   = 103  ;  ictsj2(2)   = 111
+            !                                            ! Black Sea 1 : west part of the Black Sea
+            ictsi1(3)   = 174  ; ictsj1(3)   = 107
+            ictsi2(3)   = 181  ; ictsj2(3)   = 112
+            !                                            ! Black Sea 2 : est part of the Black Sea
+            ictsi1(4)   =   2  ;  ictsj1(4)   = 107
+            ictsi2(4)   =   6  ;  ictsj2(4)   = 112
+            !                                        ! =======================
+         CASE ( 4 )                                  !  ORCA_R4 configuration
+            !                                        ! =======================
+            !                                            ! Caspian Sea
+            ictsi1(1)   =  4  ;  ictsj1(1)   = 53
+            ictsi2(1)   =  4  ;  ictsj2(1)   = 56
+            !                                            ! Great North American Lakes
+            ictsi1(2)   = 49  ;  ictsj1(2)   = 55
+            ictsi2(2)   = 51  ;  ictsj2(2)   = 56
+            !                                            ! Black Sea
+            ictsi1(3)   = 88  ;  ictsj1(3)   = 55
+            ictsi2(3)   = 91  ;  ictsj2(3)   = 56
+            !                                            ! Baltic Sea
+            ictsi1(4)   = 75  ;  ictsj1(4)   = 59
+            ictsi2(4)   = 76  ;  ictsj2(4)   = 61
+            !                                        ! =======================
+            !                                        ! =======================
+         CASE ( 025 )                                ! ORCA_R025 configuration
+            !                                        ! =======================
+                                                     ! Caspian + Aral sea
+            ictsi1(1)   = 1330 ; ictsj1(1)   = 645
+            ictsi2(1)   = 1400 ; ictsj2(1)   = 795
+            !                                        ! Azov Sea
+            ictsi1(2)   = 1284 ; ictsj1(2)   = 722
+            ictsi2(2)   = 1304 ; ictsj2(2)   = 747
+            !
+         END SELECT
+         !
+      ENDIF
+
+      ! convert the position in local domain indices
+      ! --------------------------------------------
+      DO jc = 1, npicts
+         ictsi1(jc)   = mi0( ictsi1(jc) )
+         ictsj1(jc)   = mj0( ictsj1(jc) )
+
+         ictsi2(jc)   = mi1( ictsi2(jc) )
+         ictsj2(jc)   = mj1( ictsj2(jc) )
+      END DO
+
+      ! Restore close seas values to initial data
+      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
+        ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr )
+        IF( ierr > 0 ) THEN
+           CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN
+        ENDIF
+        !
+        CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000
+        !
+        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)
+              DO jc = 1, npicts
+                 DO jk = 1, jpkm1
+                    DO jj = ictsj1(jc), ictsj2(jc)
+                       DO ji = ictsi1(jc), ictsi2(jc)
+                          trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk) 
+                          trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn)
+                       ENDDO
+                    ENDDO
+                 ENDDO
+              ENDDO
+           ENDIF
+        ENDDO
+        DEALLOCATE( ztrcdta )
+      ENDIF
+      !
+   END SUBROUTINE pis_dmp_clo
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_rst_read_pisces( knum )
+      INTEGER, INTENT(in)  :: knum
+      WRITE(*,*) 'trc_rst_read_pisces: You should not have seen this print! error?', knum
+   END SUBROUTINE trc_rst_read_pisces
+
+   SUBROUTINE trc_rst_wri_pisces( kt, kitrst, knum )
+     INTEGER, INTENT(in)  :: kt, kitrst, knum
+     WRITE(*,*) 'trc_rst_wri_pisces: You should not have seen this print! error?', kt, kitrst, knum
+   END SUBROUTINE trc_rst_wri_pisces
+#endif
+
+   !!======================================================================
+END MODULE trcrst_pisces
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90	(revision 3437)
@@ -0,0 +1,259 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   trcsms_pisces        :  Time loop of passive tracers sms
+   !!----------------------------------------------------------------------
+   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 p4zbio          !  Biological model
+   USE p4zche          !  Chemical model
+   USE p4zlys          !  Calcite saturation
+   USE p4zflx          !  Gas exchange
+   USE p4zsed          !  Sedimentation
+   USE p4zint          !  time interpolation
+   USE trdmod_oce      !  Ocean trends variables
+   USE trdmod_trc      !  TOP trends variables
+   USE sedmodel        !  Sediment model
+   USE prtctl_trc      !  print control for debugging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sms_pisces    ! called in trcsms.F90
+
+   LOGICAL ::  ln_check_mass = .false.       !: Flag to check mass conservation 
+
+   INTEGER ::  numno3  !: logical unit for NO3 budget
+   INTEGER ::  numalk  !: logical unit for talk budget
+   INTEGER ::  numsil  !: logical unit for Si budget
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_sms_pisces( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_sms_pisces  ***
+      !!
+      !! ** 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 ::   jnt, jn, jl
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:)  :: ztrdpis
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sms_pisces')
+      !
+      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers
+                                                                   CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
+         DO jn = 1, jp_pisces
+            jl = jn + jp_pcs0 - 1
+            ztrdpis(:,:,:,jn) = trn(:,:,:,jl)
+         ENDDO
+      ENDIF
+
+      IF( 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              ! computation of various rates for biogeochemistry
+         !
+      ENDIF
+
+
+      DO jnt = 1, nrdttrc          ! Potential time splitting if requested
+         !
+         CALL p4z_bio (kt, jnt)    ! Compute soft tissue production (POC)
+         CALL p4z_sed (kt, jnt)    ! compute soft tissue remineralisation
+         !
+         DO jn = jp_pcs0, jp_pcs1
+            trb(:,:,:,jn) = trn(:,:,:,jn)
+         ENDDO
+         !
+      END DO
+
+      IF( l_trdtrc )  THEN
+         DO jn = 1, jp_pisces
+            jl = jn + jp_pcs0 - 1
+            ztrdpis(:,:,:,jn) = ( ztrdpis(:,:,:,jn) - trn(:,:,:,jl) ) * rfact2r
+         ENDDO
+      ENDIF
+
+      CALL p4z_lys( kt )             ! Compute CaCO3 saturation
+      CALL p4z_flx( kt )             ! Compute surface fluxes
+
+      DO jn = jp_pcs0, jp_pcs1
+        CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+        CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
+        CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )
+      END DO
+
+      IF( l_trdtrc ) THEN
+         DO jn = 1, jp_pisces
+            jl = jn + jp_pcs0 - 1
+             ztrdpis(:,:,:,jn) = ztrdpis(:,:,:,jn) + tra(:,:,:,jl)
+             CALL trd_mod_trc( ztrdpis(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends
+          END DO
+          CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdpis ) 
+      END IF
+
+      IF( lk_sed ) THEN 
+         !
+         CALL sed_model( kt )     !  Main program of Sediment model
+         !
+         DO jn = jp_pcs0, jp_pcs1
+           CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )
+         END DO
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_pisces')
+      !
+   END SUBROUTINE trc_sms_pisces
+
+   SUBROUTINE trc_sms_pisces_dmp( kt )
+      !!----------------------------------------------------------------------
+      !!                    ***  trc_sms_pisces_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, zalksum, zpo4sum, zno3sum, zsilsum
+      !!---------------------------------------------------------------------
+
+
+      IF(lwp)  WRITE(numout,*)
+      IF(lwp)  WRITE(numout,*) ' trc_sms_pisces_dmp : Relaxation of nutrients at time-step kt = ', kt
+      IF(lwp)  WRITE(numout,*)
+
+      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) !
+         !                                                    ! --------------------------- !
+         ! set total alkalinity, phosphate, nitrate & silicate
+         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6              
+
+         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
+         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122.
+         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6
+         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
+ 
+         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum
+         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum
+
+         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum
+         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum
+
+         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum
+         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum
+
+         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum
+         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )
+         !
+      ENDIF
+
+   END SUBROUTINE trc_sms_pisces_dmp
+
+   SUBROUTINE trc_sms_pisces_mass_conserv ( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_sms_pisces_mass_conserv  ***
+      !!
+      !! ** Purpose :  Mass conservation check 
+      !!
+      !!---------------------------------------------------------------------
+      !
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      REAL(wp) :: zalkbudget, zno3budget, zsilbudget
+      !
+      NAMELIST/nampismass/ ln_check_mass
+      !!---------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN 
+         REWIND( numnatp )       
+         READ  ( numnatp, 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
+
+         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si
+            CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+            CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         ENDIF
+      ENDIF
+
+      IF( ln_check_mass ) THEN      !   Compute the budget of NO3, ALK, Si
+         zno3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  &
+            &                     + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  &
+            &                     + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  &
+            &                     + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  &
+            &                     + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  ) 
+         ! 
+         zsilbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  &
+            &                     + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  )
+         ! 
+         zalkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              &
+            &                     + trn(:,:,:,jptal)                     &
+            &                     + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  )
+
+         IF( lwp ) THEN
+            WRITE(numno3,9500) kt,  zno3budget / areatot
+            WRITE(numsil,9500) kt,  zsilbudget / areatot
+            WRITE(numalk,9500) kt,  zalkbudget / areatot
+         ENDIF
+       ENDIF
+ 9500  FORMAT(i10,e18.10)     
+       !
+   END SUBROUTINE trc_sms_pisces_mass_conserv
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE trc_sms_pisces( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'trc_sms_pisces: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_sms_pisces
+#endif 
+
+   !!======================================================================
+END MODULE trcsms_pisces 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90	(revision 3437)
@@ -0,0 +1,62 @@
+MODULE trcwri_pisces
+   !!======================================================================
+   !!                       *** MODULE trcwri ***
+   !!    PISCES :   Output of PISCES tracers
+   !!======================================================================
+   !! History :   1.0  !  2009-05 (C. Ethe)  Original code
+   !!----------------------------------------------------------------------
+#if defined key_top && key_pisces && defined key_iomput
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                           PISCES model
+   !!----------------------------------------------------------------------
+   !! trc_wri_pisces   :  outputs of concentration fields
+   !!----------------------------------------------------------------------
+   USE trc         ! passive tracers common variables 
+   USE iom         ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri_pisces 
+
+CONTAINS
+
+   SUBROUTINE trc_wri_pisces
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      CHARACTER (len=20)   :: cltra
+      REAL(wp)             :: zrfact
+      INTEGER              :: jn
+      !!---------------------------------------------------------------------
+ 
+      ! write the tracer concentrations in the file
+      ! ---------------------------------------
+      DO jn = 1, jptra
+         zrfact = 1.0e+6 
+         IF( jn == jpno3 .OR. jn == jpnh4 ) zrfact = 1.0e+6 / 7.6
+         IF( jn == jppo4  )                 zrfact = 1.0e+6 / 122.
+         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+         CALL iom_put( cltra, trn(:,:,:,jn) * zrfact )
+      END DO
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/par_sed.F90	(revision 3437)
@@ -0,0 +1,66 @@
+MODULE par_sed
+   !!======================================================================
+   !!                        ***  par_sed  ***
+   !! Sediment :   set sediment parameter
+   !!======================================================================
+   !! History :
+   !!        !  06-12  (C. Ethe)  Orignal
+   !!----------------------------------------------------------------------
+#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
+
+#if defined key_kriest
+   INTEGER, PARAMETER :: jpdta = 11
+#else
+   INTEGER, PARAMETER :: jpdta = 12
+#endif
+
+
+   ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sed.F90	(revision 3437)
@@ -0,0 +1,191 @@
+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_0     =>   e3t_0          !: 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
+#if ! defined key_kriest
+   USE p4zsink , ONLY :  sinking2   =>   sinking2        !: sinking flux for GOC
+#endif
+   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
+
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedadv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedadv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedadv.F90	(revision 3437)
@@ -0,0 +1,449 @@
+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
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedarr.F90	(revision 3437)
@@ -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)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp $ 
+   !! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedbtb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedbtb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedbtb.F90	(revision 3437)
@@ -0,0 +1,88 @@
+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
+
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedchem.F90	(revision 3437)
@@ -0,0 +1,571 @@
+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/
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedco3.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedco3.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedco3.F90	(revision 3437)
@@ -0,0 +1,200 @@
+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)
+   !!----------------------------------------------------------------------
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddsr.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddsr.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddsr.F90	(revision 3437)
@@ -0,0 +1,539 @@
+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 
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/seddta.F90	(revision 3437)
@@ -0,0 +1,277 @@
+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
+
+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
+#if ! defined key_kriest
+      REAL(wp), DIMENSION(:)  , ALLOCATABLE :: zdtap, zdtag
+#endif 
+
+
+      !----------------------------------------------------------------------
+
+      ! 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
+
+
+#if ! defined key_kriest   
+      ! Initialization of temporaries arrays  
+      ALLOCATE( zdtap(jpoce) )    ;   zdtap(:)    = 0. 
+      ALLOCATE( zdtag(jpoce) )    ;   zdtag(:)    = 0.  
+#endif
+
+
+      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)
+#   if ! defined key_kriest
+                  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)
+#   else
+                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt)
+                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt)
+                  trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt)
+                  trc_data(ji,jj,10) = tsn     (ji,jj,ikt,jp_tem)
+                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_sal)       
+#   endif
+               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 ) )
+#   if ! defined key_kriest
+         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) ) 
+#   else
+         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, 'CACO3FLXBOT', trc_data(:,:,9 ) ) 
+         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,10) ) 
+         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,11) ) 
+#   endif
+#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 : 
+         !-----------------------
+#if ! defined key_kriest
+         !  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) )
+#else
+         !  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, rainrm_dta(1:jpoce,jspoc), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )      
+         rainrm_dta(1:jpoce,jspoc) = rainrm_dta(1:jpoce,jspoc) * 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,9), 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,10), iarroce(1:jpoce) )
+         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) )
+
+#endif
+        
+         ! 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 ) 
+#if ! defined key_kriest
+      DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    ) 
+#endif      
+
+      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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90	(revision 3437)
@@ -0,0 +1,864 @@
+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
+
+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_0(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
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE sed_ini              ! Empty routine
+   END SUBROUTINE sed_ini
+#endif
+
+
+END MODULE sedini
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmat.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmat.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmat.F90	(revision 3437)
@@ -0,0 +1,265 @@
+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 
+
+
+ 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 
+   !!======================================================================
+CONTAINS
+   SUBROUTINE sed_mat         ! Empty routine
+   END SUBROUTINE sed_mat
+   !!======================================================================
+#endif
+
+ END MODULE sedmat
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmbc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmbc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmbc.F90	(revision 3437)
@@ -0,0 +1,319 @@
+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  
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedmodel.F90	(revision 3437)
@@ -0,0 +1,56 @@
+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
+
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag
+
+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 
+   !!======================================================================
+   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedrst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedrst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedrst.F90	(revision 3437)
@@ -0,0 +1,281 @@
+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)
+   
+   
+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) ) 
+
+      IF ( jprstlib == jprstdimg ) THEN
+        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+        ! if restart_sed.nc exists, then set jlibalt to jpnf90
+        INQUIRE( FILE = 'restart_sed.nc', EXIST = llok )
+        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+      ENDIF
+
+      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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedsfc.F90	(revision 3437)
@@ -0,0 +1,76 @@
+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
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedstp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedstp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedstp.F90	(revision 3437)
@@ -0,0 +1,77 @@
+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
+
+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 
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90	(revision 3437)
@@ -0,0 +1,275 @@
+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
+
+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
+   !!======================================================================
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90	(revision 3437)
@@ -0,0 +1,205 @@
+MODULE trcadv
+   !!==============================================================================
+   !!                       ***  MODULE  trcadv  ***
+   !! Ocean passive tracers:  advection trend 
+   !!==============================================================================
+   !! History :  2.0  !  05-11  (G. Madec)  Original code
+   !!            3.0  !  10-06  (C. Ethe)   Adapted to passive tracers
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_adv      : compute ocean tracer advection trend
+   !!   trc_adv_ctl  : control the different options of advection scheme
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE traadv_cen2     ! 2nd order centered scheme (tra_adv_cen2   routine)
+   USE traadv_tvd      ! TVD      scheme           (tra_adv_tvd    routine)
+   USE traadv_muscl    ! MUSCL    scheme           (tra_adv_muscl  routine)
+   USE traadv_muscl2   ! MUSCL2   scheme           (tra_adv_muscl2 routine)
+   USE traadv_ubs      ! UBS      scheme           (tra_adv_ubs    routine)
+   USE traadv_qck      ! QUICKEST scheme           (tra_adv_qck    routine)
+   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine)
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE prtctl_trc      ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_adv          ! routine called by step module
+   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module
+
+   INTEGER ::   nadv   ! choice of the type of advection scheme
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
+   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_adv_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_alloc  ***
+      !!----------------------------------------------------------------------
+
+      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
+
+      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
+
+   END FUNCTION trc_adv_alloc
+
+
+   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 
+      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 )
+      !
+
+      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      !                                                   ! effective transport
+      DO jk = 1, jpkm1
+         !                                                ! eulerian transport only
+         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)
+         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
+         !
+      END DO
+      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom
+
+      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary)
+         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' )
+      !
+      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==!
+      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered
+      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD 
+      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL 
+      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2 
+      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS 
+      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST 
+      !
+      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==!
+         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )          
+         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )          
+         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')
+         !
+      END SELECT
+
+      !                                              ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('adv ')")  ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END IF
+      !
+      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_ctl
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_adv_ctl  ***
+      !!                
+      !! ** Purpose : Control the consistency between namelist options for 
+      !!              passive tracer advection schemes and set nadv
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio
+      !!----------------------------------------------------------------------
+
+      ioptio = 0                      ! Parameter control
+      IF( ln_trcadv_cen2   )   ioptio = ioptio + 1
+      IF( ln_trcadv_tvd    )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl  )   ioptio = ioptio + 1
+      IF( ln_trcadv_muscl2 )   ioptio = ioptio + 1
+      IF( ln_trcadv_ubs    )   ioptio = ioptio + 1
+      IF( ln_trcadv_qck    )   ioptio = ioptio + 1
+      IF( lk_esopa         )   ioptio =          1
+
+      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' )
+
+      !                              ! Set nadv
+      IF( ln_trcadv_cen2   )   nadv =  1
+      IF( ln_trcadv_tvd    )   nadv =  2
+      IF( ln_trcadv_muscl  )   nadv =  3
+      IF( ln_trcadv_muscl2 )   nadv =  4
+      IF( ln_trcadv_ubs    )   nadv =  5
+      IF( ln_trcadv_qck    )   nadv =  6
+      IF( lk_esopa         )   nadv = -1
+
+      IF(lwp) THEN                   ! Print the choice
+         WRITE(numout,*)
+         IF( nadv ==  1 )   WRITE(numout,*) '         2nd order scheme is used'
+         IF( nadv ==  2 )   WRITE(numout,*) '         TVD       scheme is used'
+         IF( nadv ==  3 )   WRITE(numout,*) '         MUSCL     scheme is used'
+         IF( nadv ==  4 )   WRITE(numout,*) '         MUSCL2    scheme is used'
+         IF( nadv ==  5 )   WRITE(numout,*) '         UBS       scheme is used'
+         IF( nadv ==  6 )   WRITE(numout,*) '         QUICKEST  scheme is used'
+         IF( nadv == -1 )   WRITE(numout,*) '         esopa test: use all advection scheme'
+      ENDIF
+      !
+   END SUBROUTINE trc_adv_ctl
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_adv( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_adv: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_adv
+#endif
+
+  !!======================================================================
+END MODULE trcadv
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90	(revision 3437)
@@ -0,0 +1,115 @@
+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 trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl              ! 
+   USE prtctl_trc          ! Print control for debbuging
+   USE trdmod_oce
+   USE trdtra
+
+   PUBLIC   trc_bbl       !  routine called by step.F90
+
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+
+   SUBROUTINE trc_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. lk_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_trd_ldf, 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90	(revision 3437)
@@ -0,0 +1,228 @@
+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 && defined key_trcdmp 
+   !!----------------------------------------------------------------------
+   !!   key_trcdmp                                         internal damping
+   !!----------------------------------------------------------------------
+   !!   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 trcnam_trp      ! passive tracers transport namelist variables
+   USE trcdta
+   USE tradmp
+   USE prtctl_trc      ! Print control for debbuging
+   USE trdtra
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_dmp            ! routine called by step.F90
+   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90
+
+   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag
+
+   !                                !!* Namelist namtrc_dmp : passive tracer newtonian damping *
+   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer
+   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp) ::   rn_surf_tr =   50.  ! surface time scale for internal damping        [days]
+   REAL(wp) ::   rn_bot_tr  =  360.  ! bottom time scale for internal damping         [days]
+   REAL(wp) ::   rn_dep_tr  =  800.  ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER  ::   nn_file_tr =    2   ! = 1 create a damping.coeff NetCDF file 
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1)
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $ 
+   !! Software governed by the CeCILL licence     (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_trdmld_trc')
+      !!----------------------------------------------------------------------
+      !!
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
+      !!
+      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
+      REAL(wp) ::   ztra                 ! temporary scalars
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp')
+      !
+      ! 0. Initialization (first time-step only)
+      !    --------------
+      IF( kt == nittrc000 ) CALL trc_dmp_init
+
+      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends
+
+      ! 1. Newtonian damping trends on tracer fields
+      ! --------------------------------------------
+      ! Initialize the input fields for newtonian damping
+      CALL trc_dta( kt )
+      !                                                          ! ===========
+      DO jn = 1, jptra                                           ! tracer loop
+         !                                                       ! ===========
+         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)    ! save trends 
+
+         IF( lutini(jn) ) THEN
+            !
+            SELECT CASE ( nn_zdmp_trc )
+            !
+            CASE( 0 )                !==  newtonian damping throughout the water column  ==!
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                        tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                     END DO
+                  END DO
+               END DO
+            !
+            CASE ( 1 )                !==  no damping in the turbocline (avt > 5 cm2/s)  ==!
+               DO jk = 1, jpkm1
+                  DO jj = 2, jpjm1
+                     DO ji = fs_2, fs_jpim1   ! vector opt.
+                        IF( avt(ji,jj,jk) <= 5.e-4 )  THEN 
+                           ztra = restotr(ji,jj,jk) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                        ENDIF
+                     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( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN
+                           ztra = restotr(ji,jj,jk,jn) * ( trdta(ji,jj,jk,jn) - trb(ji,jj,jk,jn) )
+                           tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra
+                        END IF
+                     END DO
+                  END DO
+               END DO
+            !  
+            END SELECT
+            ! 
+         ENDIF
+         !
+         IF( l_trdtrc ) THEN
+            ztrtrd(:,:,:) = tra(:,:,:,jn) -  ztrtrd(:,:,:)
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_dmp, ztrtrd )
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+      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_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_dmp_init  ***
+      !! 
+      !! ** Purpose :   Initialization for the newtonian damping 
+      !!
+      !! ** Method  :   read the nammbf namelist and check the parameters
+      !!              called by trc_dmp at the first timestep (nittrc000)
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init')
+      !
+      SELECT CASE ( nn_hdmp_tr )
+      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only'
+      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp_tr, ' degrees'
+      CASE DEFAULT
+         WRITE(ctmp1,*) '          bad flag value for nn_hdmp_tr = ', nn_hdmp_tr
+         CALL ctl_stop(ctmp1)
+      END SELECT
+
+      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_dtatrc )   &
+         &   CALL ctl_stop( 'no passive tracer data define key_dtatrc' )
+
+      IF( .NOT. lk_tradmp )   &
+         &   CALL ctl_stop( 'passive trace damping need key_tradmp to compute damping coef.' )
+      !
+      !                          ! Damping coefficients initialization
+      IF( lzoom ) THEN   ;   CALL dtacof_zoom( restotr )
+      ELSE               ;   CALL dtacof( nn_hdmp_tr, rn_surf_tr, rn_bot_tr, rn_dep_tr,  &
+                             &            nn_file_tr, 'TRC'     , restotr                )
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init')
+      !
+   END SUBROUTINE trc_dmp_init
+#else
+   !!----------------------------------------------------------------------
+   !!   Default key                                     NO internal damping
+   !!----------------------------------------------------------------------
+   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .FALSE.    !: internal damping flag
+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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90	(revision 3437)
@@ -0,0 +1,272 @@
+MODULE trcldf
+   !!======================================================================
+   !!                       ***  MODULE  trcldf  ***
+   !! Ocean Passive tracers : lateral diffusive trends
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE ldftra_oce      ! lateral diffusion coefficient on tracers
+   USE ldfslp          ! ???
+   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine)
+   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine)
+   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine)
+   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine)
+   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_ldf    ! called by step.F90
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient
+   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_ldf( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE tra_ldf  ***
+      !!
+      !! ** Purpose :   compute the lateral ocean tracer physics.
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index
+      !!
+      INTEGER            :: jn
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd
+      !!----------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_ldf')
+      !
+      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options
+
+      rldf = rldf_rat
+
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd )
+         ztrtrd(:,:,:,:)  = tra(:,:,:,:)
+      ENDIF
+
+      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend
+      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian
+      CASE ( 1 )                                                                                            ! rotated laplacian
+                       IF( ln_traldf_grif ) THEN
+                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+                       ELSE
+                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+                       ENDIF
+      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian
+      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian
+         !
+      CASE ( -1 )                                     ! esopa: test all possibility with control print
+         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         IF( ln_traldf_grif ) THEN
+            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ELSE
+            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
+         ENDIF
+         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )
+         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      END SELECT
+      !
+      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics
+        DO jn = 1, jptra
+           ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
+           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) )
+        END DO
+        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd )
+      ENDIF
+      !                                          ! print mean trends (used for debugging)
+      IF( ln_ctl )   THEN
+         WRITE(charout, FMT="('ldf ')") ;  CALL prt_ctl_trc_info(charout)
+                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      ENDIF
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf')
+      !
+   END SUBROUTINE trc_ldf
+
+
+   SUBROUTINE ldf_ctl
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE ldf_ctl  ***
+      !!
+      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion
+      !!
+      !! ** Method  :   set nldf from the namtra_ldf logicals
+      !!      nldf == -2   No lateral diffusion
+      !!      nldf == -1   ESOPA test: ALL operators are used
+      !!      nldf ==  0   laplacian operator
+      !!      nldf ==  1   Rotated laplacian operator
+      !!      nldf ==  2   bilaplacian operator
+      !!      nldf ==  3   Rotated bilaplacian
+      !!----------------------------------------------------------------------
+      INTEGER ::   ioptio, ierr         ! temporary integers
+      !!----------------------------------------------------------------------
+
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
+            rldf_rat = 1.0_wp
+         ELSE
+            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+         END IF
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      !  Define the lateral mixing oparator for tracers
+      ! ===============================================
+
+      !                               ! control the input
+      ioptio = 0
+      IF( ln_trcldf_lap   )   ioptio = ioptio + 1
+      IF( ln_trcldf_bilap )   ioptio = ioptio + 1
+      IF( ioptio >  1 )   CALL ctl_stop( '          use ONE or NONE of the 2 lap/bilap operator type on tracer' )
+      IF( ioptio == 0 )   nldf = -2   ! No lateral diffusion
+      ioptio = 0
+      IF( ln_trcldf_level )   ioptio = ioptio + 1
+      IF( ln_trcldf_hor   )   ioptio = ioptio + 1
+      IF( ln_trcldf_iso   )   ioptio = ioptio + 1
+      IF( ioptio /= 1 )   CALL ctl_stop( '          use only ONE direction (level/hor/iso)' )
+
+      ! defined the type of lateral diffusion from ln_trcldf_... logicals
+      ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
+      ierr = 0
+      IF( ln_trcldf_lap ) THEN       ! laplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 0      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 0      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 1      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   nldf = 1      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN      ! bilaplacian operator
+         IF ( ln_zco ) THEN                ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_zps ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed
+            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+         IF ( ln_sco ) THEN             ! z-coordinate
+            IF ( ln_trcldf_level )   nldf = 2      ! iso-level  (no rotation)
+            IF ( ln_trcldf_hor   )   nldf = 3      ! horizontal (   rotation)
+            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation)
+         ENDIF
+      ENDIF
+
+      IF( ierr == 1 )   CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
+      IF( ierr == 2 )   CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
+      IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso )   &
+           CALL ctl_stop( '          eddy induced velocity on tracers',   &
+           &              ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
+      IF( nldf == 1 .OR. nldf == 3 ) THEN      ! rotation
+         IF( .NOT.lk_ldfslp )   CALL ctl_stop( '          the rotation of the diffusive tensor require key_ldfslp' )
+#if defined key_offline
+         l_traldf_rot = .TRUE.                 ! needed for trazdf_imp
+#endif
+      ENDIF
+
+      IF( lk_esopa ) THEN
+         IF(lwp) WRITE(numout,*) '          esopa control: use all lateral physics options'
+         nldf = -1
+      ENDIF
+
+      IF( .NOT. ln_trcldf_diff ) THEN
+         IF(lwp) WRITE(numout,*) '          No lateral diffusion on passive tracers'
+         nldf = -2
+      ENDIF
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         IF( nldf == -2 )   WRITE(numout,*) '          NO lateral diffusion'
+         IF( nldf == -1 )   WRITE(numout,*) '          ESOPA test All scheme used'
+         IF( nldf ==  0 )   WRITE(numout,*) '          laplacian operator'
+         IF( nldf ==  1 )   WRITE(numout,*) '          Rotated laplacian operator'
+         IF( nldf ==  2 )   WRITE(numout,*) '          bilaplacian operator'
+         IF( nldf ==  3 )   WRITE(numout,*) '          Rotated bilaplacian'
+      ENDIF
+
+      IF( ln_trcldf_bilap ) THEN
+         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion'
+         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
+      ELSE
+         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)'
+         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
+      ENDIF
+
+      ! ratio between active and passive tracers diffusive coef.
+      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
+         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
+            rldf_rat = 1.0_wp
+         ELSE
+            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
+         END IF
+      ELSE
+         rldf_rat = rn_ahtrc_0 / rn_aht_0
+      END IF
+      IF( rldf_rat < 0 ) THEN
+         IF( .NOT.lk_offline ) THEN 
+            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
+         ELSE
+            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
+         ENDIF 
+      ENDIF
+      !
+   END SUBROUTINE ldf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_ldf( kt )
+      INTEGER, INTENT(in) :: kt
+      WRITE(*,*) 'trc_ldf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_ldf
+#endif
+   !!======================================================================
+END MODULE trcldf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90	(revision 3437)
@@ -0,0 +1,179 @@
+MODULE trcnam_trp
+   !!======================================================================
+   !!                       ***  MODULE  trcnam_trp  ***
+   !! TOP :   namelist read options for transport
+   !!======================================================================
+   !! History :   1.0  !  2004-03  (C. Ethe)  Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_nam_trp  : read the passive tracer namelist for transport
+   !!----------------------------------------------------------------------
+   USE trc                 ! ocean passive tracers variables
+   USE in_out_manager      ! ocean dynamics and active tracers variables
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nam_trp    ! routine called by step module
+ 
+   !                                                 !!: ** Advection (nam_trcadv) **
+   LOGICAL , PUBLIC ::   ln_trcadv_cen2   = .FALSE.   ! 2nd order centered scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_tvd    = .TRUE.    ! TVD scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl  = .FALSE.   ! MUSCL scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_muscl2 = .FALSE.   ! MUSCL2 scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_ubs    = .FALSE.   ! UBS scheme flag
+   LOGICAL , PUBLIC ::   ln_trcadv_qck    = .FALSE.   ! QUICKEST scheme flag
+
+   !                                                 !!: ** lateral mixing namelist (nam_trcldf) **
+   LOGICAL , PUBLIC ::   ln_trcldf_diff  = .FALSE.    !: flag of perform or not the lateral diff.
+   LOGICAL , PUBLIC ::   ln_trcldf_lap   = .TRUE.     !: laplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_bilap = .FALSE.    !: bilaplacian operator
+   LOGICAL , PUBLIC ::   ln_trcldf_level = .FALSE.    !: iso-level direction
+   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction
+   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction
+   REAL(wp), PUBLIC ::   rn_ahtrc_0                   !: diffusivity coefficient for passive tracer (m2/s)
+   REAL(wp), PUBLIC ::   rn_ahtrb_0                   !: background diffusivity coefficient for passive tracer (m2/s)
+
+   !                                                 !!: ** Treatment of Negative concentrations ( nam_trcrad )
+   LOGICAL , PUBLIC ::   ln_trcrad       = .TRUE.     !: flag to artificially correct negative concentrations
+
+   !                                                 !!: ** Vertical diffusion (nam_trczdf) **
+   LOGICAL , PUBLIC ::   ln_trczdf_exp = .FALSE.      !: explicit vertical diffusion scheme flag
+   INTEGER , PUBLIC ::   nn_trczdf_exp = 3             !: number of sub-time step (explicit time stepping)
+
+
+#if defined key_trcdmp
+   !                                                 !!: ** newtonian damping namelist (nam_trcdmp) **
+   INTEGER , PUBLIC ::   nn_hdmp_tr      =   -1       ! = 0/-1/'latitude' for damping over passive tracer
+   INTEGER , PUBLIC ::   nn_zdmp_tr      =    0       ! = 0/1/2 flag for damping in the mixed layer
+   REAL(wp), PUBLIC ::   rn_surf_tr      =   50.      ! surface time scale for internal damping        [days]
+   REAL(wp), PUBLIC ::   rn_bot_tr       =  360.      ! bottom time scale for internal damping         [days]
+   REAL(wp), PUBLIC ::   rn_dep_tr       =  800.      ! depth of transition between rn_surf and rn_bot [meters]
+   INTEGER , PUBLIC ::   nn_file_tr      =    2       ! = 1 create a damping.coeff NetCDF file 
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam_trp
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_nam_trp  ***
+      !!                
+      !! ** Purpose :   Read Namelist for tracer transport option
+      !!----------------------------------------------------------------------
+      NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd   ,    &
+         &                 ln_trcadv_muscl, ln_trcadv_muscl2,    &
+         &                 ln_trcadv_ubs  , ln_trcadv_qck
+
+      NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap  ,     &
+         &                 ln_trcldf_bilap, ln_trcldf_level,     &
+         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0
+      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp
+      NAMELIST/namtrc_rad/ ln_trcrad
+#if defined key_trcdmp
+      NAMELIST/namtrc_dmp/ nn_hdmp_tr, nn_zdmp_tr, rn_surf_tr, &
+        &                  rn_bot_tr , rn_dep_tr , nn_file_tr
+#endif
+      !!----------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) ' trc_nam_trp: read namelist for tracer transport'
+      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
+
+      REWIND ( numnat )               ! Read Namelist namtrc_adv : tracer advection scheme
+      READ   ( numnat, namtrc_adv )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_adv_ctl : choice/control of the tracer advection scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_adv : chose a advection scheme for tracers'
+         WRITE(numout,*) '      2nd order advection scheme     ln_trcadv_cen2   = ', ln_trcadv_cen2
+         WRITE(numout,*) '      TVD advection scheme           ln_trcadv_tvd    = ', ln_trcadv_tvd
+         WRITE(numout,*) '      MUSCL  advection scheme        ln_trcadv_muscl  = ', ln_trcadv_muscl
+         WRITE(numout,*) '      MUSCL2 advection scheme        ln_trcadv_muscl2 = ', ln_trcadv_muscl2
+         WRITE(numout,*) '      UBS    advection scheme        ln_trcadv_ubs    = ', ln_trcadv_ubs
+         WRITE(numout,*) '      QUICKEST advection scheme      ln_trcadv_qck    = ', ln_trcadv_qck
+      ENDIF
+      !
+      REWIND( numnat )                ! Namelist namtrc_ldf
+      READ  ( numnat, namtrc_ldf )
+
+      IF(lwp) THEN                    ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:ldf_ctl : lateral tracer diffusive operator'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
+         WRITE(numout,*) '      perform lateral diffusion or not                   ln_trcldf_diff  = ', ln_trcldf_diff
+         WRITE(numout,*) '      laplacian operator                                 ln_trcldf_lap   = ', ln_trcldf_lap
+         WRITE(numout,*) '      bilaplacian operator                               ln_trcldf_bilap = ', ln_trcldf_bilap
+         WRITE(numout,*) '      iso-level                                          ln_trcldf_level = ', ln_trcldf_level
+         WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor
+         WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso
+         WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0
+         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0
+      ENDIF
+
+      !                                ! Vertical mixing
+      REWIND( numnat )                 !   ! Read namtopzdf namelist
+      READ  ( numnat, namtrc_zdf )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_zdf : set vertical diffusion parameters'
+         WRITE(numout,*) '      time splitting / backward scheme ln_trczdf_exp = ', ln_trczdf_exp
+         WRITE(numout,*) '      number of time step              nn_trczdf_exp = ', nn_trczdf_exp
+      ENDIF
+
+      !
+      REWIND( numnat )                 !   Read Namelist namtoprad
+      READ  ( numnat, namtrc_rad )
+
+      IF(lwp) THEN                     !   ! Control print
+         WRITE(numout,*)
+         WRITE(numout,*) '   Namelist namtrc_rad : treatment of negative concentrations'
+         WRITE(numout,*) '      correct artificially negative concen. or not ln_trcrad = ', ln_trcrad
+      ENDIF
+
+
+# if defined key_trcdmp
+      REWIND ( numnat )                  ! Read Namelist namtra_dmp : temperature and salinity damping term
+      READ   ( numnat, namtrc_dmp )
+      IF( lzoom )   nn_zdmp_trc = 0           ! restoring to climatology at closed north or south boundaries
+
+      IF(lwp) THEN                       ! Namelist print
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc_dmp : Passive tracers newtonian damping'
+         WRITE(numout,*) '~~~~~~~'
+         WRITE(numout,*) '   Namelist namtrc_dmp : set damping parameter'
+         WRITE(numout,*) '      tracer damping option          nn_hdmp_tr = ', nn_hdmp_tr
+         WRITE(numout,*) '      mixed layer damping option     nn_zdmp_tr = ', nn_zdmp_tr, '(zoom: forced to 0)'
+         WRITE(numout,*) '      surface time scale (days)      rn_surf_tr = ', rn_surf_tr
+         WRITE(numout,*) '      bottom time scale (days)       rn_bot_tr  = ', rn_bot_tr
+         WRITE(numout,*) '      depth of transition (meters)   rn_dep_tr  = ', rn_dep_tr
+         WRITE(numout,*) '      create a damping.coeff file    nn_file_tr = ', nn_file_tr
+      ENDIF
+#endif
+      !
+   END SUBROUTINE trc_nam_trp
+   
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                         No TOP model
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam_trp              ! Empty routine
+   END SUBROUTINE trc_nam_trp
+#endif
+
+  !!======================================================================
+END MODULE trcnam_trp
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90	(revision 3437)
@@ -0,0 +1,186 @@
+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 trdmod_oce
+   USE trdtra
+   USE tranxt
+# if defined key_agrif
+   USE agrif_top_update
+   USE agrif_top_interp
+# endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_nxt          ! routine called by step.F90
+   PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trc_nxt_alloc()
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_nxt_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc )
+      !
+      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array')
+      !
+   END FUNCTION trc_nxt_alloc
+
+
+   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
+
+      ! Update after tracer on domain lateral boundaries
+      DO jn = 1, jptra
+         CALL lbc_lnk( tra(:,:,:,jn), 'T', 1. )   
+      END DO
+
+
+#if defined key_obc
+!!      CALL obc_trc( kt )               ! OBC open boundaries
+#endif
+#if defined key_bdy
+!!      CALL bdy_trc( kt )               ! BDY open boundaries
+#endif
+#if defined key_agrif
+      CALL Agrif_trc                   ! AGRIF zoom boundaries
+#endif
+
+
+      ! set time step size (Euler/Leapfrog)
+      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler)
+      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog)
+      ENDIF
+
+      ! trends computation initialisation
+      IF( l_trdtrc )  THEN
+         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter
+         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
+         ! Leap-Frog + Asselin filter time stepping
+         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl) 
+         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level 
+         ENDIF
+      ENDIF
+
+#if defined key_agrif
+      ! Update tracer at AGRIF zoom boundaries
+      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Trc( kt )      ! children only
+#endif      
+
+      ! trends computation
+      IF( l_trdtrc ) THEN                                      ! trends
+         DO jn = 1, jptra
+            DO jk = 1, jpkm1
+               zfact = 1.e0 / r2dt(jk)  
+               ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt )
+            END DO
+         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
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90	(revision 3437)
@@ -0,0 +1,214 @@
+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 trdmod_oce
+   USE trdtra
+   USE prtctl_trc          ! Print control for debbuging
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_rad         ! routine called by trcstp.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+   
+CONTAINS
+
+   SUBROUTINE trc_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( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1               )  ! CFC model
+      IF( lk_c14b    )   CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1              )  ! bomb C14
+      IF( lk_lobster )   CALL trc_rad_sms( kt, trb, trn, jp_lob0 , jp_lob1, cpreserv='Y' )  ! LOBSTER model
+      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model
+      IF( lk_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_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_trd_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_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 * FLOAT( nn_dttrc ) )
+               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt
+               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radb, ztrtrdb )       ! Asselin-like trend handling
+               CALL trd_tra( kt, 'TRC', jn, jptra_trd_radn, ztrtrdn )       ! standard     trend handling
+              !
+            ENDIF
+            !
+         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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90	(revision 3437)
@@ -0,0 +1,138 @@
+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 trdmod_oce
+   USE trdtra
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_sbc   ! routine called by step.F90
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_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 minus runoff) 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) ::   zsrau, zse3t   ! temporary scalars
+      CHARACTER (len=22) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemps
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_sbc')
+      !
+      ! Allocate temporary workspace
+                      CALL wrk_alloc( jpi, jpj,      zemps  )
+      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )
+
+      IF( kt == nittrc000 ) THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition'
+         IF(lwp) WRITE(numout,*) '~~~~~~~ '
+      ENDIF
+
+
+      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf
+         zemps(:,:) = emps(:,:)  
+      ELSE                           ! Concentration dilution effect on tracer due to evaporation, precipitation, and river runoff
+         IF( lk_vvl ) THEN                      ! volume variable
+            zemps(:,:) = emps(:,:) - emp(:,:)   
+!!ch         zemps(:,:) = 0.
+         ELSE                                   ! linear free surface
+            IF( ln_rnf ) THEN  ;  zemps(:,:) = emps(:,:) - rnf(:,:)   !  E-P-R
+            ELSE               ;  zemps(:,:) = emps(:,:)
+            ENDIF 
+         ENDIF 
+      ENDIF 
+
+      ! 0. initialization
+      zsrau = 1. / rau0
+      DO jn = 1, jptra
+         !
+         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)  ! save trends
+         !                                             ! add the trend to the general tracer trend
+         DO jj = 2, jpj
+            DO ji = fs_2, fs_jpim1   ! vector opt.
+               zse3t = 1. / fse3t(ji,jj,1)
+               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + zemps(ji,jj) *  zsrau * trn(ji,jj,1,jn) * zse3t
+            END DO
+         END DO
+         
+         IF( l_trdtrc ) THEN
+            ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:)
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_nsr, ztrtrd )
+         END IF
+         !                                                       ! ===========
+      END DO                                                     ! tracer loop
+      !                                                          ! ===========
+      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,      zemps  )
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90	(revision 3437)
@@ -0,0 +1,107 @@
+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 trcnam_trp      ! passive tracers transport namelist variables
+   USE trabbl          ! bottom boundary layer               (trc_bbl routine)
+   USE trcbbl          ! bottom boundary layer               (trc_bbl routine)
+   USE zdfkpp          ! KPP non-local tracer fluxes         (trc_kpp routine)
+   USE trcdmp          ! internal damping                    (trc_dmp routine)
+   USE trcldf          ! 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)
+
+#if defined key_agrif
+   USE agrif_top_sponge ! Momemtum and tracers sponges
+#endif
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_trp    ! called by trc_stp
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_trp( kstp )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_trp  ***
+      !!                      
+      !! ** Purpose :   Management of passive tracers transport
+      !! 
+      !! ** Method  : - Compute the passive tracers trends 
+      !!              - Update the passive tracers
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index
+      !! ---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )   CALL timing_start('trc_trp')
+      !
+      IF( .NOT. lk_c1d ) THEN
+         !
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+         IF( lk_trabbl )        CALL trc_bbl( kstp )            ! advective (and/or diffusive) bottom boundary layer scheme
+         IF( lk_trcdmp )        CALL trc_dmp( kstp )            ! internal damping trends
+                                CALL trc_adv( kstp )            ! horizontal & vertical advection 
+                                CALL trc_ldf( kstp )            ! lateral mixing
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+#if defined key_agrif
+         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc           ! tracers sponge
+#endif
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+         IF( ln_trcrad )        CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         IF( ln_zps    )        CALL zps_hde( kstp, jptra, trn, gtru, gtrv )  ! Partial steps: now horizontal gradient of passive
+                                                                ! tracers at the bottom ocean level
+         !
+      ELSE                                               ! 1D vertical configuration
+                                CALL trc_sbc( kstp )            ! surface boundary condition
+         IF( .NOT. lk_offline .AND. lk_zdfkpp )    &
+            &                   CALL trc_kpp( kstp )            ! KPP non-local tracer fluxes
+                                CALL trc_zdf( kstp )            ! vertical mixing and after tracer fields
+                                CALL trc_nxt( kstp )            ! tracer fields at next time step     
+          IF( ln_trcrad )       CALL trc_rad( kstp )            ! Correct artificial negative concentrations
+         !
+      END IF
+      !
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90	(revision 3437)
@@ -0,0 +1,182 @@
+MODULE trczdf
+   !!==============================================================================
+   !!                 ***  MODULE  trczdf  ***
+   !! Ocean Passive tracers : vertical diffusive trends 
+   !!=====================================================================
+   !! History :  9.0  ! 2005-11 (G. Madec)  Original code
+   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_ldf     : update the tracer trend with the lateral diffusion
+   !!       ldf_ctl : initialization, namelist read, and parameters control
+   !!----------------------------------------------------------------------
+   USE oce_trc         ! ocean dynamics and active tracers
+   USE trc             ! ocean passive tracers variables
+   USE trcnam_trp      ! passive tracers transport namelist variables
+   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine)
+   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine)
+   USE trdmod_oce
+   USE trdtra
+   USE prtctl_trc      ! Print control
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_zdf          ! called by step.F90 
+   PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90 
+
+   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used
+      !                                ! defined from ln_zdf...  namlist logicals)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra
+      !                                                 ! except at nittrc000 (=rdttra) if neuler=0
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "zdfddm_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+   
+   INTEGER FUNCTION trc_zdf_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trc_zdf_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc )
+      !
+      IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.')
+      !
+   END FUNCTION trc_zdf_alloc
+
+
+   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( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options
+
+#if ! defined key_pisces
+      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000
+         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping)
+      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1
+         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+      ENDIF
+#else
+      r2dt(:) =  rdttrc(:)              ! = rdttrc (for PISCES use Euler time stepping)
+#endif
+
+      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 ( -1 )                                       ! esopa: test all possibility with control print
+         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+         CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra ) 
+         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout)
+                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
+      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme 
+      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                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) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)
+            END DO
+            CALL trd_tra( kt, 'TRC', jn, jptra_trd_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 zdf_ctl
+      !!----------------------------------------------------------------------
+      !!                 ***  ROUTINE zdf_ctl  ***
+      !!
+      !! ** Purpose :   Choose the vertical mixing scheme
+      !!
+      !! ** Method  :   Set nzdf from ln_zdfexp
+      !!      nzdf = 0   explicit (time-splitting) scheme (ln_trczdf_exp=T)
+      !!           = 1   implicit (euler backward) scheme (ln_trczdf_exp=F)
+      !!      NB: The implicit scheme is required when using : 
+      !!             - rotated lateral mixing operator
+      !!             - TKE, GLS or KPP vertical mixing scheme
+      !!----------------------------------------------------------------------
+
+      !  Define the vertical tracer physics scheme
+      ! ==========================================
+
+      ! Choice from ln_zdfexp already read in namelist in zdfini module
+      IF( ln_trczdf_exp ) THEN           ! use explicit scheme
+         nzdf = 0
+      ELSE                               ! use implicit scheme
+         nzdf = 1
+      ENDIF
+
+      ! Force implicit schemes
+      IF( ln_trcldf_iso                               )   nzdf = 1      ! iso-neutral lateral physics
+      IF( ln_trcldf_hor .AND. ln_sco                  )   nzdf = 1      ! horizontal lateral physics in s-coordinate
+#if defined key_zdftke || defined key_zdfgls || defined key_zdfkpp
+                                                          nzdf = 1      ! TKE, GLS or KPP physics       
+#endif
+      IF( ln_trczdf_exp .AND. nzdf == 1 )   THEN
+         CALL ctl_stop( 'trc_zdf : If using the rotated lateral mixing operator or TKE, GLS or KPP vertical scheme ', &
+            &           '          the implicit scheme is required, set ln_trczdf_exp = .false.' )
+      ENDIF
+
+      ! Test: esopa
+      IF( lk_esopa )    nzdf = -1                      ! All schemes used
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'trc:zdf_ctl : vertical passive tracer physics scheme'
+         WRITE(numout,*) '~~~~~~~~~~~'
+         IF( nzdf == -1 )   WRITE(numout,*) '              ESOPA test All scheme used'
+         IF( nzdf ==  0 )   WRITE(numout,*) '              Explicit time-splitting scheme'
+         IF( nzdf ==  1 )   WRITE(numout,*) '              Implicit (euler backward) scheme'
+      ENDIF
+
+   END SUBROUTINE zdf_ctl
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option                                         Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_zdf( kt )
+      INTEGER, INTENT(in) :: kt  
+      WRITE(*,*) 'trc_zdf: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_zdf
+#endif
+   !!==============================================================================
+END MODULE trczdf
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90	(revision 3437)
@@ -0,0 +1,1436 @@
+MODULE trdmld_trc
+   !!======================================================================
+   !!                       ***  MODULE  trdmld_trc  ***
+   !! Ocean diagnostics:  mixed layer passive tracer trends 
+   !!======================================================================
+   !! History :  9.0  !  06-08  (C. Deltel)  Original code (from trdmld.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_trdmld_trc   ||   defined key_esopa )
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld_trc'                      mixed layer trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mld_trc      : passive tracer cumulated trends averaged over ML
+   !!   trd_mld_trc_zint : passive tracer trends vertical integration
+   !!   trd_mld_trc_init : initialization step
+   !!----------------------------------------------------------------------
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE dom_oce           ! domain definition
+   USE zdfmxl  , ONLY : nmln !: number of level in the mixed layer
+   USE zdf_oce , ONLY : avt  !: vert. diffusivity coef. at w-point for temp  
+# if defined key_zdfddm   
+   USE zdfddm  , ONLY : avs  !: salinity vertical diffusivity coeff. at w-point
+# endif
+   USE trcnam_trp        ! passive tracers transport namelist variables
+   USE trdmod_trc_oce    ! definition of main arrays used for trends computations
+   USE in_out_manager    ! I/O manager
+   USE dianam            ! build the name of file (routine)
+   USE ldfslp            ! iso-neutral slopes 
+   USE ioipsl            ! NetCDF library
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! MPP library
+   USE trdmld_trc_rst    ! restart for diagnosing the ML trends
+   USE prtctl            ! print control
+   USE sms_pisces        ! PISCES bio-model
+   USE sms_lobster       ! LOBSTER bio-model
+   USE wrk_nemo          ! Memory allocation
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trd_mld_trc
+   PUBLIC trd_mld_trc_alloc
+   PUBLIC trd_mld_bio
+   PUBLIC trd_mld_trc_init
+   PUBLIC trd_mld_trc_zint
+   PUBLIC trd_mld_bio_zint
+
+   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file
+   INTEGER ::   nmoymltrd
+   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1
+   INTEGER, DIMENSION(jptra) ::   nidtrd, nh_t
+   INTEGER ::   ndimtrd1                        
+   INTEGER, SAVE ::  ionce, icount
+#if defined key_lobster
+   INTEGER ::   nidtrdbio, nh_tb
+   INTEGER, SAVE ::  ioncebio, icountbio
+   INTEGER, SAVE ::   nmoymltrdbio
+#endif
+   LOGICAL :: llwarn  = .TRUE.                                    ! this should always be .TRUE.
+   LOGICAL :: lldebug = .TRUE.
+
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   !
+#if defined key_lobster
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztmltrdbio2  ! only needed for mean diagnostics in trd_mld_bio()
+#endif
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+#  include "zdfddm_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header:  $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_mld_trc_alloc()
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_trc_alloc  ***
+      !!----------------------------------------------------------------------
+      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      &
+#if defined key_lobster
+         &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      &
+#endif
+         &      ndextrd1(jpi*jpj)                  ,  STAT=trd_mld_trc_alloc)
+         !
+      IF( lk_mpp                )   CALL mpp_sum ( trd_mld_trc_alloc )
+      IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trd_mld_trc_alloc
+
+
+   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_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_trdmld ! 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 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???)
+#if defined key_pisces || defined key_lobster
+            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion
+#endif
+            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) = fse3t(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_trdmld(:,:,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_trdmld(:,:,1) * wkx_trc(:,:,1)  ! non penetrative
+      END SELECT
+      !
+      CALL wrk_dealloc( jpi, jpj, zvlmsk )
+      !
+   END SUBROUTINE trd_mld_trc_zint
+
+
+   SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_bio_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 in namelist NAMTRD :
+      !!        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          ! bio trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   ptrc_trdmld   ! passive trc trend
+#if defined key_lobster
+      !
+      INTEGER ::   ji, jj, jk, isum
+      REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, zvlmsk )
+
+      ! I. Definition of control surface and integration weights
+      ! --------------------------------------------------------
+      !            ==> only once per time step <==
+
+      IF( icountbio == 1 ) THEN
+         !
+         tmltrd_bio(:,:,:) = 0.e0    ! <<< reset trend arrays to zero
+         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer
+         SELECT CASE ( nn_ctls_trc )                                    ! choice of the control surface
+            CASE ( -2  )   ;   STOP 'trdmld_trc : not ready '     !     -> isopycnal surface (see ???)
+            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion
+            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl)
+            CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file
+            CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 )
+                               nmld_trc(:,:) = nn_ctls_trc + 1          !     -> model level
+         END SELECT
+
+         ! ... Compute ndextrd1 and ndimtrd1 only once
+         IF( ioncebio == 1 ) THEN
+            !
+            ! Check of validity : nmld_trc(ji,jj) <= jpktrd_trc
+            isum        = 0
+            zvlmsk(:,:) = 0.e0
+
+            IF( jpktrd_trc < jpk ) THEN
+               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.
+                     END IF
+                  END DO
+               END DO
+            END IF
+
+            ! Index of ocean points (2D only)
+            IF( isum > 0 ) THEN
+               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 )
+            END IF
+
+            ioncebio = 0                  ! no more pass here
+            !
+         END IF !  ( ioncebio == 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) = fse3t(ji,jj,jk) * tmask(ji,jj,jk)
+               END DO
+            END DO
+         END DO
+
+         rmld_trc(:,:) = 0.
+         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
+
+         icountbio = 0                    ! <<< flag = off : control surface & integr. weights
+         !                             !     computed only once per time step
+      END IF ! ( icountbio == 1 )
+
+      ! II. Vertical integration of trends in the mixed-layer
+      ! -----------------------------------------------------
+
+
+      DO jk = 1, jpktrd_trc
+         tmltrd_bio(:,:,ktrd) = tmltrd_bio(:,:,ktrd) + ptrc_trdmld(:,:,jk) * wkx_trc(:,:,jk)
+      END DO
+
+      CALL wrk_alloc( jpi, jpj, zvlmsk )
+#endif
+      !
+   END SUBROUTINE trd_mld_bio_zint
+
+
+   SUBROUTINE trd_mld_trc( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_trc  ***
+      !! 
+      !! ** Purpose :  Compute and cumulate the mixed layer trends over an analysis
+      !!               period, and write NetCDF (or dimg) outputs.
+      !!
+      !! ** Method/usage :
+      !!          The stored trends can be chosen twofold (according to the ln_trdmld_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_trdmld_trc_instant=.false.
+      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmld_trc_instant=.true.
+      !!
+      !! ** Action :
+      !!       At each time step, mixed-layer averaged trends are stored in the 
+      !!       tmltrd(:,:,jpmld_xxx) array (see trdmld_oce.F90 for definitions of jpmld_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
+#if defined key_dimgout
+      INTEGER ::   iyear,imon,iday
+      CHARACTER(LEN=80) ::   cltext, clmode
+#endif
+      !!----------------------------------------------------------------------
+
+      ! 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,jpmld_trc_zdf,jn) = - zavt / fse3w(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(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn)
+   
+         END DO
+         !      
+      ENDIF
+
+#if ! defined key_gyre
+      ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm. 
+      ! 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
+#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(:,:,jpmld_trc_atf,jn)
+               tmlradn_trc(:,:,jn) = tmltrd_trc(:,:,jpmld_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 ! defined key_gyre
+
+               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 trdmld. 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(:,:,jpmld_trc_atf ,jn) + tmltrd_atf_sumb_trc(:,:,jn) &
+                  &                     - tmltrd_sum_trc(:,:,jpmld_trc_radb,jn) + tmltrd_rad_sumb_trc(:,:,jn) )
+               !
+
+               !-- Diagnose Asselin trend over the analysis window
+               ztmlatf2(:,:,jn) = ztmltrd2(:,:,jpmld_trc_atf ,jn) - tmltrd_sum_trc(:,:,jpmld_trc_atf ,jn) &
+                  &                                               + tmltrd_atf_sumb_trc(:,:,jn)
+               ztmlrad2(:,:,jn) = ztmltrd2(:,:,jpmld_trc_radb,jn) - tmltrd_sum_trc(:,:,jpmld_trc_radb,jn) &
+                  &                                               + tmltrd_rad_sumb_trc(:,:,jn)
+
+         !-- Lateral boundary conditions
+#if ! defined key_gyre         
+               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_mld_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(:,:,jpmld_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(:,:,jpmld_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 jpmld_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(:,:,jpmld_trc_atf ,jn)
+               tmltrd_rad_sumb_trc(:,:,jn)   = tmltrd_sum_trc(:,:,jpmld_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 dimg mpp output
+      ! -----------------------------
+
+# if defined key_dimgout
+      STOP 'Not implemented'
+# else
+      
+      ! IV.2 Code for IOIPSL/NetCDF output
+      ! ----------------------------------
+
+      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'trd_mld_trc : write passive tracer trends in the NetCDF file :'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+         WRITE(numout,*) '          ', trim(clhstnam), ' at kt = ', kt
+         WRITE(numout,*) '          N.B. nmoymltrd = ', nmoymltrd
+         WRITE(numout,*) ' '
+      ENDIF
+         
+      NETCDF_OUTPUT : IF( ln_trdmld_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(jpmld_trc_radb,2)),    &  ! now trcrad    : jpltrd_trc - 1
+                    &          it, ztmlrad(:,:,jn), ndimtrd1, ndextrd1 )
+
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmld_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(jpmld_trc_radb,2)),   &  ! now trcrad    : jpltrd_trc - 1
+                 &          it, ztmlrad2(:,:,jn), ndimtrd1, ndextrd1 )
+
+               CALL histwrite( nidtrd(jn), trim(clvar)//trim(ctrd_trc(jpmld_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
+
+# endif /* key_dimgout */
+
+      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_mld_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_mld_trc
+
+
+   SUBROUTINE trd_mld_bio( kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld  ***
+      !!
+      !! ** Purpose :  Compute and cumulate the mixed layer biological trends over an analysis
+      !!               period, and write NetCDF (or dimg) outputs.
+      !!
+      !! ** Method/usage :
+      !!          The stored trends can be chosen twofold (according to the ln_trdmld_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 ntrd 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 > 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. ntrd=5, ucf=1., nctls=8
+      !!             for checking residuals.
+      !!             On a NEC-SX5 computer, this typically leads to:
+      !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmld_trc_instant=.false.
+      !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmld_trc_instant=.true.
+      !!
+      !! ** Action :
+      !!       At each time step, mixed-layer averaged trends are stored in the
+      !!       tmltrd(:,:,jpmld_xxx) array (see trdmld_oce.F90 for definitions of jpmld_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
+#if defined key_lobster
+      INTEGER  ::  jl, it, itmod
+      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE.
+      REAL(wp) :: zfn, zfn2
+#if defined key_dimgout
+      INTEGER ::  iyear,imon,iday
+      CHARACTER(LEN=80) :: cltext, clmode
+#endif
+      !!----------------------------------------------------------------------
+      ! ... Warnings
+      IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " )
+
+      ! ======================================================================
+      ! II. Cumulate the trends over the analysis window
+      ! ======================================================================
+
+      ztmltrdbio2(:,:,:) = 0.e0  ! <<< reset arrays to zero
+
+      ! 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)
+         !
+         tmltrd_csum_ub_bio (:,:,:) = 0.e0
+         !
+      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
+      !                            ntrd                             2*ntrd       etc.
+      !     1      2     3     4    =5 e.g.                          =10
+      !
+      IF( ( kt >= 2 ).OR.( ln_rsttr ) ) THEN
+         !
+         nmoymltrdbio = nmoymltrdbio + 1
+
+         ! ... Trends associated with the time mean of the ML passive tracers
+         tmltrd_sum_bio    (:,:,:) = tmltrd_sum_bio    (:,:,:) + tmltrd_bio    (:,:,:)
+         tmltrd_csum_ln_bio(:,:,:) = tmltrd_csum_ln_bio(:,:,:) + tmltrd_sum_bio(:,:,:)
+         !
+      END IF
+
+      ! ======================================================================
+      ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD)
+      ! ======================================================================
+
+      ! Convert to appropriate physical units
+      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * rn_ucf_trc
+
+      MODULO_NTRD : IF( MOD( kt, nn_trd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd
+         !
+         zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn
+
+         ! III.1 Prepare fields for output ("instantaneous" diagnostics)
+         ! -------------------------------------------------------------
+
+#if defined key_diainstant
+         STOP 'tmltrd_bio : key_diainstant was never checked within trdmld. Comment this to proceed.'
+#endif
+         ! III.2 Prepare fields for output ("mean" diagnostics)
+         ! ----------------------------------------------------
+
+         ztmltrdbio2(:,:,:) = tmltrd_csum_ub_bio(:,:,:) + tmltrd_csum_ln_bio(:,:,:)
+
+         !-- Lateral boundary conditions
+#if ! defined key_gyre
+         ! ES_B27_CD_WARN : lbc inutile GYRE, cf. + haut
+         DO jn = 1, jpdiabio
+           CALL lbc_lnk( ztmltrdbio2(:,:,jn), 'T', 1. )
+         ENDDO
+#endif
+         IF( lldebug ) THEN
+            !
+            WRITE(numout,*) 'trd_mld_bio : write trends in the Mixed Layer for debugging process:'
+            WRITE(numout,*) '~~~~~~~~~~~  '
+            WRITE(numout,*) 'TRC kt = ', kt, 'nmoymltrdbio = ', nmoymltrdbio
+            WRITE(numout,*)
+
+            DO jl = 1, jpdiabio
+              IF( ln_trdmld_trc_instant ) THEN
+                  WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, &
+                     & ' SUM tmltrd_bio : ', SUM2D(tmltrd_bio(:,:,jl))
+              ELSE
+                  WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, &
+                     & ' SUM ztmltrdbio2 : ', SUM2D(ztmltrdbio2(:,:,jl))
+              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
+         ! -------------------------------
+
+         ! For passive tracer mean diagnostics
+         tmltrd_csum_ub_bio (:,:,:) = zfn * tmltrd_sum_bio(:,:,:) - tmltrd_csum_ln_bio(:,:,:)
+
+         ! III.4 Convert to appropriate physical units
+         ! -------------------------------------------
+         ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * rn_ucf_trc/zfn2
+
+      END IF MODULO_NTRD
+
+      ! ======================================================================
+      ! IV. Write trends in the NetCDF file
+      ! ======================================================================
+
+      ! IV.1 Code for dimg mpp output
+      ! -----------------------------
+
+# if defined key_dimgout
+      STOP 'Not implemented'
+# else
+
+      ! IV.2 Code for IOIPSL/NetCDF output
+      ! ----------------------------------
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+
+      IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN
+         WRITE(numout,*) ' '
+         WRITE(numout,*) 'trd_mld_bio : write ML bio trends in the NetCDF file :'
+         WRITE(numout,*) '~~~~~~~~~~~ '
+         WRITE(numout,*) '          ', TRIM(clhstnam), ' at kt = ', kt
+         WRITE(numout,*) '          N.B. nmoymltrdbio = ', nmoymltrdbio
+         WRITE(numout,*) ' '
+      END IF
+
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      NETCDF_OUTPUT : IF( ln_trdmld_trc_instant ) THEN    ! <<< write the trends for passive tracer instant. diags
+         !
+            DO jl = 1, jpdiabio
+               CALL histwrite( nidtrdbio,TRIM("ML_"//ctrd_bio(jl,2)) ,            &
+                    &          it, tmltrd_bio(:,:,jl), ndimtrd1, ndextrd1 )
+            END DO
+
+
+         IF( kt == nitend )   CALL histclo( nidtrdbio )
+
+      ELSE    ! <<< write the trends for passive tracer mean diagnostics
+
+            DO jl = 1, jpdiabio
+               CALL histwrite( nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)) ,            &
+                    &          it, ztmltrdbio2(:,:,jl), ndimtrd1, ndextrd1 )
+            END DO
+
+            IF( kt == nitend )   CALL histclo( nidtrdbio )
+            !
+      END IF NETCDF_OUTPUT
+
+      ! Compute the control surface (for next time step) : flag = on
+      icountbio = 1
+
+
+# endif /* key_dimgout */
+
+      IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN
+         !
+         ! III.5 Reset cumulative arrays to zero
+         ! -------------------------------------
+         nmoymltrdbio = 0
+         tmltrd_csum_ln_bio (:,:,:) = 0.e0
+         tmltrd_sum_bio     (:,:,:) = 0.e0
+      END IF
+
+      ! ======================================================================
+      ! Write restart file
+      ! ======================================================================
+
+! restart write is done in trd_mld_trc_write which is called by trd_mld_bio (Marina)
+!
+#endif
+   END SUBROUTINE trd_mld_bio
+
+
+   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_mld_trc_init
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mld_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_mld_trc_init : Mixed-layer trends for passive tracers                '
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
+         WRITE(numout,*)
+      ENDIF
+
+      
+      ! I.1 Check consistency of user defined preferences
+      ! -------------------------------------------------
+
+      IF( ( lk_trdmld_trc ) .AND. ( MOD( nitend, nn_trd_trc ) /= 0 ) ) THEN
+         WRITE(numout,cform_err)
+         WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend
+         WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        '
+         WRITE(numout,*) '                          you defined, 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_trdmld_trc_instant = ', ln_trdmld_trc_instant
+      ENDIF
+
+      IF( ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) .AND. .NOT. ln_trdmld_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 trdmld_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 defined key_lobster
+      nmoymltrdbio   = 0
+      tmltrd_sum_bio     (:,:,:) = 0.e0     ;   tmltrd_csum_ln_bio (:,:,:) = 0.e0
+      DO jl = 1, jp_lobster_trd
+          ctrd_bio(jl,1) = ctrbil(jl)   ! long name
+          ctrd_bio(jl,2) = ctrbio(jl)   ! short name
+       ENDDO
+#endif
+
+      IF( ln_rsttr .AND. ln_trdmld_trc_restart ) THEN
+         CALL trd_mld_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 
+#if defined key_lobster
+         tmltrd_csum_ub_bio (:,:,:) = 0.e0
+#endif
+
+       ENDIF
+
+      icount = 1   ;   ionce  = 1  ! open specifier   
+
+#if defined key_lobster
+      icountbio = 1   ;   ioncebio  = 1  ! open specifier
+#endif
+
+      ! 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
+      ! ======================================================================
+
+#if defined key_dimgout 
+      ???
+#else
+      ! 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 cpu time)
+      ENDIF
+#  if defined key_diainstant
+      IF( .NOT. ln_trdmld_trc_instant ) THEN
+         STOP 'trd_mld_trc : this was never checked. Comment this line to proceed...'
+      ENDIF
+      zsto = nn_trd_trc * rdt
+      clop = "inst("//TRIM(clop)//")"
+#  else
+      IF( ln_trdmld_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 trdmld_trc_oce.F90 <==
+
+      ctrd_trc(jpmld_trc_xad    ,1) = " Zonal advection"                 ;   ctrd_trc(jpmld_trc_xad    ,2) = "_xad"
+      ctrd_trc(jpmld_trc_yad    ,1) = " Meridional advection"            ;   ctrd_trc(jpmld_trc_yad    ,2) = "_yad"
+      ctrd_trc(jpmld_trc_zad    ,1) = " Vertical advection"              ;   ctrd_trc(jpmld_trc_zad    ,2) = "_zad"
+      ctrd_trc(jpmld_trc_ldf    ,1) = " Lateral diffusion"               ;   ctrd_trc(jpmld_trc_ldf    ,2) = "_ldf"
+      ctrd_trc(jpmld_trc_zdf    ,1) = " Vertical diff. (Kz)"             ;   ctrd_trc(jpmld_trc_zdf    ,2) = "_zdf"
+      ctrd_trc(jpmld_trc_bbl    ,1) = " Adv/diff. Bottom boundary layer" ;   ctrd_trc(jpmld_trc_bbl    ,2) = "_bbl"
+      ctrd_trc(jpmld_trc_dmp    ,1) = " Tracer damping"                  ;   ctrd_trc(jpmld_trc_dmp    ,2) = "_dmp"
+      ctrd_trc(jpmld_trc_sbc    ,1) = " Surface boundary cond."          ;   ctrd_trc(jpmld_trc_sbc    ,2) = "_sbc"
+      ctrd_trc(jpmld_trc_sms,    1) = " Sources minus sinks"             ;   ctrd_trc(jpmld_trc_sms    ,2) = "_sms"
+      ctrd_trc(jpmld_trc_radb   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radb   ,2) = "_radb"
+      ctrd_trc(jpmld_trc_radn   ,1) = " Correct negative concentrations" ;   ctrd_trc(jpmld_trc_radn   ,2) = "_radn"
+      ctrd_trc(jpmld_trc_atf    ,1) = " Asselin time filter"             ;   ctrd_trc(jpmld_trc_atf    ,2) = "_atf"
+
+      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
+
+#if defined key_lobster
+          !-- Create a NetCDF file and enter the define mode
+          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' )
+          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            &
+             &             1, jpi, 1, jpj, iiter, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set )
+#endif
+
+      !-- 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 /= jpmld_trc_atf .OR.  jpltrd_trc - 1 /= jpmld_trc_radb ) THEN
+         STOP 'Error : jpltrd_trc /= jpmld_trc_atf .OR.  jpltrd_trc - 1 /= jpmld_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 == jpmld_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(jpmld_trc_radb,2)), clmxl//" "//clvar//ctrd_trc(jpmld_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(jpmld_trc_atf,2)), clmxl//" "//clvar//ctrd_trc(jpmld_trc_atf,1),   & 
+              &       cltrcu, jpi, jpj, nh_t(jn), 1  , 1, 1  , -99 , 32, clop, zout, zout ) ! IOIPSL: NO time mean
+         !
+         ENDIF
+      END DO
+
+#if defined key_lobster
+      DO jl = 1, jp_lobster_trd
+         CALL histdef(nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)), TRIM(clmxl//" ML_"//ctrd_bio(jl,1))   ,            &
+             &    cltrcu, jpi, jpj, nh_tb, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean
+      END DO                                                                         ! if zsto=rdt above
+#endif
+
+      !-- Leave IOIPSL/NetCDF define mode
+      DO jn = 1, jptra
+         IF( ln_trdtrc(jn) )  CALL histend( nidtrd(jn), snc4set )
+      END DO
+
+#if defined key_lobster
+      !-- Leave IOIPSL/NetCDF define mode
+      CALL histend( nidtrdbio, snc4set )
+
+      IF(lwp) WRITE(numout,*)
+       IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization for ML bio trends'
+#endif
+
+#endif        /* key_dimgout */
+   END SUBROUTINE trd_mld_trc_init
+
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trd_mld_trc( kt )                                   ! Empty routine
+      INTEGER, INTENT( in) ::   kt
+      WRITE(*,*) 'trd_mld_trc: You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mld_trc
+   SUBROUTINE trd_mld_bio( kt )
+      INTEGER, INTENT( in) ::   kt
+      WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mld_bio
+   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, 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_trdmld            ! passive trc trend
+      WRITE(*,*) 'trd_mld_trc_zint: You should not have seen this print! error?', ptrc_trdmld(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_mld_trc_zint
+   SUBROUTINE trd_mld_trc_init                                    ! Empty routine
+      WRITE(*,*) 'trd_mld_trc_init: You should not have seen this print! error?'
+   END SUBROUTINE trd_mld_trc_init
+#endif
+
+   !!======================================================================
+END MODULE trdmld_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc_rst.F90	(revision 3437)
@@ -0,0 +1,220 @@
+MODULE trdmld_trc_rst
+   !!======================================================================
+   !!                       ***  MODULE  trdmld_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_trdmld_trc
+   !!----------------------------------------------------------------------
+   USE in_out_manager  ! I/O manager
+   USE iom             ! I/O module
+   USE trc             ! for nn_dttrc ctrcnm
+   USE trdmod_trc_oce  ! for lk_trdmld_trc
+
+   IMPLICIT NONE
+   PRIVATE
+  
+   PUBLIC   trd_mld_trc_rst_read    ! routine called by trd_mld_init
+   PUBLIC   trd_mld_trc_rst_write   ! routine called by step.F90
+  
+   INTEGER ::   nummldw_trc               ! logical unit for mld restart
+   !!---------------------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!---------------------------------------------------------------------------------
+  
+CONTAINS
+  
+
+    SUBROUTINE trd_mld_trc_rst_write( kt )
+      !!--------------------------------------------------------------------------------
+      !!                  ***  SUBROUTINE trd_mld_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   ! ice output restart file name
+      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)
+         IF(lwp) WRITE(numout,*) '             open ocean restart_mld_trc NetCDF  '//clname
+         CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib )
+      ENDIF
+
+      IF( kt == nitend .AND. lk_trdmld_trc ) THEN
+
+         IF( kt == nitend .AND. lwp ) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) 'trdmld_trc_rst: output for ML diags. restart, with trd_mld_trc_rst_write routine'
+            WRITE(numout,*) '~~~~~~~~~~~~~~'
+            WRITE(numout,*)
+         ENDIF
+
+         IF( ln_trdmld_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
+            !                                                          ! ===========
+#if defined key_lobster
+            DO jl = 1, jp_lobster_trd
+               CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )
+            ENDDO
+#endif
+
+         ENDIF
+         
+         CALL iom_close( nummldw_trc )
+         lrst_trc = .TRUE.
+
+      ENDIF
+
+    END SUBROUTINE trd_mld_trc_rst_write
+
+
+    SUBROUTINE trd_mld_trc_rst_read
+      !!----------------------------------------------------------------------------
+      !!                   ***  SUBROUTINE trd_mld_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
+      !!-----------------------------------------------------------------------------
+      
+      IF(lwp)  THEN
+         WRITE(numout,*)
+         WRITE(numout,*) ' trd_mld_trc_rst_read : read the NetCDF MLD restart file'
+         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~'
+      ENDIF
+      
+      IF ( jprstlib == jprstdimg ) THEN
+        ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+        ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90
+        INQUIRE( FILE = TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok )
+        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+      ENDIF
+
+      CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt ) 
+      
+      IF( ln_trdmld_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
+         !                                                          ! ===========
+
+#if defined key_lobster
+         DO jl = 1, jp_lobster_trd
+            CALL iom_get( inum, jpdom_autoglo, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) )
+         ENDDO
+#endif
+         
+         CALL iom_close( inum )
+      ENDIF
+      
+    END SUBROUTINE trd_mld_trc_rst_read
+  
+#else
+  !!=================================================================================
+  !!                       ***  MODULE  trdmld_rst  ***
+  !! Ocean dynamic :  Input/Output files for restart on mixed-layer diagnostics
+  !!=================================================================================
+CONTAINS
+  SUBROUTINE trd_mld_trc_rst_opn( kt )
+    WRITE(*,*) 'trd_mld_trc_rst_opn: You should not have seen this print! error?', kt
+  END SUBROUTINE trd_mld_trc_rst_opn
+  SUBROUTINE trd_mld_trc_rst_write( kt )           !  No ML diags ==> empty routine
+    WRITE(*,*) 'trd_mld_trc_rst_wri: You should not have seen this print! error?', kt
+  END SUBROUTINE trd_mld_trc_rst_write
+  SUBROUTINE trd_mld_trc_rst_read                  !  No ML Diags ==> empty routine
+  END SUBROUTINE trd_mld_trc_rst_read
+#endif
+
+  !!=================================================================================
+END MODULE trdmld_trc_rst
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc.F90	(revision 3437)
@@ -0,0 +1,158 @@
+MODULE trdmod_trc
+   !!======================================================================
+   !!                       ***  MODULE  trdmod_trc  ***
+   !! Ocean diagnostics:  mixed layer passive tracer trends 
+   !!======================================================================
+   !! History :  3.0  !  2010-07  (C. Ethe)  Original code (from trdmod.F90)
+   !!----------------------------------------------------------------------
+#if   defined key_top && ( defined key_trdmld_trc   ||   defined key_trdtrc )
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld_trc'                  mixed layer trend diagnostics
+   !!   'key_trdtrc'                      3D trend diagnostics
+   !!----------------------------------------------------------------------
+   !!   trd_mod_trc      : passive tracer trends 
+   !!----------------------------------------------------------------------
+   USE trc               ! tracer definitions (trn, trb, tra, etc.)
+   USE trcnam_trp
+   USE trdmod_oce
+   USE trdmod_trc_oce    ! definition of main arrays used for trends computations
+   USE trdmld_trc        ! Mixed layer trends diag.
+   USE iom               ! I/O library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   INTERFACE trd_mod_trc
+      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
+   END INTERFACE
+
+   PUBLIC trd_mod_trc
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header:  $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod_trc  ***
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in )  ::   kt                                  ! time step
+      INTEGER, INTENT( in )  ::   kjn                                 ! tracer index
+      INTEGER, INTENT( in )  ::   ktrd                                ! tracer trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
+      CHARACTER (len=20) :: cltra
+      !!----------------------------------------------------------------------
+
+      IF( kt == nittrc000 ) THEN
+!         IF(lwp)WRITE(numout,*)
+!         IF(lwp)WRITE(numout,*) 'trd_mod_trc:'
+!         IF(lwp)WRITE(numout,*) '~~~~~~~~~~~~'
+      ENDIF
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      ! Mixed layer trends for passive tracers
+      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+#if defined key_trdmld_trc  
+      IF( lk_trdmld_trc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE ( ktrd )
+         CASE ( jptra_trd_xad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_xad, '3D', kjn )
+         CASE ( jptra_trd_yad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_yad, '3D', kjn )
+         CASE ( jptra_trd_zad     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zad, '3D', kjn )
+         CASE ( jptra_trd_ldf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn )
+         CASE ( jptra_trd_bbl     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_bbl, '3D', kjn )
+         CASE ( jptra_trd_zdf     )
+            IF( ln_trcldf_iso ) THEN
+               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_ldf, '3D', kjn )
+            ELSE
+               CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_zdf, '3D', kjn )
+            ENDIF
+         CASE ( jptra_trd_dmp     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_dmp , '3D', kjn )
+         CASE ( jptra_trd_nsr     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sbc , '2D', kjn )
+         CASE ( jptra_trd_sms     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_sms , '3D', kjn )
+         CASE ( jptra_trd_radb    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radb, '3D', kjn )
+         CASE ( jptra_trd_radn    )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_radn, '3D', kjn )
+         CASE ( jptra_trd_atf     )   ;   CALL trd_mld_trc_zint( ptrtrd, jpmld_trc_atf , '3D', kjn )
+         END SELECT
+         !
+      END IF
+#endif
+
+      IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN
+         !
+         SELECT CASE( ktrd )
+         CASE( jptra_trd_xad  )       ;    WRITE (cltra,'("XAD_",4a)')
+         CASE( jptra_trd_yad  )       ;    WRITE (cltra,'("YAD_",4a)')
+         CASE( jptra_trd_zad  )       ;    WRITE (cltra,'("ZAD_",4a)')
+         CASE( jptra_trd_ldf  )       ;    WRITE (cltra,'("LDF_",4a)')
+         CASE( jptra_trd_bbl  )       ;    WRITE (cltra,'("BBL_",4a)')
+         CASE( jptra_trd_nsr  )       ;    WRITE (cltra,'("FOR_",4a)')
+         CASE( jptra_trd_zdf  )       ;    WRITE (cltra,'("ZDF_",4a)')
+         CASE( jptra_trd_dmp  )       ;    WRITE (cltra,'("DMP_",4a)')
+         CASE( jptra_trd_sms  )       ;    WRITE (cltra,'("SMS_",4a)')
+         CASE( jptra_trd_atf  )       ;    WRITE (cltra,'("ATF_",4a)')
+         CASE( jptra_trd_radb )       ;    WRITE (cltra,'("RDB_",4a)')
+         CASE( jptra_trd_radn )       ;    WRITE (cltra,'("RDN_",4a)')
+         END SELECT
+                                          cltra = TRIM(cltra)//TRIM(ctrcnm(kjn))
+                                          CALL iom_put( cltra,  ptrtrd(:,:,:) )
+         !
+      END IF
+
+   END SUBROUTINE trd_mod_trc_trp
+
+   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE trd_mod_bio  ***
+      !!----------------------------------------------------------------------
+
+      INTEGER, INTENT( in )  ::   kt                                  ! time step
+      INTEGER, INTENT( in )  ::   ktrd                                ! bio trend index
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout )  ::   ptrbio  ! Bio trend
+      !!----------------------------------------------------------------------
+
+#if defined key_trdmld_trc  
+      CALL trd_mld_bio_zint( ptrbio, ktrd ) ! Verticaly integrated biological trends
+#endif
+
+   END SUBROUTINE trd_mod_trc_bio
+#else
+   !!----------------------------------------------------------------------
+   !!   Default option :                                       Empty module
+   !!----------------------------------------------------------------------
+
+   INTERFACE trd_mod_trc
+      MODULE PROCEDURE trd_mod_trc_trp, trd_mod_trc_bio
+   END INTERFACE
+
+CONTAINS
+
+   SUBROUTINE trd_mod_trc_trp( ptrtrd, kjn, ktrd, kt )
+      INTEGER               , INTENT( in )     ::   kt      ! time step
+      INTEGER               , INTENT( in )     ::   kjn     ! tracer index
+      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
+      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrtrd  ! Temperature or U trend
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mod_trc_trp
+
+   SUBROUTINE trd_mod_trc_bio( ptrbio, ktrd, kt )
+      INTEGER               , INTENT( in )     ::   kt      ! time step
+      INTEGER               , INTENT( in )     ::   ktrd    ! tracer trend index
+      REAL, DIMENSION(:,:,:), INTENT( inout )  ::   ptrbio  ! Temperature or U trend
+      WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrbio(1,1,1)
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', ktrd
+      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kt
+   END SUBROUTINE trd_mod_trc_bio
+
+#endif
+   !!======================================================================
+END MODULE trdmod_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90	(revision 3437)
@@ -0,0 +1,180 @@
+MODULE trdmod_trc_oce
+   !!======================================================================
+   !!                   ***  MODULE trdmod_trc_oce  ***
+   !! Ocean trends :   set tracer and momentum trend variables
+   !!======================================================================
+#if defined key_top   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameters
+   USE par_trc       ! passive tracers parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !                                         !!* Namelist namtoptrd:  diagnostics on passive tracers trends
+   INTEGER  ::    nn_trd_trc                  !: time step frequency dynamics and tracers trends
+   INTEGER  ::    nn_ctls_trc                 !: control surface type for trends vertical integration
+   REAL(wp) ::    rn_ucf_trc                  !: unit conversion factor (for netCDF trends outputs)
+   LOGICAL  ::    ln_trdmld_trc_instant       !: flag to diagnose inst./mean ML trc trends
+   LOGICAL  ::    ln_trdmld_trc_restart       !: flag to restart mixed-layer trc diagnostics
+   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input)
+   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output)
+   LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist)
+
+# if defined key_trdtrc && defined key_iomput
+   LOGICAL, PARAMETER ::   lk_trdtrc = .TRUE. 
+# else
+   LOGICAL, PARAMETER ::   lk_trdtrc = .FALSE.   !: ML trend flag
+# endif
+
+# if defined key_trdmld_trc   ||   defined key_esopa
+   !!----------------------------------------------------------------------
+   !!   'key_trdmld_trc'                     mixed layer trends diagnostics
+   !!----------------------------------------------------------------------
+
+   LOGICAL, PARAMETER ::   lk_trdmld_trc = .TRUE.    !: ML trend flag
+
+   INTEGER, PARAMETER ::            & !: mixed layer trends indices
+        jpmld_trc_xad     =  1,     & !:     zonal       advection     
+        jpmld_trc_yad     =  2,     & !:     meridonal   =========
+        jpmld_trc_zad     =  3,     & !:     vertical    =========
+        jpmld_trc_ldf     =  4,     & !:     lateral diffusion (geopot. or iso-neutral)
+        jpmld_trc_zdf     =  5,     & !:     vertical diffusion (TKE)
+        jpmld_trc_bbl     =  6,     & !:     bottom boundary layer (advective/diffusive)
+        jpmld_trc_dmp     =  7,     & !:     internal restoring trend
+        jpmld_trc_sbc     =  8,     & !:     forcing 
+        jpmld_trc_sms     =  9,     & !:     sources minus sinks trend
+  !     jpmld_trc_xxx     = xx,     & !:     add here any additional trend    (** AND UPDATE JPLTRD_TRC BELOW **)
+        jpmld_trc_radn    = 10,     & !:     corr. trn<0 in trcrad
+        jpmld_trc_radb    = 11,     & !:     corr. trb<0 in trcrad (like atf) (** MUST BE BEFORE THE LAST ONE **)
+        jpmld_trc_atf     = 12        !:     asselin trend                    (** MUST BE    THE      LAST ONE**)
+
+   !! Trends diagnostics parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PARAMETER :: jpltrd_trc = 12    !: number of mixed-layer trends arrays
+      
+   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_trdmld_trc = .FALSE.   !: ML trend flag
+# endif
+
+# if defined key_lobster
+   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2)
+   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &
+      tmltrd_bio,                         &      !: \ biological contributions to the total trend ,
+                                                 !: / cumulated over the current analysis window
+      tmltrd_sum_bio,                     &      !: sum of these trends over the analysis period
+      tmltrd_csum_ln_bio,                 &      !: now cumulated sum of trends over the "lower triangle"
+      tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the
+                                                 !: upper triangle
+#endif
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   INTEGER FUNCTION trd_mod_trc_oce_alloc()
+      !!----------------------------------------------------------------------
+      !!         *** ROUTINE trd_mod_trc_oce_alloc ***
+      !!----------------------------------------------------------------------
+      USE lib_mpp, ONLY: ctl_warn
+      INTEGER :: ierr(2)
+      !!----------------------------------------------------------------------
+      ierr(:) = 0
+      !
+# if defined key_trdmld_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
+      !
+# if defined key_lobster
+      ALLOCATE( tmltrd_bio        (jpi,jpj,jpdiabio) ,     &
+         &      tmltrd_sum_bio    (jpi,jpj,jpdiabio) ,     &
+         &      tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) ,     &
+         &      tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) )
+# endif
+      !
+      trd_mod_trc_oce_alloc = MAXVAL(ierr)
+      !
+      IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc: failed to allocate arrays')
+      !
+# if defined key_trdmld_trc
+      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag.
+# endif
+      !
+   END FUNCTION trd_mod_trc_oce_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE trdmod_trc_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90	(revision 3437)
@@ -0,0 +1,290 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+
+   !* Domain size *
+   USE par_oce , ONLY :   cp_cfg   =>   cp_cfg     !: name of the configuration
+   USE par_oce , ONLY :   jp_cfg   =>   jp_cfg     !: resolution of the configuration
+   USE par_oce , ONLY :   jpiglo   =>   jpiglo     !: first  dimension of global domain --> i
+   USE par_oce , ONLY :   jpjglo   =>   jpjglo     !: second dimension of global domain --> j
+   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 :   jpidta   =>   jpidta     !: first horizontal dimension  > or = jpi
+   USE par_oce , ONLY :   jpjdta   =>   jpjdta     !: second horizontal dimension > or = jpj
+   USE par_oce , ONLY :   jpkdta   =>   jpkdta     !: number of levels            > or = jpk
+   USE par_oce , ONLY :   lk_esopa =>   lk_esopa   !: flag to activate the all option
+   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature
+   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity
+
+   !* IO manager *
+   USE in_out_manager    
+ 
+   !* Memory Allocation *
+   USE wrk_nemo      
+ 
+   !* Timing *
+   USE timing    
+ 
+   !* MPP library                         
+   USE lib_mpp 
+
+   !* Fortran utilities                         
+   USE lib_fortran
+
+   !* Lateral boundary conditions                         
+   USE lbclnk
+
+   !* physical constants *
+   USE phycst            
+
+   !* 1D configuration
+   USE c1d                                         
+
+   !* model domain *
+   USE dom_oce , ONLY :   lzoom      => lzoom        !: zoom flag
+   USE dom_oce , ONLY :   lzoom_e    => lzoom_e      !: East  zoom type flag
+   USE dom_oce , ONLY :   lzoom_w    => lzoom_w      !: West  zoom type flag
+   USE dom_oce , ONLY :   lzoom_s    => lzoom_s      !: South zoom type flag
+   USE dom_oce , ONLY :   lzoom_n    => lzoom_n      !: North zoom type flag
+   USE dom_oce , ONLY :   lzoom_arct => lzoom_arct   !: ORCA    arctic zoom flag
+   USE dom_oce , ONLY :   lzoom_anta => lzoom_anta   !: ORCA antarctic zoom flag
+   USE dom_oce , ONLY :   nperio     =>   nperio     !: type of lateral boundary condition       
+   USE dom_oce , ONLY :   nimpp      =>   nimpp      !: i index for mpp-subdomain left bottom
+   USE dom_oce , ONLY :   njmpp      =>   njmpp      !: j index for mpp-subdomain left bottom
+   USE dom_oce , ONLY :   nproc      =>   nproc      !: number for local processor
+   USE dom_oce , ONLY :   narea      =>   narea      !: number for local area
+   USE dom_oce , ONLY :   mig        =>   mig        !: local  ==> global  domain i-indice
+   USE dom_oce , ONLY :   mjg        =>   mjg        !: local  ==> global  domain i-indice
+   USE dom_oce , ONLY :   mi0        =>   mi0        !: global ==> local domain i-indice 
+   USE dom_oce , ONLY :   mi1        =>   mi1        !: (mi0=1 and mi1=0 if the global indice is not in the local one)
+   USE dom_oce , ONLY :   mj0        =>   mj0        !: global ==> local domain j-indice 
+   USE dom_oce , ONLY :   mj1        =>   mj1        !: (mj0=1 and mj1=0 if the global indice is not in the local one)
+   USE dom_oce , ONLY :   nidom      =>   nidom
+   USE dom_oce , ONLY :   nimppt     => nimppt     !:i-indexes for each processor
+   USE dom_oce , ONLY :   njmppt     => njmppt       !:j-indexes for each processor
+   USE dom_oce , ONLY :   ibonit     => ibonit       !:i-processor neighbour existence
+   USE dom_oce , ONLY :   ibonjt     => ibonjt       !:j- processor neighbour existence 
+   USE dom_oce , ONLY :   nlci       => nlci         !:i- & j-dimensions of the local subdomain
+   USE dom_oce , ONLY :   nlcj       => nlcj         !:
+   USE dom_oce , ONLY :   nldi       => nldi         !:first and last indoor i- and j-indexes
+   USE dom_oce , ONLY :   nlei       => nlei         !:
+   USE dom_oce , ONLY :   nldj       => nldj         !:
+   USE dom_oce , ONLY :   nlej       => nlej         !:
+   USE dom_oce , ONLY :   nlcit      => nlcit        !:dimensions of every i-subdomain
+   USE dom_oce , ONLY :   nlcjt      => nlcjt        !:dimensions of every j-subdomain
+   USE dom_oce , ONLY :   nldit      => nldit        !:first indoor index for each i-domain 
+   USE dom_oce , ONLY :   nleit      => nleit        !:last indoor index for each i-domain 
+   USE dom_oce , ONLY :   nldjt      => nldjt        !:first indoor index for each j-domain 
+   USE dom_oce , ONLY :   nlejt      => nlejt        !:last indoor index for each j-domain 
+ 
+   !* horizontal mesh *
+   USE dom_oce , ONLY :   glamt      =>   glamt      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamu      =>   glamu      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamv      =>   glamv      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   glamf      =>   glamf      !: longitude of t-point (degre)  
+   USE dom_oce , ONLY :   gphit      =>   gphit      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphiu      =>   gphiu      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphiv      =>   gphiv      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   gphif      =>   gphif      !: latitude  of t-point (degre)   
+   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)  
+   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)   
+   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2)
+   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m)
+   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m)
+   USE dom_oce , ONLY :   e1v        =>   e1v        !: horizontal scale factors at v-point (m)
+   USE dom_oce , ONLY :   e2v        =>   e2v        !: horizontal scale factors at v-point (m)  
+
+   !* vertical mesh *
+   USE dom_oce , ONLY :   gdept_0    =>   gdept_0    !: reference depth of t-points (m)
+   USE dom_oce , ONLY :   e3t_0      =>   e3t_0      !: reference depth of t-points (m)  
+   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m)
+   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m)
+# if ! defined key_zco
+   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ???
+   USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m)
+   USE dom_oce , ONLY :   gdepw      =>  gdepw       !: depth of t-points (m)
+   USE dom_oce , ONLY :   e3t        =>  e3t         !: vertical scale factors at t-
+   USE dom_oce , ONLY :   e3u        =>  e3u         !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3v        =>  e3v         !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3w        =>  e3w         !: w-points (m)
+   USE dom_oce , ONLY :   e3f        =>  e3f         !: f-points (m)
+   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m)
+   USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m)
+# endif
+   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag
+   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag
+   USE dom_oce , ONLY :   ln_zco     =>  ln_zco      !: z-coordinate flag
+   USE dom_oce , ONLY :   hbatt      =>  hbatt       !: ocean depth at the vertical of  t-point (m)
+   USE dom_oce , ONLY :   hbatu      =>  hbatu       !: ocean depth at the vertical of  u-point (m)
+   USE dom_oce , ONLY :   hbatv      =>  hbatv       !: ocean depth at the vertical of w-point (m)
+   USE dom_oce , ONLY :   gsigt      =>  gsigt       !: model level depth coefficient at T-levels
+   USE dom_oce , ONLY :   gsigw      =>  gsigw       !: model level depth coefficient at W-levels
+   USE dom_oce , ONLY :   gsi3w      =>  gsi3w       !: model level depth coef at w-levels (defined as the sum of e3w)
+   USE dom_oce , ONLY :   esigt      =>  esigt       !: vertical scale factor coef. at t-levels
+   USE dom_oce , ONLY :   esigw      =>  esigw       !: vertical scale factor coef. at w-levels
+   USE dom_oce , ONLY :   lk_vvl     =>  lk_vvl      !: variable grid flag
+# if defined key_vvl
+   USE dom_oce , ONLY :   gdep3w_1   =>  gdep3w_1    !: ???
+   USE dom_oce , ONLY :   gdept_1    =>  gdept_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   gdepw_1    =>  gdepw_1     !: depth of t-points (m)
+   USE dom_oce , ONLY :   e3t_1      =>  e3t_1       !: vertical scale factors at t-
+   USE dom_oce , ONLY :   e3u_1      =>  e3u_1       !: vertical scale factors at u-
+   USE dom_oce , ONLY :   e3v_1      =>  e3v_1       !: vertical scale factors v-
+   USE dom_oce , ONLY :   e3w_1      =>  e3w_1       !: w-points (m)
+   USE dom_oce , ONLY :   e3f_1      =>  e3f_1       !: f-points (m)
+   USE dom_oce , ONLY :   e3uw_1     =>  e3uw_1      !: uw-points (m)
+   USE dom_oce , ONLY :   e3vw_1     =>  e3vw_1      !: vw-points (m)
+# endif
+   !* masks, bathymetry *
+   USE dom_oce , ONLY :   mbkt       =>   mbkt       !: vertical index of the bottom last T- ocean level
+   USE dom_oce , ONLY :   mbku       =>   mbku       !: vertical index of the bottom last U- ocean level
+   USE dom_oce , ONLY :   mbkv       =>   mbkv       !: vertical index of the bottom last V- ocean level
+   USE dom_oce , ONLY :   tmask_i    =>   tmask_i    !: Interior mask at t-points
+   USE dom_oce , ONLY :   tmask      =>   tmask      !: land/ocean mask at t-points
+   USE dom_oce , ONLY :   umask      =>   umask      !: land/ocean mask at u-points   
+   USE dom_oce , ONLY :   vmask      =>   vmask      !: land/ocean mask at v-points 
+   USE dom_oce , ONLY :   fmask      =>   fmask      !: land/ocean mask at f-points 
+
+   !* time domain *
+   USE dom_oce , ONLY :   neuler     =>   neuler     !: restart euler forward option (0=Euler)
+   USE dom_oce , ONLY :   rdt        =>   rdt        !: time step for the dynamics 
+   USE dom_oce , ONLY :   atfp       =>   atfp       !: asselin time filter parameter
+   USE dom_oce , ONLY :   atfp1      =>   atfp1      !: asselin time filter coeff. (atfp1= 1-2*atfp)
+   USE dom_oce , ONLY :   rdttra     =>   rdttra     !: vertical profile of tracer time step
+   !                                                 !: it is the accumulated duration of previous runs
+   !                                                 !: that may have been run with different time steps.
+   !* calendar variables *
+   USE dom_oce , ONLY :   nyear      =>   nyear      !: current year
+   USE dom_oce , ONLY :   nmonth     =>   nmonth     !: current month
+   USE dom_oce , ONLY :   nday       =>   nday       !: current day of the month
+   USE dom_oce , ONLY :   ndastp     =>   ndastp     !: time step date in yyyymmdd format
+   USE dom_oce , ONLY :   nday_year  =>   nday_year  !: current day counted from jan 1st of the current year
+   USE dom_oce , ONLY :   nsec_year  =>   nsec_year  !: current time step counted in second since 00h jan 1st of the current year
+   USE dom_oce , ONLY :   nsec_month =>   nsec_month !: current time step counted in second since 00h 1st day of the current month
+   USE dom_oce , ONLY :   nsec_day   =>   nsec_day   !: current time step counted in second since 00h of the current day
+   USE dom_oce , ONLY :   fjulday    =>   fjulday    !: julian day
+   USE dom_oce , ONLY :   adatrj     =>   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)
+   USE dom_oce , ONLY :   nyear_len  =>   nyear_len  !: length in days of the previous/current year
+   USE dom_oce , ONLY :   nmonth_len =>   nmonth_len !: length in days of the months of the current year
+
+
+   !* ocean fields: here now and after fields *
+   USE oce , ONLY :   ua      =>    ua      !: i-horizontal velocity (m s-1) 
+   USE oce , ONLY :   va      =>    va      !: j-horizontal velocity (m s-1)
+   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 :   rotn    =>    rotn    !: relative vorticity    [s-1]
+   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s)
+   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1]
+   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 :   sshu_n  =>    sshu_n  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshu_b  =>    sshu_b  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshu_a  =>    sshu_a  !: sea surface height at u-point [m]   
+   USE oce , ONLY :   sshv_n  =>    sshv_n  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshv_b  =>    sshv_b  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshv_a  =>    sshv_a  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   sshf_n  =>    sshf_n  !: sea surface height at v-point [m]   
+   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion
+#if defined key_offline
+   USE oce , ONLY :   gtsu    =>    gtsu    !: t-, s- and rd horizontal gradient at u- and
+   USE oce , ONLY :   gtsv    =>    gtsv    !:
+   USE oce , ONLY :   gru     =>    gru     !:
+   USE oce , ONLY :   grv     =>    grv     !: 
+#endif
+
+   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection 
+
+   !* 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 :   emps       =>    emps       !: freshwater budget: concentration/dillution   [Kg/m2/s]
+   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s]
+   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Daily mean to Diurnal Cycle short wave (qsr) 
+   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths
+   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1)
+   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface
+   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction
+   USE traqsr  , ONLY :   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 trc_oce
+
+   !* lateral diffusivity (tracers) *
+   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity
+   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s)
+   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s)
+   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s)
+   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points 
+   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points 
+   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points 
+   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points
+   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s) 
+   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)   
+   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s) 
+   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s) 
+   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag
+
+   !* 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)
+
+   !* direction of lateral diffusion *
+   USE ldfslp , ONLY :   lk_ldfslp  =>  lk_ldfslp     !: slopes flag
+# if   defined key_ldfslp
+   USE ldfslp , ONLY :   uslp       =>   uslp         !: i-direction slope at u-, w-points
+   USE ldfslp , ONLY :   vslp       =>   vslp         !: j-direction slope at v-, w-points
+   USE ldfslp , ONLY :   wslpi      =>   wslpi        !: i-direction slope at u-, w-points
+   USE ldfslp , ONLY :   wslpj      =>   wslpj        !: j-direction slope at v-, w-points
+# endif
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE oce_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/par_trc.F90	(revision 3437)
@@ -0,0 +1,45 @@
+MODULE par_trc
+   !!======================================================================
+   !!                        ***  par_trc  ***
+   !! TOP :   set the passive tracers parameters
+   !!======================================================================
+   !! History :    -   !  1996-01  (M. Levy)  original code
+   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!             1.0  !  2004-03  (C. Ethe) Free form and module
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+   !
+   USE par_lobster   ! LOBSTER model
+   USE par_pisces    ! PISCES  model
+   USE par_c14b      ! C14 bomb tracer
+   USE par_cfc       ! CFC 11 and 12 tracers
+   USE par_my_trc    ! user defined passive tracers
+
+   IMPLICIT NONE
+
+   ! Passive tracers : Total size
+   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays
+   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d
+   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d
+   !                     ! total number of sms diagnostic arrays
+   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd
+   
+   !  1D configuration ("key_c1d")
+   ! -----------------
+# if defined key_c1d
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .TRUE.   !: 1D pass. tracer configuration flag
+# else   
+   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag
+# endif
+
+   REAL(wp), PUBLIC  :: rtrn  = 1.e-15      !: truncation value     
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90	(revision 3437)
@@ -0,0 +1,462 @@
+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
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   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
+
+   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), DIMENSION(jptra) ::   cl
+      CHARACTER (len=10) ::   cl2
+      REAL(wp), POINTER, DIMENSION(:,:,:)  :: zmask, ztab3d 
+      !!----------------------------------------------------------------------
+
+      CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d )
+      !                                      ! 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 )
+      !
+   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(:) = nldit(:) 
+         nleitl(:) = nleit(:) 
+         nldjtl(:) = nldjt(:) 
+         nlejtl(:) = nlejt(:) 
+         !
+         nimpptl(:) = nimppt(:)
+         njmpptl(:) = njmppt(:)
+         !
+         nlcitl(:) = nlcit(:)
+         nlcjtl(:) = nlcjt(:)
+         !
+         ibonitl(:) = ibonit(:)
+         ibonjtl(:) = ibonjt(:)
+      ELSE
+         sind = 1
+         eind = ijsplt
+         clb_name = "('mono.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
+
+
+   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"
+      !!----------------------------------------------------------------------
+      INTEGER ::   ji, jj, js               ! dummy loop indices
+      INTEGER ::   ii, ij                   ! temporary integers
+      INTEGER ::   irestil, irestjl         !    "          "
+      INTEGER ::   ijpi  , ijpj, nlcil      ! temporary logical unit
+      INTEGER ::   nlcjl , nbondil, nbondjl
+      INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl
+      REAL(wp) ::   zidom, zjdom            ! temporary scalars
+      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace
+      !!----------------------------------------------------------------------
+      !
+      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+      ! 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
+      
+      zjdom = nrecjl
+      DO jj = 1, jsplt
+         zjdom = zjdom + ilcjtl(1,jj) - nrecjl
+      END DO
+
+      ! 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
+      
+      ! Subdomain description
+      ! ---------------------
+
+      DO js = 1, ijsplt
+         ii = 1 + MOD( js-1, isplt )
+         ij = 1 + (js-1) / isplt
+         nimpptl(js) = iimpptl(ii,ij)
+         njmpptl(js) = ijmpptl(ii,ij)
+         nlcitl (js) = ilcitl (ii,ij)     
+         nlcil       = nlcitl (js)     
+         nlcjtl (js) = ilcjtl (ii,ij)     
+         nlcjl       = nlcjtl (js)
+         nbondjl = -1                                    ! general case
+         IF( js   >  isplt          )   nbondjl = 0      ! first row of processor
+         IF( js   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor
+         IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction
+         ibonjtl(js) = nbondjl
+         
+         nbondil = 0                                     ! 
+         IF( MOD( js, isplt ) == 1 )   nbondil = -1      !
+         IF( MOD( js, isplt ) == 0 )   nbondil =  1      !
+         IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction
+         ibonitl(js) = 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(js) = nldil
+         nleitl(js) = nleil
+         nldjtl(js) = nldjl
+         nlejtl(js) = nlejl
+      END DO
+      !
+      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl )
+      !
+   END SUBROUTINE sub_dom
+ 
+#else
+   !!----------------------------------------------------------------------
+   !!   Dummy module :                                    NO passive tracer
+   !!----------------------------------------------------------------------
+#endif
+ 
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================   
+END MODULE prtctl_trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/top_substitute.h90	(revision 3437)
@@ -0,0 +1,17 @@
+   !!----------------------------------------------------------------------
+   !!                    ***  top_substitute.h90   ***
+   !!----------------------------------------------------------------------
+   !! ** purpose : Statement function file: to be include in all passive tracer modules
+   !!----------------------------------------------------------------------
+   !! History :   1.0  !  2004-03 (C. Ethe) Original code
+   !!             2.0  !  2007-12 (C. Ethe, G. Madec) new architecture
+   !!----------------------------------------------------------------------
+#  include "domzgr_substitute.h90"
+#  include "ldfeiv_substitute.h90"
+#  include "ldftra_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trc.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trc.F90	(revision 3437)
@@ -0,0 +1,242 @@
+MODULE trc
+   !!======================================================================
+   !!                      ***  MODULE  trc  ***
+   !! Passive tracers   :  module for tracers defined
+   !!======================================================================
+   !! History :   OPA  !  1996-01  (M. Levy)  Original code
+   !!              -   !  1999-07  (M. Levy)  for LOBSTER1 or NPZD model
+   !!              -   !  2000-04  (O. Aumont, M.A. Foujols)  HAMOCC3 and P3ZD
+   !!   NEMO      1.0  !  2004-03  (C. Ethe)  Free form and module
+   !!----------------------------------------------------------------------
+#if defined key_top
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   USE par_oce
+   USE par_trc
+   
+   IMPLICIT NONE
+   PUBLIC
+
+   PUBLIC   trc_alloc   ! called by nemogcm.F90
+
+   !! parameters for the control of passive tracers
+   !! --------------------------------------------------
+   INTEGER, PUBLIC                                                 ::   numnat        !: logicla unit for the passive tracer NAMELIST
+   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics
+
+   !! 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            !: traceur concentration for now time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step
+
+   !! 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
+   
+   !! 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_dttrc       !: frequency of step on passive tracers
+   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 = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output)
+   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step
+   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files
+   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag
+   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model
+
+   !! 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              :: llsave   !: save the tracer 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
+   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file
+   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not
+
+   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
+
+   !! additional 2D/3D outputs namelist
+   !! --------------------------------------------------
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array 
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array 
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit
+   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic
+   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs
+
+   !! Biological trends
+   !! -----------------
+   LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic
+   INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs
+   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name
+   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name
+   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit
+
+   !! 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_ldfslp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points
+#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(:,:)     ::  sshu_n_tm   !: average ssh for the now step [m]
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_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(:,:)     ::  sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m]  
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_b_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(:,:)     ::  emps_tm    !: freshwater budget:concentration/dilution [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]
+   !
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 3D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 2D coefficients ** at T-,U-,V-,W-points
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 1D coefficients ** at T-,U-,V-,W-points
+#else
+   REAL(wp), PUBLIC                                        ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 0D coefficients ** at T-,U-,V-,W-points
+#endif
+   !
+#if defined key_traldf_eiv
+#  if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 3D coefficients **
+#  elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 2D coefficients **
+#  elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_tm , aeiv_tm, aeiw_tm   !: ** 1D coefficients **
+#  else
+   REAL(wp), PUBLIC                                        ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 0D coefficients **
+#  endif
+#endif
+
+   ! 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(:,:,:)   ::  e3t_temp,e3u_temp,e3v_temp,e3w_temp     !: hold current values
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_temp, sshu_b_temp, sshu_a_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshf_n_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_temp, sshv_b_temp, sshv_a_temp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hu_temp, hv_temp, hur_temp, hvr_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, emps_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_ldfslp
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_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
+   !
+#if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp   
+#elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp  
+#elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 
+#else
+   REAL(wp), PUBLIC                                        ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp
+#endif
+   !
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 3D coefficients **
+# elif defined key_traldf_c2d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 2D coefficients **
+# elif defined key_traldf_c1d
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_temp , aeiv_temp, aeiw_temp   !: ** 1D coefficients **
+# else
+   REAL(wp), PUBLIC                                        ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 0D coefficients **
+# endif
+# endif
+
+   !!----------------------------------------------------------------------
+   !! 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
+      !!-------------------------------------------------------------------
+      !
+      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &  
+         &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       &
+         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       &
+         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
+         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )  
+
+      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays')
+      !
+   END FUNCTION trc_alloc
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Empty module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+#endif
+
+   !!======================================================================
+END MODULE trc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdia.F90	(revision 3437)
@@ -0,0 +1,493 @@
+MODULE trcdia
+   !!======================================================================
+   !!                       *** MODULE trcdia ***
+   !! TOP :   Output of passive tracers
+   !!======================================================================
+   !! History :   OPA  !  1995-01 (M. Levy)  Original code
+   !!              -   !  1998-01 (C. Levy) NETCDF format using ioipsl interface
+   !!              -   !  1999-01 (M.A. Foujols) adapted for passive tracer
+   !!              -   !  1999-09 (M.A. Foujols) split into three parts
+   !!   NEMO      1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90
+   !!                  !  2008-05 (C. Ethe re-organization)
+   !!----------------------------------------------------------------------
+#if defined key_top 
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !! trc_dia     : main routine of output passive tracer
+   !! trcdit_wr   : outputs of concentration fields
+   !! trcdii_wr   : outputs of additional 2D/3D diagnostics
+   !! trcdib_wr   : outputs of biological fields
+   !!----------------------------------------------------------------------
+   USE dom_oce         ! ocean space and time domain variables 
+   USE oce_trc
+   USE trc
+   USE par_trc
+   USE dianam    ! build name of file (routine)
+   USE ioipsl    ! I/O manager
+   USE iom       ! I/O manager
+   USE lib_mpp   ! MPP library
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_dia        ! called by XXX module 
+
+   INTEGER  ::   nit5      !: id for tracer output file
+   INTEGER  ::   ndepit5   !: id for depth mesh
+   INTEGER  ::   nhorit5   !: id for horizontal mesh
+   INTEGER  ::   ndimt50   !: number of ocean points in index array
+   INTEGER  ::   ndimt51   !: number of ocean points in index array
+   REAL(wp) ::   zjulian   !: ????   not DOCTOR !
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index
+   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index
+
+   INTEGER  ::   nitd      !: id for additional array output file
+   INTEGER  ::   ndepitd   !: id for depth mesh
+   INTEGER  ::   nhoritd   !: id for horizontal mesh
+
+   INTEGER  ::   nitb        !:         id.         for additional array output file
+   INTEGER  ::   ndepitb   !:  id for depth mesh
+   INTEGER  ::   nhoritb   !:  id for horizontal mesh
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_dia( kt )  
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_dia  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt    ! ocean time-step
+      !
+      INTEGER             ::  ierr   ! local integer
+      !!---------------------------------------------------------------------
+      !
+      IF( kt == nittrc000 )  THEN
+         ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=ierr )
+         IF( ierr > 0 ) THEN
+            CALL ctl_stop( 'STOP', 'trc_diat: unable to allocate arrays' )  ;   RETURN
+         ENDIF
+      ENDIF
+      !
+      IF( .NOT.lk_iomput ) THEN
+                          CALL trcdit_wr( kt )      ! outputs for tracer concentration
+         IF( ln_diatrc )  CALL trcdii_wr( kt )      ! outputs for additional arrays
+         IF( ln_diabio )  CALL trcdib_wr( kt )      ! outputs for biological trends
+      ENDIF
+      !
+   END SUBROUTINE trc_dia
+
+
+   SUBROUTINE trcdit_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdit_wr  ***
+      !!
+      !! ** Purpose :   Standard output of passive tracer : concentration fields
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nwritetrc time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      !
+      INTEGER ::   jn
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) :: clhstnam, clop
+      INTEGER ::   inum = 11             ! temporary logical unit
+      CHARACTER (len=20) :: cltra, cltrau
+      CHARACTER (len=80) :: cltral
+      REAL(wp) :: zsto, zout, zdt
+      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+
+      ! local variable for debugging
+      ll_print = .FALSE.                  ! change it to true for more control print
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+# if defined key_diainstant
+      zsto = nn_writetrc * rdt
+      clop = "inst("//TRIM(clop)//")"
+# else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+# endif
+      zout = nn_writetrc * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! Define NETCDF files and fields at beginning of first time step
+      ! --------------------------------------------------------------
+
+      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt
+      
+      IF( kt == nittrc000 ) THEN
+
+         IF(lwp) THEN                   ! control print
+            WRITE(numout,*)
+            WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc
+            DO jn = 1, jptra
+               IF( ln_trc_wri(jn) )  WRITE(numout,*) ' ouput tracer nb : ', jn, '    short name : ', ctrcnm(jn) 
+            END DO
+            WRITE(numout,*) ' '
+         ENDIF
+
+         ! 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  
+  
+         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  &
+            &                    ' limit storage in depth = ', ipk
+
+         IF( lk_offline .AND. lwp ) THEN
+            CALL dia_nam( clhstnam, nn_writetrc,' ' )
+            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea )
+            WRITE(inum,*) clhstnam
+            CLOSE(inum)
+         ENDIF
+
+         ! Define the NETCDF files for passive tracer concentration
+         CALL dia_nam( clhstnam, nn_writetrc, 'ptrc_T' )
+         IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam
+
+         ! Horizontal grid : glamt and gphit
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     &
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
+            &          iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom, snc4chunks=snc4set)
+
+         ! Vertical grid for tracer : gdept
+         CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5)
+
+         ! Index of ocean points in 3D and 2D (surface)
+         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndext50, ndimt50 )
+         CALL wheneq( jpi*jpj    , tmask, 1, 1., ndext51, ndimt51 )
+
+         ! Declare all the output fields as NETCDF variables
+         DO jn = 1, jptra
+            IF( ln_trc_wri(jn) ) THEN
+               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
+               cltral = TRIM( ctrcln(jn) )   ! long title for tracer
+               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer
+               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  &
+                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout ) 
+            ENDIF
+         END DO
+
+         ! end netcdf files header
+         CALL histend( nit5, snc4set )
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr'
+         IF( ll_print )   CALL FLUSH(numout )
+
+      ENDIF
+
+      ! Start writing the tracer concentrations
+      ! ---------------------------------------
+
+      IF( lwp .AND. MOD( itmod, nn_writetrc ) == 0 ) THEN
+         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~~~~ '
+      ENDIF
+
+      DO jn = 1, jptra
+         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer
+         IF( ln_trc_wri(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 )
+      END DO
+
+      ! close the file 
+      ! --------------
+      IF( kt == nitend )   CALL histclo( nit5 )
+      !
+   END SUBROUTINE trcdit_wr
+
+   SUBROUTINE trcdii_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdii_wr  ***
+      !!
+      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nn_writedia time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT(in) ::   kt       ! ocean time-step
+      !!
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) ::   clhstnam, clop
+      CHARACTER (len=20) ::   cltra, cltrau
+      CHARACTER (len=80) ::   cltral
+      INTEGER  ::   jl
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      REAL(wp) ::   zsto, zout, zdt
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+      
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+      !
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#  if defined key_diainstant
+      zsto = nn_writedia * zdt
+      clop = "inst("//TRIM(clop)//")"
+#  else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+#  endif
+      zout = nn_writedia * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! 1. Define NETCDF files and fields at beginning of first time step
+      ! -----------------------------------------------------------------
+
+      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt
+
+      IF( kt == nittrc000 ) THEN
+
+         ! Define the NETCDF files for additional arrays : 2D or 3D
+
+         ! Define the T grid file for tracer auxiliary files
+
+         CALL dia_nam( clhstnam, nn_writedia, 'diad_T' )
+         IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam
+
+         ! Define a netcdf FILE for 2d and 3d arrays
+
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             &
+            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &
+            &          iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom, snc4chunks=snc4set )
+
+         ! Vertical grid for 2d and 3d arrays
+
+         CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd)
+
+         ! Declare all the output fields as NETCDF variables
+
+         ! more 3D horizontal arrays
+         DO jl = 1, jpdia3d
+            cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
+            cltral = TRIM( ctrc3l(jl) )  ! long title for 3D diagnostic
+            cltrau = TRIM( ctrc3u(jl) )  ! UNIT for 3D diagnostic
+            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   &
+               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout )
+         END DO
+
+         ! more 2D horizontal arrays
+         DO jl = 1, jpdia2d
+            cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
+            cltral = TRIM( ctrc2l(jl) )  ! long title for 2D diagnostic
+            cltrau = TRIM( ctrc2u(jl) )  ! UNIT for 2D diagnostic
+            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  &
+               &          1, 1, 1,  -99, 32, clop, zsto, zout )
+         END DO
+
+         ! TODO: more 2D vertical sections arrays : I or J indice fixed
+
+         ! CLOSE netcdf Files
+         CALL histend( nitd, snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr'
+         IF( ll_print )   CALL FLUSH(numout )
+         !
+      ENDIF
+
+      ! 2. Start writing data
+      ! ---------------------
+
+      IF( lwp .AND. MOD( itmod, nn_writedia ) == 0 ) THEN
+         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      ! more 3D horizontal arrays
+      DO jl = 1, jpdia3d
+         cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic
+         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50)
+      END DO
+
+      ! more 2D horizontal arrays
+      DO jl = 1, jpdia2d
+         cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic
+         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51)
+      END DO
+
+      ! Closing all files
+      ! -----------------
+      IF( kt == nitend )   CALL histclo(nitd)
+      !
+
+   END SUBROUTINE trcdii_wr
+
+   SUBROUTINE trcdib_wr( kt )
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE trcdib_wr  ***
+      !!
+      !! ** Purpose :   output of passive tracer : biological fields
+      !!
+      !! ** Method  :   At the beginning of the first time step (nittrc000), define all
+      !!             the NETCDF files and fields for concentration of passive tracer
+      !!
+      !!        At each time step call histdef to compute the mean if necessary
+      !!        Each nn_writebio time step, output the instantaneous or mean fields
+      !!
+      !!----------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt          ! ocean time-step
+      !!
+      LOGICAL ::   ll_print = .FALSE.
+      CHARACTER (len=40) ::   clhstnam, clop
+      CHARACTER (len=20) ::   cltra, cltrau
+      CHARACTER (len=80) ::   cltral
+      INTEGER  ::   ji, jj, jk, jl
+      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod, iiter
+      REAL(wp) ::   zsto, zout, zdt
+      !!----------------------------------------------------------------------
+
+      ! Initialisation
+      ! --------------
+      
+      ! local variable for debugging
+      ll_print = .FALSE.
+      ll_print = ll_print .AND. lwp
+
+      ! Define frequency of output and means
+      zdt = rdt
+      IF( ln_mskland )   THEN   ;   clop = "only(x)"   ! put 1.e+20 on land (very expensive!!)
+      ELSE                      ;   clop = "x"         ! no use of the mask value (require less cpu time)
+      ENDIF
+#        if defined key_diainstant
+      zsto = nn_writebio * zdt
+      clop = "inst("//TRIM(clop)//")"
+#        else
+      zsto = zdt
+      clop = "ave("//TRIM(clop)//")"
+#        endif
+      zout = nn_writebio * zdt
+
+      ! Define indices of the horizontal output zoom and vertical limit storage
+      iimi = 1      ;      iima = jpi
+      ijmi = 1      ;      ijma = jpj
+      ipk = jpk
+
+      ! define time axis
+      itmod = kt - nittrc000 + 1
+      it    = kt
+      iiter = ( nittrc000 - 1 ) / nn_dttrc
+
+      ! Define NETCDF files and fields at beginning of first time step
+      ! --------------------------------------------------------------
+
+      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt
+
+      IF( kt == nittrc000 ) THEN
+
+         ! Define the NETCDF files for biological trends
+
+         CALL dia_nam(clhstnam,nn_writebio,'biolog')
+         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam
+         ! Horizontal grid : glamt and gphit
+         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      &
+            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          &
+            &    iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom, snc4chunks=snc4set )
+         ! Vertical grid for biological trends
+         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
+
+         ! Declare all the output fields as NETCDF variables
+         ! biological trends
+         DO jl = 1, jpdiabio
+            cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
+            cltral = TRIM( ctrbil(jl) )  ! long title for biological diagnostic
+            cltrau = TRIM( ctrbiu(jl) )  ! UNIT for biological diagnostic
+            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  &
+               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout)
+         END DO
+
+         ! CLOSE netcdf Files
+          CALL histend( nitb, snc4set )
+
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr'
+         IF(ll_print) CALL FLUSH(numout )
+         !
+      ENDIF
+
+      ! Start writing data
+      ! ------------------
+
+      ! biological trends
+      IF( lwp .AND. MOD( itmod, nn_writebio ) == 0 ) THEN
+         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step'
+         WRITE(numout,*) '~~~~~~ '
+      ENDIF
+
+      DO jl = 1, jpdiabio
+         cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic
+         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50)
+      END DO
+
+      ! Closing all files
+      ! -----------------
+      IF( kt == nitend )   CALL histclo( nitb )
+      !
+   END SUBROUTINE trcdib_wr
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_dia( kt )                      ! Empty routine   
+      INTEGER, INTENT(in) :: kt
+   END SUBROUTINE trc_dia   
+#endif
+
+   !!======================================================================
+END MODULE trcdia
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcdta.F90	(revision 3437)
@@ -0,0 +1,281 @@
+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 
+   !!----------------------------------------------------------------------
+#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_init    ! 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                                     :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
+   REAL(wp) , SAVE,         ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values
+   TYPE(FLD), SAVE,         ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read)
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+CONTAINS
+
+   SUBROUTINE trc_dta_init
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE trc_dta_init  ***
+      !!                    
+      !! ** Purpose :   initialisation of passive tracer input data 
+      !! 
+      !! ** Method  : - Read namtsd namelist
+      !!              - allocates passive tracer data structure 
+      !!----------------------------------------------------------------------
+      !
+      INTEGER            :: jl, jn                   ! dummy loop indicies
+      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers
+      CHARACTER(len=100) :: clndta, clntrc
+      REAL(wp)           :: zfact
+      !
+      CHARACTER(len=100) :: cn_dir
+      TYPE(FLD_N), DIMENSION(jptra) :: slf_i     ! array of namelist informations on the fields to read
+      TYPE(FLD_N), DIMENSION(jptra) :: sn_trcdta
+      REAL(wp)   , DIMENSION(jptra) :: 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_init')
+      !
+      !  Initialisation
+      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  
+      ! Compute the number of tracers to be initialised with data
+      ALLOCATE( n_trc_index(jptra), STAT=ierr0 )
+      IF( ierr0 > 0 ) THEN
+         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN
+      ENDIF
+      nb_trcdta      = 0
+      n_trc_index(:) = 0
+      DO jn = 1, jptra
+         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
+      WRITE(numout,*) ' '
+      WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
+      WRITE(numout,*) ' '
+      !                         ! allocate the arrays (if necessary)
+      !
+      cn_dir  = './'            ! directory in which the model is executed
+      DO jn = 1, jptra
+         WRITE( clndta,'("TR_",I1)' ) jn
+         clndta = TRIM( clndta )
+         !                 !  file      ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation !
+         !                 !  name      !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    !
+         sn_trcdta(jn)  = FLD_N( clndta ,   -1      , clndta    ,  .false.   , .true.  ,  'monthly'  , ''       , ''       )
+         !
+         rn_trfac(jn) = 1._wp
+      END DO
+      !
+      REWIND( numnat )               ! read nattrc
+      READ  ( numnat, namtrc_dta )
+
+      IF( lwp ) THEN
+         DO jn = 1, jptra
+            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)       ) 
+               zfact  = rn_trfac(jn)
+               IF( clndta /=  clntrc ) THEN 
+                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   &
+                  &              'the variable name in the data file : '//clndta//   & 
+                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ')
+               ENDIF
+               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 
+               &               ' multiplicative 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, jptra
+            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 : 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', 'Passive tracer data', 'namtrc' )
+         !
+      ENDIF
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init')
+      !
+   END SUBROUTINE trc_dta_init
+
+
+   SUBROUTINE trc_dta( kt, ptrc )
+      !!----------------------------------------------------------------------
+      !!                   ***  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  :   ptrc   passive tracer data on medl mesh and interpolated at time-step kt
+      !!----------------------------------------------------------------------
+      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step
+      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   ptrc   ! passive tracer data
+      !
+      INTEGER ::   ji, jj, jk, jl, jn, jkk, ik    ! dummy loop indicies
+      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
+         !
+         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==!
+         !
+         DO jn = 1, ntra
+            ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:)    ! NO mask
+         ENDDO
+         !
+         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 jn = 1, ntra
+               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 = fsdept_0(ji,jj,jk)
+                        IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data
+                           ztp(jk) =  ptrc(ji,jj,1    ,jn)
+                        ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data
+                           ztp(jk) =  ptrc(ji,jj,jpkm1,jn)
+                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1
+                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1)
+                              IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN
+                                 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk))
+                                 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 
+                              ENDIF
+                           END DO
+                        ENDIF
+                     END DO
+                     DO jk = 1, jpkm1
+                        ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord
+                     END DO
+                     ptrc(ji,jj,jpk,jn) = 0._wp
+                  END DO
+               END DO
+            ENDDO 
+            ! 
+         ELSE                                !==   z- or zps- coordinate   ==!
+            !                             
+            DO jn = 1, ntra
+               ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:)    ! Mask
+               !
+               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_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) )
+                           ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn)
+                        ENDIF
+                     END DO
+                  END DO
+               ENDIF
+            ENDDO 
+            !
+         ENDIF
+         !
+         DO jn = 1, ntra
+            ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn)   !  multiplicative factor
+         ENDDO 
+         !
+         IF( lwp .AND. kt == nit000 ) THEN
+            DO jn = 1, ntra
+               clndta = TRIM( sf_trcdta(jn)%clvar ) 
+               WRITE(numout,*) ''//clndta//' data '
+               WRITE(numout,*)
+               WRITE(numout,*)'  level = 1'
+               CALL prihre( ptrc(:,:,1    ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+               WRITE(numout,*)'  level = ', jpk/2
+               CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+               WRITE(numout,*)'  level = ', jpkm1
+               CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
+               WRITE(numout,*)
+            ENDDO
+         ENDIF
+         !
+         IF( .NOT.ln_trcdmp ) THEN                   !==   deallocate data structure   ==! 
+            !                                              (data used only for initialisation)
+            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run'
+            DO jn = 1, ntra
+                                             DEALLOCATE( sf_trcdta(jn)%fnow )     !  arrays in the structure
+               IF( sf_trcdta(jn)%ln_tint )   DEALLOCATE( sf_trcdta(jn)%fdta )
+            ENDDO
+                                             DEALLOCATE( sf_trcdta          )     ! the structure itself
+            !
+         ENDIF
+         !
+      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 )        ! Empty routine
+      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt
+   END SUBROUTINE trc_dta
+#endif
+   !!======================================================================
+END MODULE trcdta
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcini.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcini.F90	(revision 3437)
@@ -0,0 +1,225 @@
+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 trcrst          ! passive tracers restart
+   USE trcnam          ! Namelist read
+   USE trcini_cfc      ! CFC      initialisation
+   USE trcini_lobster  ! LOBSTER  initialisation
+   USE trcini_pisces   ! PISCES   initialisation
+   USE trcini_c14b     ! C14 bomb initialisation
+   USE trcini_my_trc   ! MY_TRC   initialisation
+   USE trcdta          ! initialisation form files
+   USE daymod          ! calendar manager
+   USE zpshde          ! partial step: hor. derivative   (zps_hde routine)
+   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine)
+   USE trcsub       ! variables to substep passive tracers
+   
+   IMPLICIT NONE
+   PRIVATE
+   
+   PUBLIC   trc_init   ! called by opa
+
+    !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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
+      !!---------------------------------------------------------------------
+      INTEGER ::   jk, jn, jl    ! dummy loop indices
+      CHARACTER (len=25) :: charout
+      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace
+      !!---------------------------------------------------------------------
+      !
+      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 top_alloc()              ! allocate TOP arrays
+
+      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    &
+         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' )
+
+      IF( nn_cla == 1 )   &
+         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
+
+      CALL trc_nam                  ! read passive tracers namelists
+      !
+      IF(lwp) WRITE(numout,*)
+      IF( ln_rsttr ) THEN
+        !
+        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog)
+        CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar
+        !
+      ELSE
+        IF( lk_offline )  THEN
+           neuler = 0                  ! Set time-step indicator at nit000 (euler)
+           CALL day_init               ! set calendar
+        ENDIF
+        !
+      ENDIF
+      IF(lwp) WRITE(numout,*)
+                                                              ! masked grid volume
+      !                                                              ! masked grid volume
+      DO jk = 1, jpk
+         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
+      END DO
+      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol
+      !                                                              ! total volume of the ocean 
+      areatot = glob_sum( cvol(:,:,:) )
+
+      IF( lk_lobster )       CALL trc_ini_lobster      ! LOBSTER bio-model
+      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model
+      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers
+      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer
+      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers
+
+      IF( lwp ) THEN
+         !
+         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
+         !
+      ENDIF
+
+      IF( ln_trcdta )      CALL trc_dta_init
+
+
+      IF( ln_rsttr ) THEN
+        !
+        CALL trc_rst_read              ! restart from a file
+        !
+      ELSE
+        !
+        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping
+            !
+            CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation
+            !
+            CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000
+            !
+            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) 
+                  trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)  
+               ENDIF
+            ENDDO
+            CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )
+        ENDIF
+        !
+        trb(:,:,:,:) = trn(:,:,:,:)
+        ! 
+      ENDIF
+ 
+      tra(:,:,:,:) = 0._wp
+      
+      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive
+        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level
+
+      !
+      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers
+      !
+
+      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,*)
+         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)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_init')
+      !
+   END SUBROUTINE trc_init
+
+
+   SUBROUTINE top_alloc
+      !!----------------------------------------------------------------------
+      !!                     ***  ROUTINE top_alloc  ***
+      !!
+      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
+      !!----------------------------------------------------------------------
+      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines...
+      USE trc           , ONLY:   trc_alloc
+      USE trcnxt        , ONLY:   trc_nxt_alloc
+      USE trczdf        , ONLY:   trc_zdf_alloc
+      USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc
+#if defined key_trdmld_trc 
+      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc
+#endif
+      !
+      INTEGER :: ierr
+      !!----------------------------------------------------------------------
+      !
+      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines...
+      ierr = ierr + trc_alloc    ()
+      ierr = ierr + trc_nxt_alloc()
+      ierr = ierr + trc_zdf_alloc()
+      ierr = ierr + trd_mod_trc_oce_alloc()
+#if defined key_trdmld_trc 
+      ierr = ierr + trd_mld_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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcnam.F90	(revision 3437)
@@ -0,0 +1,272 @@
+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 trcnam_trp        ! Transport namelist
+   USE trcnam_lobster    ! LOBSTER namelist
+   USE trcnam_pisces     ! PISCES namelist
+   USE trcnam_cfc        ! CFC SMS namelist
+   USE trcnam_c14b       ! C14 SMS namelist
+   USE trcnam_my_trc     ! MY_TRC SMS namelist
+   USE trdmod_oce       
+   USE trdmod_trc_oce
+   USE iom               ! I/O manager
+
+   IMPLICIT NONE
+   PRIVATE 
+
+   PUBLIC trc_nam      ! called in trcini
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE trc_nam
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_nam  ***
+      !!
+      !! ** Purpose :   READ and PRINT options for the passive tracer run (namelist) 
+      !!
+      !! ** Method  : - read passive tracer namelist 
+      !!              - read namelist of each defined SMS model
+      !!                ( (LOBSTER, PISCES, CFC, MY_TRC )
+      !!---------------------------------------------------------------------
+      INTEGER ::  jn, ierr
+      ! Definition of a tracer as a structure
+      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput
+      !!
+      NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, &
+         &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta, ln_trcdmp
+#if defined key_trdmld_trc  || defined key_trdtrc
+      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, &
+         &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, &
+         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc
+#endif
+      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio
+
+      !!---------------------------------------------------------------------
+
+      IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~'
+
+      CALL ctl_opn( numnat, 'namelist_top', 'OLD', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. )
+
+      ! Namelist nattrc (files)
+      ! ----------------------------------------------
+      nn_dttrc      = 1                 ! default values
+      nn_writetrc   = 10 
+      ln_rsttr      = .FALSE.
+      nn_rsttr      =  0
+      cn_trcrst_in  = 'restart_trc'
+      cn_trcrst_out = 'restart_trc'
+      !
+      DO jn = 1, jptra
+         WRITE( sn_tracer(jn)%clsname,'("TR_",I1)'           ) jn
+         WRITE( sn_tracer(jn)%cllname,'("TRACER NUMBER ",I1)') jn
+         sn_tracer(jn)%clunit  = 'mmole/m3'
+         sn_tracer(jn)%llinit  = .FALSE.
+         sn_tracer(jn)%llsave  = .TRUE.
+      END DO
+      ln_trcdta = .FALSE.
+      ln_trcdmp = .FALSE.
+
+
+      REWIND( numnat )               ! read nattrc
+      READ  ( numnat, namtrc )
+
+      DO jn = 1, jptra
+         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_wri(jn) =       sn_tracer(jn)%llsave
+      END DO
+
+      !!KPE  computes the first time step of tracer model
+      nittrc000 = nit000 + nn_dttrc - 1
+ 
+
+      IF(lwp) THEN                   ! control print
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc'
+         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,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc  
+         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,*) ' '
+         DO jn = 1, jptra
+            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn)
+         END DO
+         WRITE(numout,*) ' '
+      ENDIF
+
+      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step
+  
+      IF(lwp) THEN                   ! control print
+        WRITE(numout,*) 
+        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1)
+        WRITE(numout,*) 
+      ENDIF
+
+      ln_diatrc = .FALSE.
+      ln_diabio = .FALSE.
+      nn_writedia = 10
+      nn_writebio = 10
+
+      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
+      READ  ( numnat, namtrc_dia )
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*)
+         WRITE(numout,*) ' Namelist : namtrc_dia'
+         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc
+         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio
+         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia
+         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio
+         WRITE(numout,*) ' '
+      ENDIF
+
+      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 
+         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  &
+           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  & 
+           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr ) 
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' )
+      ENDIF
+
+      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN
+         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , &
+           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr ) 
+         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' )
+      ENDIF
+
+      ! namelist of transport
+      ! ---------------------
+      CALL trc_nam_trp
+
+
+      IF( ln_trcdmp .AND. .NOT.ln_trcdta ) THEN
+         CALL ctl_warn( 'trc_nam: passive tracer damping requires data from files we set ln_trcdta to TRUE' )
+         ln_trcdta = .TRUE.
+      ENDIF
+      !
+      IF( ln_rsttr .AND. .NOT.ln_trcdmp .AND. ln_trcdta ) THEN
+          CALL ctl_warn( 'trc_nam: passive tracer restart and  data intialisation, ',   &
+             &           'we keep the restart values and set ln_trcdta to FALSE' )
+         ln_trcdta = .FALSE.
+      ENDIF
+      !
+      IF( .NOT.ln_trcdta ) THEN
+         ln_trc_ini(:) = .FALSE.
+      ENDIF
+
+      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,*)
+         ELSE
+            IF( .NOT.ln_trcdta ) THEN
+                WRITE(numout,*)
+                WRITE(numout,*) '  All the passive tracers are initialised with constant values '
+                WRITE(numout,*)
+            ENDIF
+         ENDIF
+      ENDIF
+
+
+#if defined key_trdmld_trc || defined key_trdtrc
+         nn_trd_trc  = 20
+         nn_ctls_trc =  9
+         rn_ucf_trc   =  1.
+         ln_trdmld_trc_instant = .TRUE.
+         ln_trdmld_trc_restart =.FALSE.
+         cn_trdrst_trc_in  = "restart_mld_trc"
+         cn_trdrst_trc_out = "restart_mld_trc"
+         ln_trdtrc(:) = .FALSE.
+
+         REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic
+         READ  ( numnat, namtrc_trd )
+
+         IF(lwp) THEN
+            WRITE(numout,*)
+            WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    '
+            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               '
+            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc
+            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc
+            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart
+            WRITE(numout,*) '   * flag to diagnose trends of                                 '
+            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant
+            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc
+            DO jn = 1, jptra
+               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn
+            END DO
+         ENDIF
+#endif
+
+
+      ! namelist of SMS
+      ! ---------------      
+      IF( lk_lobster ) THEN   ;   CALL trc_nam_lobster      ! LOBSTER bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used'
+      ENDIF
+
+      IF( lk_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used'
+      ENDIF
+
+      IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used'
+      ENDIF
+
+      IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used'
+      ENDIF
+
+      IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers
+      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used'
+      ENDIF
+      !
+   END SUBROUTINE trc_nam
+
+#else
+   !!----------------------------------------------------------------------
+   !!  Dummy module :                                     No passive tracer
+   !!----------------------------------------------------------------------
+CONTAINS
+   SUBROUTINE trc_nam                      ! Empty routine   
+   END SUBROUTINE trc_nam
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id$ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE  trcnam
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcrst.F90	(revision 3437)
@@ -0,0 +1,332 @@
+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
+   !!----------------------------------------------------------------------
+   !!----------------------------------------------------------------------
+   !!   'key_top'                                                TOP models
+   !!----------------------------------------------------------------------
+   !!   trc_rst_opn    : open  restart file
+   !!   trc_rst_read   : read  restart file
+   !!   trc_rst_wri    : write restart file
+   !!----------------------------------------------------------------------
+   USE oce_trc
+   USE trc
+   USE trcnam_trp
+   USE iom
+   USE trcrst_cfc      ! CFC      
+   USE trcrst_lobster  ! LOBSTER  restart
+   USE trcrst_pisces   ! PISCES   restart
+   USE trcrst_c14b     ! C14 bomb restart
+   USE trcrst_my_trc   ! MY_TRC   restart
+   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
+
+   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write)
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+   
+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
+      !!----------------------------------------------------------------------
+      !
+      IF( lk_offline ) THEN
+         IF( kt == nittrc000 ) THEN
+            lrst_trc = .FALSE.
+            nitrst = nitend
+         ENDIF
+
+         IF( 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)
+         IF(lwp) WRITE(numout,*) '             open trc restart.output NetCDF file: '//clname
+         CALL iom_open( 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
+
+      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model
+      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model
+      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers
+      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer
+      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers
+
+      CALL iom_close( numrtr )
+      !
+   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 trc_rst_cal( kt, 'WRITE' )   ! calendar
+      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface 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( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model
+      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model
+      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers
+      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer
+      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers
+
+      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_trdmld_trc
+          lrst_trc = .FALSE.
+#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 ( jprstlib == jprstdimg ) THEN
+           ! eventually read netcdf file (monobloc)  for restarting on different number of processors
+           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
+           INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok )
+           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF
+         ENDIF
+
+         CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )
+
+         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run
+         IF(lwp) THEN
+            WRITE(numout,*) ' *** Info read in restart : '
+            WRITE(numout,*) '   previous time-step                               : ', NINT( zkt )
+            WRITE(numout,*) ' *** restart option'
+            SELECT CASE ( nn_rsttr )
+            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000'
+            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)'
+            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart'
+            END SELECT
+            WRITE(numout,*)
+         ENDIF
+         ! Control of date 
+         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  &
+            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 &
+            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' )
+         IF( lk_offline ) THEN      ! set the date in offline mode
+            ! Check dynamics and tracer time-step consistency and force Euler restart if changed
+            IF( iom_varid( numrtr, 'rdttrc1', ldstop = .FALSE. ) > 0 )   THEN
+               CALL iom_get( numrtr, 'rdttrc1', zrdttrc1 )
+               IF( zrdttrc1 /= rdttrc(1) )   neuler = 0
+            ENDIF
+            !                          ! define ndastp and adatrj
+            IF ( nn_rsttr == 2 ) THEN
+               CALL iom_get( numrtr, 'ndastp', zndastp ) 
+               ndastp = NINT( zndastp )
+               CALL iom_get( numrtr, 'adatrj', adatrj  )
+            ELSE
+               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam
+               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday
+               ! note this is wrong if time step has changed during run
+            ENDIF
+            !
+            IF(lwp) THEN
+              WRITE(numout,*) ' *** Info used values : '
+              WRITE(numout,*) '   date ndastp                                      : ', ndastp
+              WRITE(numout,*) '   number of elapsed days since the begining of run : ', adatrj
+              WRITE(numout,*)
+            ENDIF
+            !
+            CALL day_init          ! compute calendar
+            !
+         ENDIF
+         !
+      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
+      !!----------------------------------------------------------------------
+
+      IF( lwp ) THEN
+         WRITE(numout,*) 
+         WRITE(numout,*) '           ----TRACER STAT----             '
+         WRITE(numout,*) 
+      ENDIF
+      !
+      DO jn = 1, jptra
+         ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
+         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
+      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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsms.F90	(revision 3437)
@@ -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_lobster     ! LOBSTER bio-model
+   USE trcsms_pisces      ! PISCES biogeo-model
+   USE trcsms_cfc         ! CFC 11 & 12
+   USE trcsms_c14b        ! C14b tracer 
+   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( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER
+      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES 
+      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC
+      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14
+      IF( lk_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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcstp.F90	(revision 3437)
@@ -0,0 +1,114 @@
+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 trc
+   USE trctrp           ! passive tracers transport
+   USE trcsms           ! passive tracers sources and sinks
+   USE prtctl_trc       ! Print control for debbuging
+   USE trcdia
+   USE trcwri
+   USE trcrst
+   USE trdmod_trc_oce
+   USE trdmld_trc
+   USE iom
+   USE in_out_manager
+   USE trcsub
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   trc_stp    ! called by step
+
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! 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( kt == nittrc000 .AND. lk_trdmld_trc )  CALL trd_mld_trc_init    ! trends: Mixed-layer
+      !
+      IF( lk_vvl ) THEN                                                   ! update ocean volume due to ssh temporal evolution
+         DO jk = 1, jpk
+            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
+         END DO
+         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol
+         areatot         = glob_sum( cvol(:,:,:) )
+      ENDIF
+      !    
+     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( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager
+         ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager
+         ENDIF
+                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources
+                                   CALL trc_trp      ( kt )       ! transport of passive tracers
+         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file
+         IF( lk_trdmld_trc  )      CALL trd_mld_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,e18.10)
+      !
+      IF( nn_timing == 1 )   CALL timing_stop('trc_stp')
+      !
+   END SUBROUTINE trc_stp
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcsub.F90	(revision 3437)
@@ -0,0 +1,1136 @@
+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
+#if defined key_zdftke
+   USE zdftke          ! twice TKE (en)
+#endif
+#if defined key_zdfgls
+   USE zdfgls, ONLY: en
+#endif
+   USE trabbl
+   USE zdf_oce
+   USE domvvl
+   USE divcur          ! hor. divergence and curl      (div & cur routines)
+   USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff 
+   USE sbc_oce         ! surface boundary condition: ocean
+   USE bdy_oce
+#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
+
+   !!* Module variables
+   REAL(wp)  :: r1_ndttrc     !    1 /  nn_dttrc 
+   REAL(wp)  :: r1_ndttrcp1   !    1 / (nn_dttrc+1) 
+
+   !!* Substitution
+#  include "top_substitute.h90"
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
+   !! $Id: trcstp.F90 2528 2010-12-27 17:33:53Z rblod $ 
+   !! 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  (:,:)
+           sshu_b_hold(:,:) = sshu_n(:,:)
+           sshv_b_hold(:,:) = sshv_n(:,:)
+           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   (:,:,:)        * fse3u(:,:,:) 
+          vn_tm   (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * fse3v(:,:,:) 
+          tsn_tm  (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
+          tsn_tm  (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
+          rhop_tm (:,:,:)        = rhop_tm (:,:,:)        + rhop (:,:,:)        * fse3t(:,:,:)  
+          avt_tm  (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * fse3w(:,:,:)  
+# if defined key_zdfddm
+          avs_tm  (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * fse3w(:,:,:)  
+# endif
+#if defined key_ldfslp
+          wslpi_tm(:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)        * fse3w(:,:,:) 
+          wslpj_tm(:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)        * fse3w(:,:,:) 
+          uslp_tm (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)        * fse3u(:,:,:) 
+          vslp_tm (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)        * fse3v(:,:,:) 
+#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  (:,:) 
+          sshu_n_tm(:,:)         = sshu_n_tm(:,:)         + sshu_n(:,:) 
+          sshv_n_tm(:,:)         = sshv_n_tm(:,:)         + sshv_n(:,:) 
+          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   (:,:) 
+          emps_tm  (:,:)         = emps_tm  (:,:)         + emps  (:,:)
+          qsr_tm   (:,:)         = qsr_tm   (:,:)         + qsr   (:,:)
+          wndm_tm  (:,:)         = wndm_tm  (:,:)         + wndm  (:,:)
+          !
+#if defined key_traldf_c3d
+          ahtt_tm  (:,:,:)       = ahtt_tm  (:,:,:)       + ahtt(:,:,:)         * fse3t(:,:,:)
+          ahtu_tm  (:,:,:)       = ahtu_tm  (:,:,:)       + ahtu(:,:,:)         * fse3u(:,:,:)
+          ahtv_tm  (:,:,:)       = ahtv_tm  (:,:,:)       + ahtv(:,:,:)         * fse3v(:,:,:)
+          ahtw_tm  (:,:,:)       = ahtw_tm  (:,:,:)       + ahtw(:,:,:)         * fse3w(:,:,:)
+#elif defined key_traldf_c2d
+          ahtt_tm  (:,:)         = ahtt_tm  (:,:)         + ahtt(:,:)
+          ahtu_tm  (:,:)         = ahtu_tm  (:,:)         + ahtu(:,:)
+          ahtv_tm  (:,:)         = ahtv_tm  (:,:)         + ahtv(:,:)
+          ahtw_tm  (:,:)         = ahtw_tm  (:,:)         + ahtw(:,:)
+#elif defined key_traldf_c1d
+          ahtt_tm  (:)           = ahtt_tm  (:,:)         + ahtt(:)
+          ahtu_tm  (:)           = ahtu_tm  (:,:)         + ahtu(:)
+          ahtv_tm  (:)           = ahtv_tm  (:,:)         + ahtv(:)
+          ahtw_tm  (:)           = ahtw_tm  (:,:)         + ahtw(:)
+#else
+          ahtt_tm                = ahtt_tm                + ahtt
+          ahtu_tm                = ahtu_tm                + ahtu
+          ahtv_tm                = ahtv_tm                + ahtv
+          ahtw_tm                = ahtw_tm                + ahtw
+#endif
+#if defined key_traldf_eiv
+#  if defined key_traldf_c3d
+          aeiu_tm  (:,:,:)       = aeiu_tm  (:,:,:)       + aeiu(:,:,:)         * fse3u(:,:,:)
+          aeiv_tm  (:,:,:)       = aeiv_tm  (:,:,:)       + aeiv(:,:,:)         * fse3v(:,:,:)
+          aeiw_tm  (:,:,:)       = aeiw_tm  (:,:,:)       + aeiw(:,:,:)         * fse3w(:,:,:)
+#  elif defined key_traldf_c2d
+          aeiu_tm  (:,:)         = aeiu_tm  (:,:)         + aeiu(:,:)
+          aeiv_tm  (:,:)         = aeiv_tm  (:,:)         + aeiv(:,:)
+          aeiw_tm  (:,:)         = aeiw_tm  (:,:)         + aeiw(:,:)
+#  elif defined key_traldf_c1d
+          aeiu_tm  (:)           = aeiu_tm  (:,:)         + aeiu(:)
+          aeiv_tm  (:)           = aeiv_tm  (:,:)         + aeiv(:)
+          aeiw_tm  (:)           = aeiw_tm  (:,:)         + aeiw(:)
+#  else
+          aeiu_tm                = aeiu_tm                + aeiu
+          aeiv_tm                = aeiv_tm                + aeiv
+          aeiw_tm                = aeiw_tm                + aeiw
+#  endif
+#endif
+
+      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 defined key_ldfslp
+         wslpi_temp (:,:,:)      = wslpi (:,:,:)
+         wslpj_temp (:,:,:)      = wslpj (:,:,:)
+         uslp_temp  (:,:,:)      = uslp  (:,:,:)
+         vslp_temp  (:,:,:)      = vslp  (:,:,:)
+#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  (:,:)
+         sshu_n_temp(:,:)        = sshu_n(:,:)
+         sshv_n_temp(:,:)        = sshv_n(:,:)
+         sshf_n_temp(:,:)        = sshf_n(:,:)
+         sshb_temp  (:,:)        = sshb  (:,:)
+         sshu_b_temp(:,:)        = sshu_b(:,:)
+         sshv_b_temp(:,:)        = sshv_b(:,:)
+         ssha_temp  (:,:)        = ssha  (:,:)
+         sshu_a_temp(:,:)        = sshu_a(:,:)
+         sshv_a_temp(:,:)        = sshv_a(:,:)
+         rnf_temp   (:,:)        = rnf   (:,:)
+         h_rnf_temp (:,:)        = h_rnf (:,:)
+         hmld_temp  (:,:)        = hmld  (:,:)
+         fr_i_temp  (:,:)        = fr_i  (:,:)
+         emp_temp   (:,:)        = emp   (:,:)
+         emp_b_temp (:,:)        = emp_b (:,:)
+         emps_temp  (:,:)        = emps  (:,:)
+         qsr_temp   (:,:)        = qsr   (:,:)
+         wndm_temp  (:,:)        = wndm  (:,:)
+#if defined key_traldf_c3d
+         ahtu_temp  (:,:,:)      = ahtu  (:,:,:)
+         ahtv_temp  (:,:,:)      = ahtv  (:,:,:)
+         ahtw_temp  (:,:,:)      = ahtw  (:,:,:)
+         ahtt_temp  (:,:,:)      = ahtt  (:,:,:)
+#elif defined key_traldf_c2d
+         ahtu_temp  (:,:)        = ahtu  (:,:)
+         ahtv_temp  (:,:)        = ahtv  (:,:)
+         ahtw_temp  (:,:)        = ahtw  (:,:)
+         ahtt_temp  (:,:)        = ahtt  (:,:)
+#elif defined key_traldf_c1d
+         ahtu_temp  (:)          = ahtu  (:)
+         ahtv_temp  (:)          = ahtv  (:)
+         ahtw_temp  (:)          = ahtw  (:)
+         ahtt_temp  (:)          = ahtt  (:)
+#else
+         ahtu_temp               = ahtu
+         ahtv_temp               = ahtv
+         ahtw_temp               = ahtw
+         ahtt_temp               = ahtt
+#endif
+
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+         aeiu_temp  (:,:,:)      = aeiu(:,:,:)
+         aeiv_temp  (:,:,:)      = aeiv(:,:,:)
+         aeiw_temp  (:,:,:)      = aeiw(:,:,:)
+# elif defined key_traldf_c2d
+         aeiu_temp  (:,:)        = aeiu(:,:)
+         aeiv_temp  (:,:)        = aeiv(:,:)
+         aeiw_temp  (:,:)        = aeiw(:,:)
+# elif defined key_traldf_c1d
+         aeiu_temp  (:)          = aeiu(:)
+         aeiv_temp  (:)          = aeiv(:)
+         aeiw_temp  (:)          = aeiw(:)
+# else
+         aeiu_temp               = aeiu
+         aeiv_temp               = aeiv
+         aeiw_temp               = aeiw
+# endif
+#endif
+         !                                    !  Variables reset in trc_sub_ssh
+         rotn_temp  (:,:,:)      = rotn  (:,:,:)
+         hdivn_temp (:,:,:)      = hdivn (:,:,:)
+         rotb_temp  (:,:,:)      = rotb  (:,:,:)
+         hdivb_temp (:,:,:)      = hdivb (:,:,:)
+         hu_temp    (:,:)        = hu    (:,:)
+         hv_temp    (:,:)        = hv    (:,:)
+         hur_temp   (:,:)        = hur   (:,:)
+         hvr_temp   (:,:)        = hvr   (:,:)
+         !
+         DO jk = 1, jpk
+            e3t_temp(:,:,jk)     = fse3t(:,:,jk)
+            e3u_temp(:,:,jk)     = fse3u(:,:,jk)
+            e3v_temp(:,:,jk)     = fse3v(:,:,jk)
+            e3w_temp(:,:,jk)     = fse3w(:,:,jk)
+         ENDDO
+         IF( lk_vvl ) THEN                      !  Update Now Vertical coord.  !   (only in vvl case)
+           !                                    !------------------------------!
+           DO jk = 1, jpk
+              fse3t (:,:,jk)     = fse3t_n (:,:,jk)   ! vertical scale factors stored in fse3. arrays
+              fse3u (:,:,jk)     = fse3u_n (:,:,jk)
+              fse3v (:,:,jk)     = fse3v_n (:,:,jk)
+              fse3w (:,:,jk)     = fse3w_n (:,:,jk)
+           END DO
+         ENDIF
+
+         ! 2. Create averages and reassign variables
+         un_tm    (:,:,:)        = un_tm   (:,:,:)        + un   (:,:,:)        * e3u_temp(:,:,:) 
+         vn_tm    (:,:,:)        = vn_tm   (:,:,:)        + vn   (:,:,:)        * e3v_temp(:,:,:) 
+         tsn_tm   (:,:,:,jp_tem) = tsn_tm  (:,:,:,jp_tem) + tsn  (:,:,:,jp_tem) * e3t_temp(:,:,:)  
+         tsn_tm   (:,:,:,jp_sal) = tsn_tm  (:,:,:,jp_sal) + tsn  (:,:,:,jp_sal) * e3t_temp(:,:,:)  
+         rhop_tm (:,:,:)         = rhop_tm (:,:,:)        + rhop (:,:,:)        * e3t_temp(:,:,:)  
+         avt_tm   (:,:,:)        = avt_tm  (:,:,:)        + avt  (:,:,:)        * e3w_temp(:,:,:)  
+# if defined key_zdfddm
+         avs_tm   (:,:,:)        = avs_tm  (:,:,:)        + avs  (:,:,:)        * e3w_temp(:,:,:)  
+# endif
+#if defined key_ldfslp
+         wslpi_tm (:,:,:)        = wslpi_tm(:,:,:)        + wslpi(:,:,:)        * e3w_temp(:,:,:) 
+         wslpj_tm (:,:,:)        = wslpj_tm(:,:,:)        + wslpj(:,:,:)        * e3w_temp(:,:,:) 
+         uslp_tm  (:,:,:)        = uslp_tm (:,:,:)        + uslp (:,:,:)        * e3u_temp(:,:,:) 
+         vslp_tm  (:,:,:)        = vslp_tm (:,:,:)        + vslp (:,:,:)        * e3v_temp(:,:,:) 
+#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  (:,:) 
+         sshu_n_tm(:,:)          = sshu_n_tm  (:,:)       + sshu_n(:,:) 
+         sshv_n_tm(:,:)          = sshv_n_tm  (:,:)       + sshv_n(:,:) 
+         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   (:,:) 
+         emps_tm  (:,:)          = emps_tm    (:,:)       + emps  (:,:)
+         qsr_tm   (:,:)          = qsr_tm     (:,:)       + qsr   (:,:)
+         wndm_tm  (:,:)          = wndm_tm    (:,:)       + wndm  (:,:)
+         !
+         sshn     (:,:)          = sshn_tm    (:,:) * r1_ndttrcp1 
+         sshu_n   (:,:)          = sshu_n_tm  (:,:) * r1_ndttrcp1  
+         sshv_n   (:,:)          = sshv_n_tm  (:,:) * r1_ndttrcp1  
+         sshb     (:,:)          = sshb_hold  (:,:)
+         sshu_b   (:,:)          = sshu_b_hold(:,:)
+         sshv_b   (:,:)          = sshv_b_hold(:,:)
+         rnf      (:,:)          = rnf_tm     (:,:) * r1_ndttrcp1 
+         h_rnf    (:,:)          = h_rnf_tm   (:,:) * r1_ndttrcp1 
+         hmld     (:,:)          = hmld_tm    (:,:) * r1_ndttrcp1 
+         !  variables that are initialized after averages initialized
+         emp_b    (:,:) = emp_b_hold (:,:)
+         IF( kt == nittrc000 ) THEN
+            wndm  (:,:)          = wndm_tm    (:,:) * r1_ndttrc 
+            qsr   (:,:)          = qsr_tm     (:,:) * r1_ndttrc 
+            emp   (:,:)          = emp_tm     (:,:) * r1_ndttrc 
+            emps  (:,:)          = emps_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 
+            emps  (:,:)          = emps_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  / fse3t(ji,jj,jk)
+                  z1_ne3u = r1_ndttrcp1  / fse3u(ji,jj,jk)
+                  z1_ne3v = r1_ndttrcp1  / fse3v(ji,jj,jk)
+                  z1_ne3w = r1_ndttrcp1  / fse3w(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
+                  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
+#if defined key_ldfslp
+                  wslpi(ji,jj,jk)        = wslpi_tm(ji,jj,jk)        * z1_ne3w 
+                  wslpj(ji,jj,jk)        = wslpj_tm(ji,jj,jk)        * z1_ne3w 
+                  uslp (ji,jj,jk)        = uslp_tm (ji,jj,jk)        * z1_ne3u 
+                  vslp (ji,jj,jk)        = vslp_tm (ji,jj,jk)        * z1_ne3v 
+#endif
+               ENDDO
+            ENDDO
+         ENDDO
+
+#if defined key_traldf_c3d
+          ahtt_tm  (:,:,:)       = ahtt_tm  (:,:,:)       + ahtt(:,:,:)         * e3t_temp(:,:,:)
+          ahtu_tm  (:,:,:)       = ahtu_tm  (:,:,:)       + ahtu(:,:,:)         * e3u_temp(:,:,:)
+          ahtv_tm  (:,:,:)       = ahtv_tm  (:,:,:)       + ahtv(:,:,:)         * e3v_temp(:,:,:)
+          ahtw_tm  (:,:,:)       = ahtw_tm  (:,:,:)       + ahtw(:,:,:)         * e3w_temp(:,:,:)
+          !
+          ahtt     (:,:,:)       = ahtt_tm  (:,:,:) * r1_ndttrcp1  / fse3t(:,:,:)
+          ahtu     (:,:,:)       = ahtu_tm  (:,:,:) * r1_ndttrcp1  / fse3u(:,:,:)
+          ahtv     (:,:,:)       = ahtv_tm  (:,:,:) * r1_ndttrcp1  / fse3v(:,:,:)
+          ahtw     (:,:,:)       = ahtw_tm  (:,:,:) * r1_ndttrcp1  / fse3w(:,:,:)
+#elif defined key_traldf_c2d
+          ahtt_tm  (:,:)         = ahtt_tm  (:,:)         + ahtt(:,:)
+          ahtu_tm  (:,:)         = ahtu_tm  (:,:)         + ahtu(:,:)
+          ahtv_tm  (:,:)         = ahtv_tm  (:,:)         + ahtv(:,:)
+          ahtw_tm  (:,:)         = ahtw_tm  (:,:)         + ahtw(:,:)
+          !
+          ahtt     (:,:)         = ahtt_tm  (:,:)   * r1_ndttrcp1
+          ahtu     (:,:)         = ahtu_tm  (:,:)   * r1_ndttrcp1
+          ahtv     (:,:)         = ahtv_tm  (:,:)   * r1_ndttrcp1
+          ahtw     (:,:)         = ahtw_tm  (:,:)   * r1_ndttrcp1
+#elif defined key_traldf_c1d
+          ahtt_tm  (:)           = ahtt_tm  (:,:)         + ahtt(:)
+          ahtu_tm  (:)           = ahtu_tm  (:,:)         + ahtu(:)
+          ahtv_tm  (:)           = ahtv_tm  (:,:)         + ahtv(:)
+          ahtw_tm  (:)           = ahtw_tm  (:,:)         + ahtw(:)
+          !
+          ahtt     (:)           = ahtt_tm  (:)     * r1_ndttrcp1
+          ahtu     (:)           = ahtu_tm  (:)     * r1_ndttrcp1
+          ahtv     (:)           = ahtv_tm  (:)     * r1_ndttrcp1
+          ahtw     (:)           = ahtw_tm  (:)     * r1_ndttrcp1
+#else
+          ahtt_tm                = ahtt_tm                + ahtt
+          ahtu_tm                = ahtu_tm                + ahtu
+          ahtv_tm                = ahtv_tm                + ahtv
+          ahtw_tm                = ahtw_tm                + ahtw
+          !
+          ahtt                   = ahtt_tm          * r1_ndttrcp1
+          ahtu                   = ahtu_tm          * r1_ndttrcp1
+          ahtv                   = ahtv_tm          * r1_ndttrcp1
+          ahtw                   = ahtw_tm          * r1_ndttrcp1
+#endif
+
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+          aeiu_tm  (:,:,:)       = aeiu_tm  (:,:,:)       + aeiu(:,:,:)         * e3u_temp(:,:,:)
+          aeiv_tm  (:,:,:)       = aeiv_tm  (:,:,:)       + aeiv(:,:,:)         * e3v_temp(:,:,:)
+          aeiw_tm  (:,:,:)       = aeiw_tm  (:,:,:)       + aeiw(:,:,:)         * e3w_temp(:,:,:)
+          !
+          aeiu     (:,:,:)       = aeiu_tm  (:,:,:) * r1_ndttrcp1  / fse3u(:,:,:)
+          aeiv     (:,:,:)       = aeiv_tm  (:,:,:) * r1_ndttrcp1  / fse3v(:,:,:)
+          aeiw     (:,:,:)       = aeiw_tm  (:,:,:) * r1_ndttrcp1  / fse3w(:,:,:)
+# elif defined key_traldf_c2d
+          aeiu_tm  (:,:)         = aeiu_tm  (:,:)         + aeiu(:,:)
+          aeiv_tm  (:,:)         = aeiv_tm  (:,:)         + aeiv(:,:)
+          aeiw_tm  (:,:)         = aeiw_tm  (:,:)         + aeiw(:,:)
+          !
+          aeiu     (:,:)         = aeiu_tm  (:,:)   * r1_ndttrcp1
+          aeiv     (:,:)         = aeiv_tm  (:,:)   * r1_ndttrcp1
+          aeiw     (:,:)         = aeiw_tm  (:,:)   * r1_ndttrcp1
+# elif defined key_traldf_c1d
+          aeiu_tm  (:)           = aeiu_tm  (:,:)         + aeiu(:)
+          aeiv_tm  (:)           = aeiv_tm  (:,:)         + aeiv(:)
+          aeiw_tm  (:)           = aeiw_tm  (:,:)         + aeiw(:)
+          !
+          aeiu     (:)           = aeiu_tm  (:)     * r1_ndttrcp1
+          aeiv     (:)           = aeiv_tm  (:)     * r1_ndttrcp1
+          aeiw     (:)           = aeiw_tm  (:)     * r1_ndttrcp1
+# else
+          aeiu_tm                = aeiu_tm                + aeiu
+          aeiv_tm                = aeiv_tm                + aeiv
+          aeiw_tm                = aeiw_tm                + aeiw
+          !
+          aeiu                   = aeiu_tm          * r1_ndttrcp1
+          aeiv                   = aeiv_tm          * r1_ndttrcp1
+          aeiw                   = aeiw_tm          * r1_ndttrcp1
+# endif
+#endif
+
+         CALL lbc_lnk( un    (:,:,:)       , 'U',-1. ) 
+         CALL lbc_lnk( vn    (:,:,:)       , 'V',-1. ) 
+         CALL lbc_lnk( tsn   (:,:,:,jp_tem), 'T', 1. ) 
+         CALL lbc_lnk( tsn   (:,:,:,jp_sal), 'T', 1. ) 
+         CALL lbc_lnk( rhop  (:,:,:)       , 'T', 1. ) 
+         CALL lbc_lnk( avt   (:,:,:)       , 'W', 1. ) 
+# if defined key_zdfddm
+          CALL lbc_lnk( avs  (:,:,:)       , 'W', 1. ) 
+# endif
+#if defined key_ldfslp
+         CALL lbc_lnk( uslp  (:,:,:)       , 'U',-1. ) 
+         CALL lbc_lnk( vslp  (:,:,:)       , 'V',-1. ) 
+         CALL lbc_lnk( wslpi (:,:,:)       , 'W',-1. ) 
+         CALL lbc_lnk( wslpj (:,:,:)       , 'W',-1. ) 
+#endif
+         CALL lbc_lnk( sshn  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( sshu_n(:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( sshv_n(:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( sshf_n(:,:)         , 'F', 1. ) 
+         CALL lbc_lnk( sshb  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( sshu_b(:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( sshv_b(:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( ssha  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( sshu_a(:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( sshv_a(:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( rnf   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( h_rnf (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( hmld  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( fr_i  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emp   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emp_b (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( emps  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( qsr   (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( wndm  (:,:)         , 'T', 1. ) 
+# if defined key_trabbl
+         IF( nn_bbl_ldf == 1 ) THEN
+            CALL lbc_lnk( ahu_bbl(:,:)     , 'U', 1. ) 
+            CALL lbc_lnk( ahv_bbl(:,:)     , 'v', 1. ) 
+         ENDIF
+         IF( nn_bbl_adv == 1 ) THEN
+            CALL lbc_lnk( utr_bbl(:,:)     , 'U', 1. ) 
+            CALL lbc_lnk( vtr_bbl(:,:)     , 'U', 1. ) 
+         ENDIF
+# endif
+#if defined key_traldf_c3d
+         CALL lbc_lnk( ahtt  (:,:,:)       , 'T', 1. ) 
+         CALL lbc_lnk( ahtu  (:,:,:)       , 'U', 1. ) 
+         CALL lbc_lnk( ahtv  (:,:,:)       , 'V', 1. ) 
+         CALL lbc_lnk( ahtw  (:,:,:)       , 'W', 1. ) 
+#elif defined key_traldf_c2d
+         CALL lbc_lnk( ahtt  (:,:)         , 'T', 1. ) 
+         CALL lbc_lnk( ahtu  (:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( ahtv  (:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( ahtw  (:,:)         , 'W', 1. ) 
+#endif
+#if defined key_traldf_eiv
+#if defined key_traldf_c3d
+         CALL lbc_lnk( aeiu  (:,:,:)       , 'U', 1. ) 
+         CALL lbc_lnk( aeiv  (:,:,:)       , 'V', 1. ) 
+         CALL lbc_lnk( aeiw  (:,:,:)       , 'W', 1. ) 
+#elif defined key_traldf_c2d
+         CALL lbc_lnk( aeiu  (:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( aeiv  (:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( aeiw  (:,:)         , 'W', 1. ) 
+#endif
+#endif
+         !
+         CALL trc_sub_ssh( kt )         ! after ssh & vertical velocity
+         !
+         CALL lbc_lnk( wn    (:,:,:)       , 'W',-1. ) 
+         CALL lbc_lnk( rotn  (:,:,:)       , 'F', 1. ) 
+         CALL lbc_lnk( hdivn (:,:,:)       , 'T', 1. ) 
+         CALL lbc_lnk( rotb  (:,:,:)       , 'F', 1. ) 
+         CALL lbc_lnk( hdivb (:,:,:)       , 'T', 1. ) 
+         CALL lbc_lnk( hu    (:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( hv    (:,:)         , 'V', 1. ) 
+         CALL lbc_lnk( hur   (:,:)         , 'U', 1. ) 
+         CALL lbc_lnk( hvr   (:,:)         , 'V', 1. ) 
+      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   (:,:,:)        * fse3u(:,:,:) 
+      vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
+      tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
+      tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
+      rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)  
+      avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)  
+# if defined key_zdfddm
+      avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
+# endif
+#if defined key_ldfslp
+      wslpi_tm(:,:,:)        = wslpi(:,:,:)        * fse3w(:,:,:) 
+      wslpj_tm(:,:,:)        = wslpj(:,:,:)        * fse3w(:,:,:) 
+      uslp_tm (:,:,:)        = uslp (:,:,:)        * fse3u(:,:,:) 
+      vslp_tm (:,:,:)        = vslp (:,:,:)        * fse3v(:,:,:) 
+#endif
+      sshn_tm  (:,:) = sshn  (:,:) 
+      sshu_n_tm(:,:) = sshu_n(:,:) 
+      sshv_n_tm(:,:) = sshv_n(:,:) 
+      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
+      emps_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 defined key_traldf_c3d
+      ahtt_tm(:,:,:) = ahtt(:,:,:) * fse3t(:,:,:)
+      ahtu_tm(:,:,:) = ahtu(:,:,:) * fse3u(:,:,:)
+      ahtv_tm(:,:,:) = ahtv(:,:,:) * fse3v(:,:,:)
+      ahtw_tm(:,:,:) = ahtw(:,:,:) * fse3w(:,:,:)
+#elif defined key_traldf_c2d
+      ahtt_tm(:,:)   = ahtt(:,:)
+      ahtu_tm(:,:)   = ahtu(:,:)
+      ahtv_tm(:,:)   = ahtv(:,:)
+      ahtw_tm(:,:)   = ahtw(:,:)
+#elif defined key_traldf_c1d
+      ahtt_tm(:)     = ahtt(:)
+      ahtu_tm(:)     = ahtu(:)
+      ahtv_tm(:)     = ahtv(:)
+      ahtw_tm(:)     = ahtw(:)
+#else
+      ahtt_tm        = ahtt
+      ahtu_tm        = ahtu
+      ahtv_tm        = ahtv
+      ahtw_tm        = ahtw
+#endif
+      !
+#if defined key_traldf_eiv
+#  if defined key_traldf_c3d
+      aeiu_tm(:,:,:) = aeiu(:,:,:) * fse3u(:,:,:)
+      aeiv_tm(:,:,:) = aeiv(:,:,:) * fse3v(:,:,:)
+      aeiw_tm(:,:,:) = aeiw(:,:,:) * fse3w(:,:,:)
+#  elif defined key_traldf_c2d
+      aeiu_tm(:,:)   = aeiu(:,:)
+      aeiv_tm(:,:)   = aeiv(:,:)
+      aeiw_tm(:,:)   = aeiw(:,:)
+#  elif defined key_traldf_c1d
+      aeiu_tm(:)     = aeiu(:)
+      aeiv_tm(:)     = aeiv(:)
+      aeiw_tm(:)     = aeiw(:)
+#  else
+      aeiu_tm        = aeiu
+      aeiv_tm        = aeiv
+      aeiw_tm        = aeiw
+#  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 defined key_ldfslp
+      wslpi (:,:,:)   =  wslpi_temp (:,:,:)
+      wslpj (:,:,:)   =  wslpj_temp (:,:,:)
+      uslp  (:,:,:)   =  uslp_temp  (:,:,:)
+      vslp  (:,:,:)   =  vslp_temp  (:,:,:)
+#endif
+      sshn  (:,:)     =  sshn_temp  (:,:)
+      sshb  (:,:)     =  sshb_temp  (:,:)
+      ssha  (:,:)     =  ssha_temp  (:,:)
+      sshu_n(:,:)     =  sshu_n_temp(:,:)
+      sshu_b(:,:)     =  sshu_b_temp(:,:)
+      sshu_a(:,:)     =  sshu_a_temp(:,:)
+      sshv_n(:,:)     =  sshv_n_temp(:,:)
+      sshv_b(:,:)     =  sshv_b_temp(:,:)
+      sshv_a(:,:)     =  sshv_a_temp(:,:)
+      sshf_n(:,:)     =  sshf_n_temp(:,:)
+      rnf   (:,:)     =  rnf_temp   (:,:)
+      h_rnf (:,:)     =  h_rnf_temp (:,:)
+      !
+      hmld  (:,:)     =  hmld_temp  (:,:)
+      fr_i  (:,:)     =  fr_i_temp  (:,:)
+      emp   (:,:)     =  emp_temp   (:,:)
+      emps  (:,:)     =  emps_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
+      !
+#if defined key_traldf_c3d
+      ahtu  (:,:,:)   =  ahtu_temp  (:,:,:)
+      ahtv  (:,:,:)   =  ahtv_temp  (:,:,:)
+      ahtw  (:,:,:)   =  ahtw_temp  (:,:,:)
+      ahtt  (:,:,:)   =  ahtt_temp  (:,:,:)
+#elif defined key_traldf_c2d
+      ahtu  (:,:)     =  ahtu_temp  (:,:)
+      ahtv  (:,:)     =  ahtv_temp  (:,:)
+      ahtw  (:,:)     =  ahtw_temp  (:,:)
+      ahtt  (:,:)     =  ahtt_temp  (:,:)
+#elif defined key_traldf_c1d
+      ahtu  (:)       =  ahtu_temp  (:)
+      ahtv  (:)       =  ahtv_temp  (:)
+      ahtw  (:)       =  ahtw_temp  (:)
+      ahtt  (:)       =  ahtt_temp  (:)
+#else
+      ahtu            =  ahtu_temp
+      ahtv            =  ahtv_temp
+      ahtw            =  ahtw_temp
+      ahtt            =  ahtt_temp
+#endif
+      !
+#if defined key_traldf_eiv
+#if defined key_traldf_c3d
+      aeiu  (:,:,:)  =  aeiu_temp(:,:,:)
+      aeiv  (:,:,:)  =  aeiv_temp(:,:,:)
+      aeiw  (:,:,:)  =  aeiw_temp(:,:,:)
+#elif defined key_traldf_c2d
+      aeiu  (:,:)    =  aeiu_temp(:,:)
+      aeiv  (:,:)    =  aeiv_temp(:,:)
+      aeiw  (:,:)    =  aeiw_temp(:,:)
+#elif defined key_traldf_c1d
+      aeiu  (:)      =  aeiu_temp(:)
+      aeiv  (:)      =  aeiv_temp(:)
+      aeiw  (:)      =  aeiw_temp(:)
+#else
+      aeiu           =  aeiu_temp
+      aeiv           =  aeiv_temp
+      aeiw           =  aeiw_temp
+#endif
+#endif 
+      hdivn (:,:,:)   =  hdivn_temp (:,:,:)
+      rotn  (:,:,:)   =  rotn_temp  (:,:,:)
+      hdivb (:,:,:)   =  hdivb_temp (:,:,:)
+      rotb  (:,:,:)   =  rotb_temp  (:,:,:)
+      hu    (:,:)     =  hu_temp    (:,:)
+      hv    (:,:)     =  hv_temp    (:,:)
+      hur   (:,:)     =  hur_temp   (:,:)
+      hvr   (:,:)     =  hvr_temp   (:,:)
+      !                                      
+      DO jk = 1, jpk
+         fse3t(:,:,jk)= e3t_temp(:,:,jk) 
+         fse3u(:,:,jk)= e3u_temp(:,:,jk) 
+         fse3v(:,:,jk)= e3v_temp(:,:,jk) 
+         fse3w(:,:,jk)= e3w_temp(:,:,jk) 
+      END DO
+      !                                           !------------------------------!
+      IF( lk_vvl ) THEN                           !  Update Now Vertical coord.  !   (only in vvl case)
+        !                                           !------------------------------!
+         DO jk = 1, jpkm1
+            fsdept(:,:,jk) = fsdept_n(:,:,jk)          ! now local depths stored in fsdep. arrays
+            fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
+            fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
+            !
+            fse3t (:,:,jk) = fse3t_n (:,:,jk)          ! vertical scale factors stored in fse3. arrays
+            fse3u (:,:,jk) = fse3u_n (:,:,jk)
+            fse3v (:,:,jk) = fse3v_n (:,:,jk)
+            fse3f (:,:,jk) = fse3f_n (:,:,jk)
+            fse3w (:,:,jk) = fse3w_n (:,:,jk)
+            fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
+            fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
+         END DO
+         !
+      ENDIF
+
+      ! Start new averages
+         un_tm   (:,:,:)        = un   (:,:,:)        * fse3u(:,:,:) 
+         vn_tm   (:,:,:)        = vn   (:,:,:)        * fse3v(:,:,:) 
+         tsn_tm  (:,:,:,jp_tem) = tsn  (:,:,:,jp_tem) * fse3t(:,:,:)  
+         tsn_tm  (:,:,:,jp_sal) = tsn  (:,:,:,jp_sal) * fse3t(:,:,:)  
+         rhop_tm (:,:,:)        = rhop (:,:,:)        * fse3t(:,:,:)  
+         avt_tm  (:,:,:)        = avt  (:,:,:)        * fse3w(:,:,:)  
+# if defined key_zdfddm
+         avs_tm  (:,:,:)        = avs  (:,:,:)        * fse3w(:,:,:)  
+# endif
+#if defined key_ldfslp
+         wslpi_tm(:,:,:)        = wslpi(:,:,:)        * fse3w(:,:,:) 
+         wslpj_tm(:,:,:)        = wslpj(:,:,:)        * fse3w(:,:,:) 
+         uslp_tm (:,:,:)        = uslp (:,:,:)        * fse3u(:,:,:) 
+         vslp_tm (:,:,:)        = vslp (:,:,:)        * fse3v(:,:,:) 
+#endif
+      !
+      sshb_hold  (:,:) = sshn  (:,:)
+      sshu_b_hold(:,:) = sshu_n(:,:)
+      sshv_b_hold(:,:) = sshv_n(:,:)
+      emp_b_hold (:,:) = emp   (:,:)
+      sshn_tm    (:,:) = sshn  (:,:) 
+      sshu_n_tm  (:,:) = sshu_n(:,:) 
+      sshv_n_tm  (:,:) = sshv_n(:,:) 
+      rnf_tm     (:,:) = rnf   (:,:) 
+      h_rnf_tm   (:,:) = h_rnf (:,:) 
+      hmld_tm    (:,:) = hmld  (:,:)
+      fr_i_tm    (:,:) = fr_i  (:,:)
+      emp_tm     (:,:) = emp   (:,:)
+      emps_tm    (:,:) = emps  (:,:)
+      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 defined key_traldf_c3d
+      DO jk = 1, jpkm1
+         ahtt_tm(:,:,jk) = ahtt(:,:,jk) * fse3t(:,:,jk)
+         ahtu_tm(:,:,jk) = ahtu(:,:,jk) * fse3u(:,:,jk)
+         ahtv_tm(:,:,jk) = ahtv(:,:,jk) * fse3v(:,:,jk)
+         ahtw_tm(:,:,jk) = ahtw(:,:,jk) * fse3w(:,:,jk)
+      END DO
+#elif defined key_traldf_c2d
+      ahtt_tm(:,:)   = ahtt(:,:)
+      ahtu_tm(:,:)   = ahtu(:,:)
+      ahtv_tm(:,:)   = ahtv(:,:)
+      ahtw_tm(:,:)   = ahtw(:,:)
+#elif defined key_traldf_c1d
+      ahtt_tm(:)     = ahtt(:)
+      ahtu_tm(:)     = ahtu(:)
+      ahtv_tm(:)     = ahtv(:)
+      ahtw_tm(:)     = ahtw(:)
+#else
+      ahtt_tm        = ahtt
+      ahtu_tm        = ahtu
+      ahtv_tm        = ahtv
+      ahtw_tm        = ahtw
+#endif
+      !
+#if defined key_traldf_eiv
+#  if defined key_traldf_c3d
+      DO jk = 1, jpk
+         aeiu_tm(:,:,jk) = aeiu(:,:,jk) * fse3u(:,:,jk)
+         aeiv_tm(:,:,jk) = aeiv(:,:,jk) * fse3v(:,:,jk)
+         aeiw_tm(:,:,jk) = aeiw(:,:,jk) * fse3w(:,:,jk)
+      END DO
+#  elif defined key_traldf_c2d
+      aeiu_tm(:,:)   = aeiu(:,:)
+      aeiv_tm(:,:)   = aeiv(:,:)
+      aeiw_tm(:,:)   = aeiw(:,:)
+#  elif defined key_traldf_c1d
+      aeiu_tm(:)     = aeiu(:)
+      aeiv_tm(:)     = aeiv(:)
+      aeiw_tm(:)     = aeiw(:)
+#  else
+      aeiu_tm        = aeiu
+      aeiv_tm        = aeiv
+      aeiw_tm        = aeiw
+#  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 (lk_vvl=T).
+      !!
+      !! ** 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 (lk_vvl=T)
+      !!                hu, hv, hur, hvr        : ocean depth and its inverse at u-,v-points
+      !!
+      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling.
+      !!----------------------------------------------------------------------
+      !
+      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
+
+      !                                           !------------------------------------------!
+      IF( lk_vvl ) THEN                           !  Regridding: Update Now Vertical coord.  !   (only in vvl case)
+         !                                        !------------------------------------------!
+         DO jk = 1, jpkm1
+            fsdept(:,:,jk) = fsdept_n(:,:,jk)         ! now local depths stored in fsdep. arrays
+            fsdepw(:,:,jk) = fsdepw_n(:,:,jk)
+            fsde3w(:,:,jk) = fsde3w_n(:,:,jk)
+            !
+            fse3t (:,:,jk) = fse3t_n (:,:,jk)         ! vertical scale factors stored in fse3. arrays
+            fse3u (:,:,jk) = fse3u_n (:,:,jk)
+            fse3v (:,:,jk) = fse3v_n (:,:,jk)
+            fse3f (:,:,jk) = fse3f_n (:,:,jk)
+            fse3w (:,:,jk) = fse3w_n (:,:,jk)
+            fse3uw(:,:,jk) = fse3uw_n(:,:,jk)
+            fse3vw(:,:,jk) = fse3vw_n(:,:,jk)
+         END DO
+         !
+         hu(:,:) = hu_0(:,:) + sshu_n(:,:)            ! now ocean depth (at u- and v-points)
+         hv(:,:) = hv_0(:,:) + sshv_n(:,:)
+         !                                            ! now masked inverse of the ocean depth (at u- and v-points)
+         hur(:,:) = umask(:,:,1) / ( hu(:,:) + 1._wp - umask(:,:,1) )
+         hvr(:,:) = vmask(:,:,1) / ( hv(:,:) + 1._wp - vmask(:,:,1) )
+         ! 
+      ENDIF
+      !
+      CALL div_cur( 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(:,:) + fse3t(:,:,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 defined key_agrif
+      CALL agrif_ssh( kt )
+#endif
+#if defined key_obc
+      IF( Agrif_Root() ) THEN 
+         ssha(:,:) = ssha(:,:) * obctmsk(:,:)
+         CALL lbc_lnk( ssha, 'T', 1. )                 ! absolutly compulsory !! (jmm)
+      ENDIF
+#endif
+#if defined key_bdy
+      ssha(:,:) = ssha(:,:) * bdytmask(:,:)
+      CALL lbc_lnk( ssha, 'T', 1. ) 
+#endif
+
+      !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only)
+      IF( lk_vvl ) THEN                                ! (required only in key_vvl case)
+         DO jj = 1, jpjm1
+            DO ji = 1, jpim1      ! NO Vector Opt.
+               sshu_a(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   &
+                  &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     &
+                  &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) )
+               sshv_a(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   &
+                  &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     &
+                  &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) )
+            END DO
+         END DO
+         CALL lbc_lnk( sshu_a, 'U', 1. )   ;   CALL lbc_lnk( sshv_a, 'V', 1. )      ! Boundaries conditions
+      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 fse3t by its expression yields too long lines otherwise
+         wn(:,:,jk) = wn(:,:,jk+1) -   fse3t_n(:,:,jk) * hdivn(:,:,jk)        &
+            &                      - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) )    &
+            &                         * tmask(:,:,jk) * z1_2dt
+#if defined key_bdy
+         wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
+#endif
+      END DO
+
+      !
+      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)          ,  sshu_a_temp(jpi,jpj),     &
+         &      sshu_n_temp(jpi,jpj)        ,  sshu_b_temp(jpi,jpj),     &
+         &      sshv_n_temp(jpi,jpj)        ,  sshv_b_temp(jpi,jpj),     &
+         &      sshv_a_temp(jpi,jpj)        ,  sshf_n_temp(jpi,jpj) ,   &
+         &      e3t_temp(jpi,jpj,jpk)       ,  e3u_temp(jpi,jpj,jpk),    &
+         &      e3v_temp(jpi,jpj,jpk)       ,  e3w_temp(jpi,jpj,jpk),    &
+#if defined key_ldfslp
+         &      wslpi_temp(jpi,jpj,jpk)     ,  wslpj_temp(jpi,jpj,jpk),  &
+         &      uslp_temp(jpi,jpj,jpk)      ,  vslp_temp(jpi,jpj,jpk),   &
+#endif
+#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)           ,  emps_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
+#if defined key_traldf_c3d
+         &      ahtt_tm(jpi,jpj,jpk)        ,  ahtt_temp(jpi,jpj,jpk),   &
+         &      ahtu_tm(jpi,jpj,jpk)        ,  ahtu_temp(jpi,jpj,jpk),   &
+         &      ahtv_tm(jpi,jpj,jpk)        ,  ahtv_temp(jpi,jpj,jpk),   &
+         &      ahtw_tm(jpi,jpj,jpk)        ,  ahtw_temp(jpi,jpj,jpk),   &
+#elif defined key_traldf_c2d
+         &      ahtt_tm(jpi,jpj)            ,  ahtt_temp(jpi,jpj),       &
+         &      ahtu_tm(jpi,jpj)            ,  ahtu_temp(jpi,jpj),       &
+         &      ahtv_tm(jpi,jpj)            ,  ahtv_temp(jpi,jpj),       &
+         &      ahtw_tm(jpi,jpj)            ,  ahtw_temp(jpi,jpj),       &
+#elif defined key_traldf_c1d
+         &      ahtt_tm(jpk)                ,  ahtt_temp(jpk),           &
+         &      ahtu_tm(jpk)                ,  ahtu_temp(jpk),           &
+         &      ahtv_tm(jpk)                ,  ahtv_temp(jpk),           &
+         &      ahtw_tm(jpk)                ,  ahtw_temp(jpk),           &
+#endif
+#if defined key_traldf_eiv
+# if defined key_traldf_c3d
+         &      aeiu_tm(jpi,jpj,jpk)        ,  aeiu_temp(jpi,jpj,jpk),   &
+         &      aeiv_tm(jpi,jpj,jpk)        ,  aeiv_temp(jpi,jpj,jpk),   &
+         &      aeiw_tm(jpi,jpj,jpk)        ,  aeiw_temp(jpi,jpj,jpk),   &
+# elif defined key_traldf_c2d
+         &      aeiu_tm(jpi,jpj)            ,  aeiu_temp(jpi,jpj),       &
+         &      aeiv_tm(jpi,jpj)            ,  aeiv_temp(jpi,jpj),       &
+         &      aeiw_tm(jpi,jpj)            ,  aeiw_temp(jpi,jpj),       &
+# elif defined key_traldf_c1d
+         &      aeiu_tm(jpk)                ,  aeiu_temp(jpk),           &
+         &      aeiv_tm(jpk)                ,  aeiv_temp(jpk),           &
+         &      aeiw_tm(jpk)                ,  aeiw_temp(jpk),           &
+# endif
+# endif
+         &      hdivn_temp(jpi,jpj,jpk)     ,  hdivb_temp(jpi,jpj,jpk),  &
+         &      rotn_temp(jpi,jpj,jpk)      ,  rotb_temp(jpi,jpj,jpk),   &
+         &      hu_temp(jpi,jpj)            ,  hv_temp(jpi,jpj),         &
+         &      hur_temp(jpi,jpj)           ,  hvr_temp(jpi,jpj),        &
+         &      un_tm(jpi,jpj,jpk)          ,  vn_tm(jpi,jpj,jpk)  ,     &
+         &      avt_tm(jpi,jpj,jpk)                                ,     &
+         &      sshn_tm(jpi,jpj)            ,  sshb_hold(jpi,jpj) ,      &
+         &      sshu_n_tm(jpi,jpj)          ,  sshu_b_hold(jpi,jpj),     &
+         &      sshv_n_tm(jpi,jpj)          ,  sshv_b_hold(jpi,jpj),     &
+         &      tsn_tm(jpi,jpj,jpk,2)       ,                            &
+         &      emp_tm(jpi,jpj)             ,  emps_tm(jpi,jpj) ,        &
+         &      emp_b_hold(jpi,jpj)         ,                            &
+         &      hmld_tm(jpi,jpj)            ,  qsr_tm(jpi,jpj) ,         &
+#if defined key_ldfslp
+         &      wslpi_tm(jpi,jpj,jpk)       ,  wslpj_tm(jpi,jpj,jpk),    &
+         &      uslp_tm(jpi,jpj,jpk)        ,  vslp_tm(jpi,jpj,jpk),     &
+#endif
+#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')
+
+      !
+   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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/NEMO/TOP_SRC/trcwri.F90	(revision 3437)
@@ -0,0 +1,98 @@
+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
+
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC trc_wri      
+
+   !! * Substitutions
+#  include "top_substitute.h90"
+
+CONTAINS
+
+   SUBROUTINE trc_wri( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri  ***
+      !! 
+      !! ** Purpose :   output passive tracers fields and dynamical trends
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) :: kt
+      !!---------------------------------------------------------------------
+      !
+      IF( nn_timing == 1 )  CALL timing_start('trc_wri')
+      !
+      CALL iom_setkt  ( kt + nn_dttrc - 1 )       ! set the passive tracer time step
+      CALL trc_wri_trc( kt              )       ! outputs for tracer concentration
+      CALL iom_setkt  ( kt              )       ! set the model time step
+      !
+      IF( nn_timing == 1 )  CALL timing_stop('trc_wri')
+      !
+   END SUBROUTINE trc_wri
+
+   SUBROUTINE trc_wri_trc( kt )  
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE trc_wri_trc  ***
+      !!
+      !! ** Purpose :   output passive tracers fields 
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in )     :: kt       ! ocean time-step
+      INTEGER                   :: jn
+      CHARACTER (len=20)        :: cltra
+      CHARACTER (len=40)        :: clhstnam
+      INTEGER ::   inum = 11            ! temporary logical unit
+      !!---------------------------------------------------------------------
+ 
+      IF( lk_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( lk_pisces )  THEN
+         CALL trc_wri_pisces
+      ELSE
+         DO jn = 1, jptra
+            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer
+            CALL iom_put( cltra, trn(:,:,:,jn) )
+         END DO
+      ENDIF
+      !
+   END SUBROUTINE trc_wri_trc
+
+#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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ALTIX_NAUTILUS_MPT	(revision 3437)
@@ -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=/sata/working/jeff/packages/netcdf4/netcdf-4.1.1/altix/intel10.1
+  export HD5_HOME=/sata/working/jeff/packages/hdf5/hdf5-1.8.4-patch1/altix/intel10.1
+  export IFT_HOME=/sw/Intel/fce/10.1.021
+  export SVN_HOME=/fibre/acc/UTILS/svn/v1.5/svn
+#
+  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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_CALYPSO	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-PW6_VARGAS	(revision 3437)
@@ -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 = 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 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 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_TITANE	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-ifort_MERCATOR_CLUSTER	(revision 3437)
@@ -0,0 +1,74 @@
+#!/bin/bash 
+#!
+#PBS -N sette
+#PBS -e sette.$PBS_JOBID.err
+#PBS -o sette.$PBS_JOBID.out
+#PBS -l nodes=2:ppn=8
+#PBS -q multi
+#PBS -l walltime=03:00:00
+#PBS -l mem=24gb
+
+#
+# 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 
+#
+  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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/BATCH_TEMPLATE/sette_batch_template	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/README	(revision 3437)
@@ -0,0 +1,79 @@
+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 : command for job submission in batch mode
+	       MPI_INTERACT : "yes" if you want to run in interactive mode for MPI run
+	       		      "no" if you want to run in batch mode for MPI run
+			      NOTE : every job using only 1 proc is run in interactive mode
+
+               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 (for example to test reproductibility: add_key mpp_rep)
+                        del_key : to del list of keys
+               and for more details and options of makenemo see ./makenemo -h
+
+	       set_namelist : to set namelist values 
+			(example : to set 75 time steps for one test : namelist nn_itend 75)
+			(        : to change cn_icerst_in name : namelist_ice cn_icerst_in  \"test_00101231_restart_icemod\")
+			(  	 : 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 NB_PROCS TEST_NAME MPI_FLAG JOB_FILE_NAME
+
+               fcm_job.sh needs input: TOTAL_NUMBER_OF_PROCS_used JOB_FILE_NAME INTERACT_FLAG MPI_FLAG 
+			(for example if you compile ORCA2_LIM with key_mpp_mpi 
+			and only run short test ===> ./fcm_job input_ORCA2_LIM.cfg 4 SHORT)
+
+ 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 [ ${MPI_INTERACT} == "yes" ] mpirun command line (some examples are already written)
+	       NOTE: if MPI_INTERACT="no" it is neede 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 MPI_INTERACT="no")
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/all_functions.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/all_functions.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/all_functions.sh	(revision 3437)
@@ -0,0 +1,217 @@
+######################################################
+# 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_lim2 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 enought 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 $@\". "
+		echo "variable: \"$2\" is empty"
+		echo "control that variable $2 is in \"${EXE_DIR}/$1\" "
+		echo "exit"
+		echo "error in executing script : set_namelist $@" >> ${SETTE_DIR}/output.sette
+		echo "....." >> ${SETTE_DIR}/output.sette
+		exit 1
+	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}/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 "ok model run"   >> ${SETTE_DIR}/output.sette
+    fi
+################################################################
+
+################################################################
+# Creation of NEMO_VALIDATION tree
+    export LANG=en_US 
+    cd ${CONFIG_DIR}
+    cd ../
+    REVISION_NB=`svn info | grep -i "Revision:" | sed -e "s/ //" | 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}/*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
+}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/fcm_job.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/fcm_job.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/fcm_job.sh	(revision 3437)
@@ -0,0 +1,100 @@
+#####################################################
+# 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 MPI_FLAG
+#
+#
+# DESCRIPTION
+# ===========
+#
+# Simple job for SET TESTS for NEMO (SETTE)
+# 
+#  
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./fcm_job.sh NUMBER_OF_PROCS JOB_FILE INTERACT MPI_FLAG
+#
+#  run a 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+#
+
+usage=" Usage : ./fcm_job.sh  NUMBER_OF_PROCS JOB_FILE INTERACT MPI_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=$3
+export MPI_FLAG=$4
+################################################################
+# RUN OPA
+cd ${EXE_DIR}
+if [ "$INTERACT" == "yes" ]; then
+        eval $JOB_FILE
+else if [ "$INTERACT" == "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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+amm12_inputs_v3_4.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12_PISCES.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12_PISCES.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_AMM12_PISCES.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+amm12_inputs_v3_4.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_GYRE.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_GYRE.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_GYRE.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.3.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_AGRIF.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_AGRIF.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_AGRIF.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+ORCA2_LIM_AGRIF_nemo_v3.3.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_LIM_PISCES.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+ORCA2_LIM_nemo_v3.3.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_ORCA2_OFF_PISCES.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+INPUTS_DYNA_v3.tar 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_POMME.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_POMME.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/input_POMME.cfg	(revision 3437)
@@ -0,0 +1,1 @@
+POMME_nemo_v3_3.tar
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/iodef_sette.xml
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/iodef_sette.xml	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/iodef_sette.xml	(revision 3437)
@@ -0,0 +1,551 @@
+<?xml version="1.0"?>
+<simulation> 
+  
+  <context id="nemo">
+    
+    <!-- $id$ -->
+
+    <!-- 
+============================================================================================================
+=                                  definition of all existing variables                                    =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <field_definition level="1" prec="4" operation="ave(X)" enabled=".TRUE."> <!-- time step automaticaly defined -->
+
+      <!-- T grid -->
+      
+      <group id="grid_T" axis_ref="none" grid_ref="grid_T">
+	<field id="toce"         description="temperature"                               unit="degC" axis_ref="deptht"   />
+       	<field id="soce"         description="salinity"                                  unit="psu"  axis_ref="deptht"   />
+	<field id="sst"          description="sea surface temperature"                   unit="degC"                     />
+	<field id="sst2"         description="square of sea surface temperature"         unit="degC2"                    />
+	<field id="sstgrad"      description="module of sst gradient"                    unit="degC/m"                   />
+	<field id="sstgrad2"     description="square of module of sst gradient"          unit="degC2/m2"                 />
+	<field id="sss"          description="sea surface salinity"                      unit="psu"                      />
+	<field id="sss2"         description="square of sea surface salinity"            unit="psu2"                     />
+	<field id="ssh"          description="sea surface height"                        unit="m"                        />
+	<field id="ssh2"         description="square of sea surface height"              unit="m2"                       />
+	<field id="mldkz5"       description="mixing layer depth (Turbocline)"           unit="m"                        />
+	<field id="mldr10_1"     description="Mixed Layer Depth 0.01 ref.10m"            unit="m"                        />
+       	<field id="rhop"         description="potential density (sigma0)"                unit="kg/m3" axis_ref="deptht"  />
+	<!-- next variables available with key_diahth -->
+	<field id="mlddzt"       description="Thermocline Depth (max dT/dz)"             unit="m"                        />
+	<field id="mldr10_3"     description="Mixed Layer Depth dr=0.03 (ref.10m)"       unit="m"                        />
+	<field id="mldr0_1"      description="Mixed Layer Depth dr=0.01 (ref.surf)"      unit="m"                        />
+	<field id="mldr0_3"      description="Mixed Layer Depth dr=0.03 (ref.surf)"      unit="m"                        />
+	<field id="mld_dt02"     description="Mixed Layer Depth |dt|=0.2 (ref.10m)"      unit="m"                        />
+	<field id="topthdep"     description="Top of the thermocline dt=-0.2 (ref.10m)"  unit="m"                        />
+	<field id="pycndep"      description="Pycnocline depth dr~dt=-0.2 (ref.10m)"     unit="m"                        />
+	<field id="BLT"          description="Barrier Layer Thickness"                   unit="m"                        />
+	<field id="tinv"         description="Max of vertical invertion of temperature"  unit="degC"                     />
+	<field id="depti"        description="Depth of max. vert. inv. of temperature"   unit="m"                        />
+        <field id="20d"          description="Depth of 20C isotherm"                     unit="m"                        />
+	<field id="28d"          description="Depth of 28C isotherm"                     unit="m"                        />
+	<field id="hc300"        description="Heat content 300 m"                        unit="W"                        />
+	<!-- variables available with key_diaar5 -->
+	<field id="botpres"      description="Pressure at sea floor"                     unit="dbar"                     />
+	<field id="cellthc"      description="Cell thickness"                            unit="m"     axis_ref="deptht"  />
+     </group>
+
+      <!-- SBC -->
+      
+      <group id="SBC" axis_ref="none" grid_ref="grid_T" > <!-- time step automaticaly defined based on nn_fsbc -->
+
+	<field id="empmr"        description="Net Upward Water Flux"                                        unit="kg/m2/s"  />
+	<field id="empsmr"       description="concentration/dilution water flux"                            unit="kg/m2/s"  />
+	<field id="snowpre"      description="Snow precipitation"                                           unit="kg/m2/s"  />
+	<field id="runoffs"      description="River Runoffs"                                                unit="Kg/m2/s"  />
+
+	<field id="qt"           description="Net Downward Heat Flux"                                       unit="W/m2"     />
+	<field id="qns"          description="non solar Downward Heat Flux"                                 unit="W/m2"     />
+	<field id="qsr"          description="Shortwave Radiation"                                          unit="W/m2"     />
+	<field id="qsr3d"        description="Shortwave Radiation 3D distribution"        axis_ref="deptht" unit="W/m2"     />
+	<field id="qrp"          description="Surface Heat Flux: Damping"                                   unit="W/m2"     />
+	<field id="erp"          description="Surface Water Flux: Damping"                                  unit="Kg/m2/s"  />
+	<field id="taum"         description="wind stress module"                                           unit="N/m2"     />
+	<field id="wspd"         description="Wind speed module at 10 m"                                    unit="m/s"      />
+
+        <!-- * variable relative to atmospheric pressure forcing : available with ln_apr_dyn -->
+        <field id="ssh_ib"       description="Inverse barometer sea surface height"                         unit="m"        />
+	
+	<!-- *_oce variables available with ln_blk_clio or ln_blk_core -->
+	<field id="qns_oce"      description="Non solar Downward Heat Flux over open ocean"                 unit="W/m2"     />
+	<field id="qlw_oce"      description="Longwave Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qsb_oce"      description="Sensible Downward Heat Flux over open ocean"                  unit="W/m2"     />
+	<field id="qla_oce"      description="Latent Downward Heat Flux over open ocean"                    unit="W/m2"     />
+	<field id="taum_oce"     description="wind stress module over open ocean"                           unit="N/m2"     />
+
+	<field id="ice_cover"    description="Ice fraction"                                                 unit="1"        />
+
+	<field id="ioceflxb"     description="Oceanic flux at the ice base"                                 unit="W/m2"     />
+	<field id="qsr_ai_cea"   description="Air-Ice downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_ai_cea"   description="Air-Ice downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	<field id="qla_ai_cea"   description="Air-Ice downward Latent heat flux (cell average)"             unit="W/m2"     />
+	
+	<field id="qsr_io_cea"   description="Ice-Oce downward solar heat flux (cell average)"              unit="W/m2"     />
+	<field id="qns_io_cea"   description="Ice-Oce downward non-solar heat flux (cell average)"          unit="W/m2"     />
+	
+	<field id="snowthic_cea" description="Snow thickness (cell average)"                                unit="m"        />
+	<field id="icethic_cea"  description="Ice thickness (cell average)"                                 unit="m"        />
+	<field id="iceprod_cea"  description="Ice production (cell average)"                                unit="m/s"      />
+	
+	<field id="ice_pres"     description="Ice presence"                                                 unit="-"        />
+	<field id="ist_cea"      description="Ice surface temperature (cell average)"                       unit="degC"     />
+	<field id="ist_ipa"      description="Ice surface temperature (ice presence average)"               unit="degC"     />      
+	<field id="uice_ipa"     description="Ice velocity along i-axis at I-point (ice presence average)"  unit="m/s"      />      
+	<field id="vice_ipa"     description="Ice velocity along j-axis at I-point (ice presence average)"  unit="m/s"      />      
+	
+	<field id="utau_ice"     description="Wind stress along i-axis over the ice at i-point"             unit="N/m2"     />
+	<field id="vtau_ice"     description="Wind stress along j-axis over the ice at i-point"             unit="N/m2"     />
+	
+	<field id="u_imasstr"    description="Sea-ice mass transport along i-axis"                          unit="kg/s"     />
+	<field id="v_imasstr"    description="Sea-ice mass transport along j-axis"                          unit="kg/s"     />
+
+	<!-- available key_coupled -->
+	<field id="snow_ao_cea"  description="Snow over ice-free ocean (cell average)"                      unit="kg/m2/s"  />
+	<field id="snow_ai_cea"  description="Snow over sea-ice (cell average)"                             unit="kg/m2/s"  />
+	<field id="subl_ai_cea"  description="Sublimation over sea-ice (cell average)"                      unit="kg/m2/s"  />
+	<field id="icealb_cea"   description="Ice albedo (cell average)"                                    unit="1"        />
+	<field id="calving"      description="Calving"                                                      unit="kg/m2/s"  />
+	<!-- available if key_coupled + conservative method -->
+	<field id="rain"         description="Liquid precipitation"                                         unit="Kg/m2/s"  />
+	<field id="evap_ao_cea"  description="Evaporation over ice-free ocean (cell average)"               unit="kg/m2/s"  />
+	<!-- variables available with key_diaar5 -->
+	<field id="isnwmlt_cea"   description="Snow over Ice melting (cell average)"                        unit="kg/m2/s"  />
+	<field id="fsal_virt_cea" description="Virtual salt flux due to ice formation (cell average)"       unit="kg/m2/s"  />
+	<field id="fsal_real_cea" description="Real salt flux due to ice formation (cell average)"          unit="kg/m2/s"  />
+	<field id="hflx_rain_cea" description="heat flux due to rainfall"                                   unit="W/m2"     />
+	<field id="hflx_evap_cea" description="heat flux due to evaporation"                                unit="W/m2"     />
+	<field id="hflx_snow_cea" description="heat flux due to snow falling over ice-free ocean"           unit="W/m2"     />
+	<field id="hflx_ice_cea"  description="heat flux due to ice thermodynamics"                         unit="W/m2"     />
+	<field id="hflx_rnf_cea"  description="heat flux due to runoffs"                                    unit="W/m2"     />
+	<field id="hflx_cal_cea"  description="heat flux due to calving"                                    unit="W/m2"     />
+	<field id="bicemel_cea"  description="Rate of Melt at Sea Ice Base (cell average)"                  unit="kg/m2/s"  />
+	<field id="licepro_cea"  description="Lateral Sea Ice Growth Rate (cell average)"                   unit="kg/m2/s"  />
+	<field id="snowmel_cea"  description="Snow Melt Rate (cell average)"                                unit="kg/m2/s"  />
+	<field id="sntoice_cea"  description="Snow-Ice Formation Rate (cell average)"                       unit="kg/m2/s"  />
+	<field id="ticemel_cea"  description="Rate of Melt at Upper Surface of Sea Ice (cell average)"      unit="kg/m2/s"  />
+
+      </group>
+
+      <!-- U grid -->
+      
+      <group id="grid_U"  axis_ref="depthu" grid_ref="grid_U">
+	<field id="utau"         description="Wind Stress along i-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="uoce"         description="ocean current along i-axis"                  unit="m/s"                  />
+	<field id="uocetr_eff"   description="Effective ocean transport along i-axis"      unit="m3/s"                  />
+	<!-- uoce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="uoce_eiv"     description="EIV ocean current along i-axis"              unit="m/s"                  />
+	<!-- uoce_eiv: available with key_trabbl -->
+	<field id="uoce_bbl"     description="BBL ocean current along i-axis"              unit="m/s"  axis_ref="none" />
+	<field id="ahu_bbl"      description="BBL diffusive flux along i-axis"             unit="m3/s" axis_ref="none" />
+ 	<!-- variables available with key_diaar5 -->
+	<field id="u_masstr"     description="ocean eulerian mass transport along i-axis"  unit="kg/s"                 />
+	<field id="u_heattr"     description="ocean eulerian heat transport along i-axis"  unit="W"    axis_ref="none" />
+	<field id="ueiv_heattr"  description="ocean bolus heat transport along i-axis"     unit="W"    axis_ref="none" />
+	<field id="udiff_heattr" description="ocean diffusion heat transport along i-axis" unit="W"    axis_ref="none" />
+     </group>
+      
+      <!-- V grid -->
+      
+      <group id="grid_V"  axis_ref="depthv" grid_ref="grid_V">
+	<field id="vtau"         description="Wind Stress along j-axis"                    unit="N/m2" axis_ref="none" />
+	<field id="voce"         description="ocean current along j-axis"                  unit="m/s"                  />
+	<field id="vocetr_eff"   description="Effective ocean transport along j-axis"      unit="m3/s"                  />
+	<!-- voce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="voce_eiv"     description="EIV ocean current along j-axis"              unit="m/s"                  />
+	<!-- voce_eiv: available with key_trabbl -->
+	<field id="voce_bbl"     description="BBL ocean current along j-axis"              unit="m/s" axis_ref="none"  />
+	<field id="ahv_bbl"      description="BBL diffusive flux along j-axis"             unit="m3/s" axis_ref="none" />
+	<!-- variables available with key_diaar5 -->
+	<field id="v_masstr"     description="ocean eulerian mass transport along j-axis"  unit="kg/s"                 />
+	<field id="v_heattr"     description="ocean eulerian heat transport along j-axis"  unit="W"    axis_ref="none" />
+	<field id="veiv_heattr"  description="ocean bolus heat transport along j-axis"     unit="W"    axis_ref="none" />
+	<field id="vdiff_heattr" description="ocean diffusion heat transport along j-axis" unit="W"    axis_ref="none" />
+      </group>
+      
+      <!-- W grid -->
+      
+      <group id="grid_W"  axis_ref="depthw" grid_ref="grid_W">
+	<field id="woce"         description="ocean vertical velocity"                     unit="m/s"                  />
+	<field id="wocetr_eff"   description="effective ocean vertical transport"          unit="m3/s"                 />
+	<!-- woce_eiv: available with key_traldf_eiv and key_diaeiv -->
+	<field id="woce_eiv"     description="EIV ocean vertical velocity"                 unit="m/s"                  />
+	<!-- woce_eiv: available with key_trabbl_adv -->
+	<field id="avt"          description="vertical eddy diffusivity"                   unit="m2/s"                 />
+	<field id="avm"          description="vertical eddy viscosity"                     unit="m2/s"                 />
+	<!-- avs: available with key_zdfddm -->
+	<field id="avs"          description="salt vertical eddy diffusivity"              unit="m2/s"                 />
+	<!-- avt_evd and avm_evd: available with ln_zdfevd -->
+	<field id="avt_evd"      description="enhanced vertical diffusivity"               unit="m2/s"                 />
+	<field id="avm_evd"      description="enhanced vertical viscosity"                 unit="m2/s"                 />
+	<!-- aht2d and  aht2d_eiv: available with key_traldf_eiv and key_traldf_c2d -->
+	<field id="aht2d"        description="lateral eddy diffusivity"                    unit="m2/s" axis_ref="none" />
+	<field id="aht2d_eiv"    description="EIV lateral eddy diffusivity"                unit="m2/s" axis_ref="none" />
+	<!-- avt_tide: available with key_zdftmx -->
+	<field id="av_tide"      description="tidal vertical diffusivity"                  unit="m2/s"                 />
+	<!-- variables available with key_diaar5 -->   
+	<field id="w_masstr"     description="vertical mass trasport"                      unit="kg/s"                 />
+	<field id="w_masstr2"    description="square of vertical mass trasport"            unit="kg2/s2"               />
+      </group>
+          
+      <!-- scalar -->
+      
+      <!-- variables available with key_diaar5 -->
+      <group id="scalar" axis_ref="none" grid_ref="scalarpoint" zoom_ref="1point" >
+	<field id="voltot"     description="global mean volume"                         unit="m3"   />
+	<field id="sshtot"     description="global mean ssh"                            unit="m"    />
+	<field id="sshsteric"  description="global mean ssh steric"                     unit="m"    />
+	<field id="sshthster"  description="global mean ssh thermosteric"               unit="m"    />
+	<field id="masstot"    description="global mean mass"                           unit="kg"   />
+	<field id="temptot"    description="global mean temperature"                    unit="degC" />
+	<field id="saltot"     description="global mean salinity"                       unit="psu"  />
+	<field id="fram_trans" description="Sea Ice Mass Transport Through Fram Strait" unit="kg/s" />
+      </group>
+         
+      <!-- ptrc on T grid -->
+
+     <group id="ptrc_T" axis_ref="deptht" grid_ref="grid_T">  
+       <field id="DIC"      description="Dissolved inorganic Concentration"        unit="molC/L"     />
+       <field id="Alkalini" description="Total Alkalinity Concentration"           unit="eq/L"       />
+       <field id="O2"       description="Oxygen Concentration"                     unit="molO2/L"    />
+       <field id="CaCO3"    description="Calcite Concentration"                    unit="molC/L"     />
+       <field id="PO4"      description="Phosphate Concentration"                  unit="molC/L"     />
+       <field id="POC"      description="Small organic carbon Concentration"       unit="molC/L"     />
+       <field id="Si"       description="Silicate Concentration"                   unit="molSi/L"    />
+       <field id="PHY"      description="Nanophytoplankton Concentration"          unit="molC/L"     />
+       <field id="ZOO"      description="Microzooplankton Concentration"           unit="molC/L"     />
+       <field id="DOC"      description="Dissolved organic Concentration"          unit="molC/L"     />
+       <field id="PHY2"     description="Diatoms Concentration"                    unit="molC/L"     />
+       <field id="ZOO2"     description="Mesozooplankton Concentration"            unit="molC/L"     />
+       <field id="BSi"      description="Diatoms Silicate Concentration"           unit="molC/L"     />
+       <field id="Fer"      description="Dissolved Iron Concentration"             unit="molFe/L"    />
+       <field id="BFe"      description="Big iron particles Concentration"         unit="molFe/L"    />
+       <field id="GOC"      description="Big organic carbon Concentration"         unit="molC/L"     />
+       <field id="SFe"      description="Small iron particles Concentration"       unit="molFe/L"    />
+       <field id="DFe"      description="Diatoms iron  Concentration"              unit="molFe/L"    />
+       <field id="DSi"      description="Sinking biogenic Silicate Concentration"  unit="molC/L"     />
+       <field id="NFe"      description="Nano iron Concentration"                  unit="molC/L"     />
+       <field id="NCHL"     description="Nano chlorophyl Concentration"            unit="gChl/L"     />
+       <field id="DCHL"     description="Diatoms chlorophyl Concentration"         unit="gChl/L"     />
+       <field id="NO3"      description="Nitrates Concentration"                   unit="molC/L"     />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="molC/L"     />
+       <field id="DET"      description="Detritus"                                 unit="mmole-N/m3" />
+       <field id="ZOO"      description="Zooplankton Concentration"                unit="mmole-N/m3" />
+       <field id="PHY"      description="Phytoplankton Concentration"              unit="mmole-N/m3" />
+       <field id="NO3"      description="Nitrate Concentration"                    unit="mmole-N/m3" />
+       <field id="NH4"      description="Ammonium Concentration"                   unit="mmole-N/m3" />
+       <field id="DOM"      description="Dissolved Organic Matter"                 unit="mmole-N/m3" />
+
+     </group>
+
+      <!-- diad on T grid : variables available with key_diatrc -->
+
+     <group id="diad_T" axis_ref="none" grid_ref="grid_T">
+       <field id="PH"          description="PH"                                       unit="-"           axis_ref="deptht" />
+       <field id="CO3"         description="Bicarbonates"                             unit="mol/L"       axis_ref="deptht" />
+       <field id="CO3sat"      description="CO3 saturation"                           unit="mol/L"       axis_ref="deptht" />
+       <field id="PAR"         description="Photosynthetically Available Radiation"   unit="W/m2"        axis_ref="deptht" />
+       <field id="PPPHY"       description="Primary production of nanophyto"          unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPPHY2"      description="Primary production of diatoms"            unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWN"      description="New Primary production of nanophyto"      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PPNEWD"      description="New Primary production of diatoms"        unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="PBSi"        description="Primary production of Si diatoms"         unit="molSi/m3/s"  axis_ref="deptht" />
+       <field id="PFeN"        description="Primary production of nano iron"          unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PFeD"        description="Primary production of diatoms iron"       unit="molFe/m3/s"  axis_ref="deptht" />
+       <field id="PCAL"        description="Calcite production"                       unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="DCAL"        description="Calcite dissolution"                      unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="GRAZ"        description="Grazing by zooplankton"                   unit="molC/m3/s"   axis_ref="deptht" />
+       <field id="Nfix"        description="Nitrogen fixation at surface"             unit="molN/m2/s"       />
+       <field id="EPC100"      description="Export of carbon particles at 100 m"      unit="molC/m2/s"       />
+       <field id="EPFE100"     description="Export of biogenic iron at 100 m"         unit="molFe/m2/s"      />
+       <field id="EPSI100"     description="Export of Silicate at 100 m"              unit="molSi/m2/s"      />
+       <field id="EPCAL100"    description="Export of Calcite at 100 m"               unit="molC/m2/s"       />
+       <field id="Cflx"        description="DIC flux"                                 unit="molC/m2/s"       />
+       <field id="Oflx"        description="Oxygen flux"                              unit="molC/m2/s"       />
+       <field id="Kg"          description="Gas transfer"                             unit="molC/m2/s/uatm"  />
+       <field id="Dpco2"       description="Delta CO2"                                unit="uatm"            />
+       <field id="Dpo2"        description="Delta O2"                                 unit="uatm"            />
+       <field id="Heup"        description="Euphotic layer depth"                     unit="m"               />
+       <field id="Irondep"     description="Iron deposition"                          unit="molFe/m2/s"      />
+       <field id="FNO3PHY"     description="FNO3PHY"                                  unit="-"           axis_ref="deptht" /> 
+       <field id="FNH4PHY"     description="FNH4PHY"                                  unit="-"           axis_ref="deptht" /> 
+       <field id="FNH4NO3"     description="FNH4NO3"                                  unit="-"           axis_ref="deptht" /> 
+       <field id="TNO3PHY"     description="TNO3PHY"                                  unit="-"  /> 
+       <field id="TNH4PHY"     description="TNH4PHY"                                  unit="-"  /> 
+       <field id="TPHYDOM"     description="TPHYDOM"                                  unit="-"  /> 
+       <field id="TPHYNH4"     description="TPHYNH4"                                  unit="-"  /> 
+       <field id="TPHYZOO"     description="TPHYZOO"                                  unit="-"  /> 
+       <field id="TPHYDET"     description="TPHYDET"                                  unit="-"  /> 
+       <field id="TDETZOO"     description="TDETZOO"                                  unit="-"  /> 
+       <field id="TDETSED"     description="TDETSED"                                  unit="-"  /> 
+       <field id="TZOODET"     description="TZOODET"                                  unit="-"  /> 
+       <field id="TZOOBOD"     description="TZOOBOD"                                  unit="-"  /> 
+       <field id="TZOONH4"     description="TZOONH4"                                  unit="-"  /> 
+       <field id="TZOODOM"     description="TZOODOM"                                  unit="-"  /> 
+       <field id="TNH4NO3"     description="TNH4NO3"                                  unit="-"  /> 
+       <field id="TDOMNH4"     description="TDOMNH4"                                  unit="-"  /> 
+       <field id="TDETNH4"     description="TDETNH4"                                  unit="-"  /> 
+       <field id="TPHYTOT"     description="TPHYTOT"                                  unit="-"  /> 
+       <field id="TZOOTOT"     description="TZOOTOT"                                  unit="-"  /> 
+       <field id="TDETDOM"     description="TDETDOM"                                  unit="-"  /> 
+       <field id="SEDPOC"      description="SEDPOC"                                   unit="-"  /> 
+     </group>
+       
+    </field_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           output files definition                                        =
+=                                            Define your own files                                         =
+=                                         put the variables you want...                                    =
+============================================================================================================
+    -->
+    
+    <file_definition >
+
+      <group id="1h" output_freq="3600"   output_level="10" enabled=".TRUE.">                      <!-- 1h files -->
+      </group>
+      
+      <group id="2h" output_freq="7200"   output_level="10" enabled=".TRUE.">                      <!-- 2h files -->
+      </group>
+      
+      <group id="3h" output_freq="10800"  output_level="10" enabled=".TRUE.">                      <!-- 3h files -->
+      </group>
+      
+      <group id="4h" output_freq="14400"  output_level="10" enabled=".TRUE.">                      <!-- 4h files -->
+      </group>
+      
+      <group id="6h" output_freq="21600"  output_level="10" enabled=".TRUE.">                      <!-- 6h files -->
+      </group>
+      
+      <group id="1d" output_freq="86400"  output_level="10" enabled=".TRUE.">                      <!-- 1d files -->
+      </group>
+      
+      <group id="3d" output_freq="259200" output_level="10" enabled=".TRUE.">                      <!-- 3d files -->
+      </group>
+      
+      <group id="5d" output_freq="432000" output_level="10" enabled=".TRUE.">                      <!-- 5d files -->
+      </group>
+      
+      <group id="1m" output_freq="-1"     output_level="10" enabled=".TRUE.">                      <!-- real monthly files -->
+      </group>
+
+      <group id="2m" output_freq="-2"     output_level="10" enabled=".TRUE.">                      <!-- real 2m files -->
+      </group>
+
+      <group id="3m" output_freq="-3"     output_level="10" enabled=".TRUE.">                      <!-- real 3m files -->
+      </group>
+
+      <group id="4m" output_freq="-4"     output_level="10" enabled=".TRUE.">                      <!-- real 4m files -->
+      </group>
+
+      <group id="6m" output_freq="-6"     output_level="10" enabled=".TRUE.">                      <!-- real 6m files -->
+      </group>
+
+      <group id="1y" output_freq="-12"    output_level="10" enabled=".TRUE.">                      <!-- real yearly files -->
+      </group>
+
+      <group id="2y"  output_freq="-24"   output_level="10" enabled=".TRUE.">                      <!-- real 2y files -->
+      </group>
+
+      <group id="5y"  output_freq="-60"   output_level="10" enabled=".TRUE.">                      <!-- real 5y files -->
+      </group>
+
+      <group id="10y" output_freq="-120"  output_level="10" enabled=".TRUE.">                      <!-- real 10y files -->
+      </group>
+
+    </file_definition>
+    
+    <!-- 
+============================================================================================================
+=                                           grid definition                                                =
+=                                            DO NOT CHANGE                                                 =
+============================================================================================================
+    -->
+    
+    <axis_definition>  
+      <axis id="deptht" description="Vertical T levels" unit="m" positive=".false." />
+      <axis id="depthu" description="Vertical U levels" unit="m" positive=".false." />
+      <axis id="depthv" description="Vertical V levels" unit="m" positive=".false." />
+      <axis id="depthw" description="Vertical W levels" unit="m" positive=".false." />
+      <axis id="none" description="axe non defini" unit="none" size="1" />
+    </axis_definition> 
+    
+    <grid_definition>
+      <grid id="grid_T" description="grid T" >
+    <!--   Eq section   -->
+        <zoom id="EqT" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+    <!--   TAO   -->
+      <!--   137e   -->
+        <zoom id="2n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n137eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   147e   -->
+        <zoom id="0n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n147eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   156e   -->
+        <zoom id="5s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n156eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   165e   -->
+        <zoom id="8s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n165eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   180w   -->
+        <zoom id="8s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n180wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   170w   -->
+        <zoom id="8s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n170wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   155w   -->
+        <zoom id="8s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n155wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   140w   -->
+        <zoom id="8s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n140wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   125w   -->
+        <zoom id="8s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n125wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   110w   -->
+        <zoom id="8s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n110wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95w   -->
+        <zoom id="8s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2s95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="2n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n95wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   RAMA   -->
+      <!--   55e   -->
+        <zoom id="16s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s55eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n55eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n55eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   65e   -->
+        <zoom id="15n65eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   67e   -->
+        <zoom id="16s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s67eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n67eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n67eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   80.5e   -->
+        <zoom id="16s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s80.5eT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4s80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5s80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n80.5eT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n80.5eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   90e   -->
+        <zoom id="1.5s90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="1.5n90eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n90eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n90eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   95e   -->
+        <zoom id="16s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12s95eT"    ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="5s95eT"     ibegin="0000" jbegin="0000" ni="1" nj="1" />
+    <!--   PIRATA   -->
+      <!--   38w-30w   -->
+        <zoom id="19s34wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="14s32wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8s30wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n35wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="8n38wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="15n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="20n38wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   23w   -->
+        <zoom id="0n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="4n23wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="12n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="21n23wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   10w   -->
+        <zoom id="10s10wT" ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="6s10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+        <zoom id="0n10wT"  ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      <!--   0e   -->
+        <zoom id="0n0eT"   ibegin="0000" jbegin="0000" ni="1" nj="1" />
+      </grid>
+
+      <grid id="grid_U" description="grid U" >
+    <!--   Eq section   -->
+        <zoom id="EqU" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="grid_V" description="grid V" >
+      </grid>
+
+      <grid id="grid_W" description="grid W" >
+    <!--   Eq section   -->
+        <zoom id="EqW" ibegin="1" jbegin="0000" ni="0000" nj="1" />
+      </grid>
+
+      <grid id="scalarpoint" description="scalar" >
+        <zoom id="1point" ibegin="1" jbegin="1" ni="1" nj="1" />
+      </grid>
+
+
+    </grid_definition>    
+    
+  </context>
+  
+</simulation>
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/param.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/param.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/param.cfg	(revision 3437)
@@ -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
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_exe_dir.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_exe_dir.sh	(revision 3437)
@@ -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 -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.
+cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml
+cd ${EXE_DIR}
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_job.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_job.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/prepare_job.sh	(revision 3437)
@@ -0,0 +1,209 @@
+#####################################################
+# Author : Italo Epicoco for NEMO
+# Contact : italo.epicoco@unisalento.it
+#
+# Some scripts called by sette.sh 
+# prepare_job.sh   : create the job script for running job 
+######################################################
+#set -vx
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# prepare_job.sh
+# ================
+#
+# --------------------------
+# create 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"
+usage=" example : ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg 8 SHORT no/yes $JOB_FILE"
+
+
+minargcount=5
+        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
+
+# export EXE_DIR. This directory is used to execute model 
+#
+export EXE_DIR
+#
+#
+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 ${SETTE_DIR}/../CONFIG/${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
+tar_file=$(sed -ne "1,1p" ${SETTE_DIR}/$INPUTARFILE)
+if [ "$(cat ${SETTE_DIR}/$INPUTARFILE | grep -c ".tar" )" -ne 0 ] ; then
+	echo "looking for tar file" >> ${SETTE_DIR}/output.sette
+	echo "            " >> ${SETTE_DIR}/output.sette
+	cp ${FORCING_DIR}/${tar_file} ${INPUT_DIR}/.
+	echo "file in ${INPUT_DIR}"
+	if [ ! -f ${INPUT_DIR}/${tar_file} ] ; then 
+		echo "PROBLEM during copy of tar file" >> ${SETTE_DIR}/output.sette
+		echo "tar file IS NOT present in ${INPUT_DIR} directory " >> ${SETTE_DIR}/output.sette
+		echo "            " >> ${SETTE_DIR}/output.sette
+		echo "PROBLEM during copy of tar file" 
+		exit 1
+	else  
+		cd ${EXE_DIR} ; tar xvof ${INPUT_DIR}/*.tar ; gunzip -f *gz
+	fi
+fi 
+
+if [ ! -f ${EXE_DIR}/namelist_ice ] ; then 
+if [ -f ${EXE_DIR}/namelist_ice_lim2 ] ; then 
+   echo "choosing for namelist ice " >> ${SETTE_DIR}/output.sette
+   echo "            " >> ${SETTE_DIR}/output.sette
+   cp ${EXE_DIR}/namelist_ice_lim2 ${EXE_DIR}/namelist_ice
+elif  [ -f ${EXE_DIR}/namelist_ice_lim3 ] ; then 
+   cp ${EXE_DIR}/namelist_ice_lim3 ${EXE_DIR}/namelist_ice
+fi
+fi
+
+
+if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "agrif" )" -ne 0 ] ; then
+	#- Namelist for ocean and ice (agrif fine grid)
+   	echo "choosing for namelist for AGRIF" >> ${SETTE_DIR}/output.sette
+   	echo "            " >> ${SETTE_DIR}/output.sette
+	cp ${EXE_DIR}/1_namelist_ice_lim2 ${EXE_DIR}/1_namelist_ice 
+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 Altix system using PBS batch submission (requires ${SETTE_DIR}/sette_batch_template file)
+#
+  #  if [ ${MPI_FLAG} == "no" ] ; then
+		case ${COMPILER} in 
+			ALTIX_NAUTILUS_MPT)
+                                NB_REM=$( echo $NB_PROC | awk '{print $1 % 4}')
+		        	if [ ${NB_REM} == 0 ] ; then
+					# number of processes required is an integer multiple of 4
+					#
+					NB_NODES=$( echo $NB_PROC | awk '{print $1 / 4}')
+				else
+					#
+					# number of processes required is not an integer multiple of 4
+					# round up the number of nodes required.
+					#
+					NB_NODES=$( echo $NB_PROC | awk '{printf("%d",$1 / 4 + 1 )}')
+	       			fi
+				;;
+			*)
+				NB_NODES=${NB_PROC}
+				;;
+
+		esac
+#
+# Pass settings into job file by using sed to edit predefined strings
+#
+        cat ${SETTE_DIR}/job_batch_template | sed -e"s/NODES/${NB_NODES}/" -e"s/NPROCS/${NB_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
+	
+#
+# 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh	(revision 3437)
@@ -0,0 +1,668 @@
+#!/bin/bash
+#############################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# 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 -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# sette.sh
+# ================
+#
+# ----------------------------------------------
+# Set of tests for NEMO
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./sette.sh
+#
+# DESCRIPTION
+# ===========
+#
+# Variables to be checked by user:
+#
+# COMPILER : name of compiler as defined in NEMOGCM/ARCH directory 
+#
+# BATCH_COMMAND :  name of the command for batch submission
+#
+# MPI_INTERACT :  
+#
+#         for MPP tests, "no" for batch execution, "yes" for interactive execution 
+#
+#         NOTE: for run with 1 process tests are run always in MPI_INTERACT="yes"
+#
+# Principal script is sette.sh, that calls 
+#
+#  makenemo 
+#
+#   creates the exectuable in ${CONFIG_NAME}/BLD/bin/nemo.exe  (and its link 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 set namelist parameters for tests
+#
+#   post_test_tidyup : creates validation storage directory and copy needed output files (solver.stat and ocean.output) in it after execution of test.
+#
+#   Tree of VALIDATION 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 in 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 
+#
+#   runs job in interactive or batch mode : all jobs using 1 process are run interactive, and all MPP jobs are
+#
+#   run in batch (MPI_INTERACT="no") or interactive (MPI_INTERACT="yes") see sette.sh and BATCH_TEMPLATE directory
+#
+#   (note this job needs to have an input_CONFIG.cfg in which can be found input tar file)
+# 
+#  NOTE: if job is not launched for some problems you have executable ready in ${EXE_DIR} directory
+#
+#  NOTE: the changed namelists are leaved in ${EXE_DIR} directory whereas original namelist remains in ${NEW_CONF}/EXP00
+# 
+#  in ${SETTE_DIR} is created output.sette with the echo of executed commands
+#
+#  if sette.sh is stopped in output.sette there is written the last command executed by sette.sh
+#
+#  if you run: ./sette.sh 2>&1 | tee out.sette
+#
+#  in ${SETTE_DIR} out.sette is redirected standard error & standard output
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./sette.sh 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#   * creation
+#
+#-
+#
+#-
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=PW6_VARGAS
+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
+cd ${SETTE_DIR}
+cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+
+for config in 1 2 3 4 5 6 7 8 9
+do
+
+# TESTS FOR GYRE_LOBSTER CONFIGURATION
+if [ ${config} -eq 1 ] ;  then
+    ## Restartability tests for GYRE_LOBSTER
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRELOB_LONG -r GYRE_LOBSTER -j 8  
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=1
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 120
+    set_namelist namelist nn_stock 60
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE $INTERACT_FLAG $MPIRUN_FLAG
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_SHORT\"
+    set_namelist namelist nn_it000 61
+    set_namelist namelist nn_itend 120
+    set_namelist namelist nn_stock 60
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    ln -s -f ..\/LONG\/GYRELOB_LONG_00000060_restart.nc
+    ln -s -f ..\/LONG\/GYRELOB_LONG_00000060_restart_trc.nc
+    set_namelist namelist cn_ocerst_in \"GYRELOB_LONG_00000060_restart\"
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"GYRELOB_LONG_00000060_restart_trc\"
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+fi
+
+if [ ${config} -eq 2 ] ;  then
+    ## Reproducibility tests for GYRE_LOBSTER
+    export TEST_NAME="REPRO_1_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRELOB_4 -r GYRE_LOBSTER -j 8 add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_14\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 60
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist nn_bench 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist jpni 1
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 4
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_2"
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=4
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_22\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 60
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_GYRE.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+fi
+
+# TESTS FOR ORCA2_LIM_PISCES CONFIGURATION
+if [ ${config} -eq 3 ] ;  then
+    ## Restartability tests for ORCA2_LIM_PISCES
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2LIMPIS_LONG -r ORCA2_LIM_PISCES -j 8
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=1
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"O2LP_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 150
+    set_namelist namelist nn_stock 75
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE    
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+#
+    export TEST_NAME="SHORT"
+    cd ${SETTE_DIR}
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"O2LP_SHORT\"
+    set_namelist namelist nn_it000 76
+    set_namelist namelist nn_itend 150
+    set_namelist namelist nn_stock 75
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    ln -s -f ../LONG/O2LP_LONG_00000075_restart.nc
+    ln -s -f ../LONG/O2LP_LONG_00000075_restart_ice.nc
+    ln -s -f ../LONG/O2LP_LONG_00000075_restart_trc.nc
+    set_namelist namelist cn_ocerst_in \"O2LP_LONG_00000075_restart\"
+    set_namelist namelist_ice cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"O2LP_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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE $INTERACT_FLAG $MPIRUN_FLAG 
+fi
+
+if [ ${config} -eq 4 ] ;  then
+    ## Reproducibility tests for ORCA2_LIM_PISCES
+    export TEST_NAME="REPRO_4_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2LIMPIS_16 -r ORCA2_LIM_PISCES -j 8 add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 16
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    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
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 16
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_LIM_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    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 ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_LONG -r ORCA2_OFF_PISCES -j 8 
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=1
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"OFFP_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist nn_stock 20
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"OFFP_SHORT\"
+    set_namelist namelist nn_it000 21
+    set_namelist namelist nn_itend 40
+    set_namelist namelist nn_stock 20
+    set_namelist namelist ln_clobber .true.
+    ln -s ../LONG/OFFP_LONG_00000020_restart_trc.nc .
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"OFFP_LONG_00000020_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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    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_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_16 -r ORCA2_OFF_PISCES -j 8 add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=16
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 16
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    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
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 16
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_OFF_PISCES.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+fi
+
+# TESTS FOR AMM12 CONFIGURATION
+if [ ${config} -eq 7 ] ;  then
+    ## Reproducibility tests for AMM12
+    export TEST_NAME="REPRO_8_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_32 -r AMM12 -j 8 add_key "key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 576
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    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
+    NPROC=32
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 576
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE $INTERACT_FLAG $MPIRUN_FLAG
+fi
+
+if [ ${config} -eq 8 ] ;  then
+    ## Restartability tests for AMM12
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=32
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 12
+    set_namelist namelist nn_stock 6
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 7
+    set_namelist namelist nn_itend 12
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    set_namelist namelist cn_ocerst_in \"../LONG/AMM12_00000006_restart\"
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_AMM12.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE $INTERACT_FLAG $MPIRUN_FLAG 
+fi
+
+# TEST FOR ORCA2_LIM_AGRIF : simple test of running AGRIF (no restartability neither reproducibility tests)
+if [ ${config} -eq 9 ] ;  then
+    ## ORCA2_LIM with Agulhas AGRIF zoom in MPI
+    export TEST_NAME="SHORT"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL_1_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_mpp_mpi key_agrif" del_key "key_zdftmx"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    JOB_FILE=${EXE_DIR}/run_job.sh
+    NPROC=2
+    \rm $JOB_FILE
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 1
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 2
+    set_namelist 1_namelist nn_it000 1
+    set_namelist 1_namelist nn_itend 150
+    set_namelist 1_namelist ln_ctl .false.
+    set_namelist 1_namelist ln_clobber .true.
+    cd ${SETTE_DIR}
+   cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+    . ./prepare_job.sh input_ORCA2_LIM_AGRIF.cfg $NPROC ${TEST_NAME} $MPIRUN_FLAG $JOB_FILE
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh $NPROC $JOB_FILE  $INTERACT_FLAG $MPIRUN_FLAG
+fi
+
+done
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh.vargas
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh.vargas	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette.sh.vargas	(revision 3437)
@@ -0,0 +1,593 @@
+#!/bin/bash
+#############################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# 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 -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ================
+# sette.sh
+# ================
+#
+# ----------------------------------------------
+# Set of tests for NEMO
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./sette.sh
+#
+# DESCRIPTION
+# ===========
+#
+# Variables to be checked by user:
+#
+# COMPILER : name of compiler as defined in NEMOGCM/ARCH directory 
+#
+# BATCH_COMMAND :  name of the command for batch submission
+#
+# MPI_INTERACT :  
+#
+#         for MPP tests, "no" for batch execution, "yes" for interactive execution 
+#
+#         NOTE: for run with 1 process tests are run always in MPI_INTERACT="yes"
+#
+# Principal script is sette.sh, that calls 
+#
+#  makenemo 
+#
+#   creates the exectuable in ${CONFIG_NAME}/BLD/bin/nemo.exe  (and its link 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 set namelist parameters for tests
+#
+#   post_test_tidyup : creates validation storage directory and copy needed output files (solver.stat and ocean.output) in it after execution of test.
+#
+#   Tree of VALIDATION 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 in every test in sette.sh
+#
+#       ( each test in executed in its own directory )
+#
+#
+#  fcm_job.sh 
+#
+#   runs job in interactive or batch mode : all jobs using 1 process are run interactive, and all MPP jobs are
+#
+#   run in batch (MPI_INTERACT="no") or interactive (MPI_INTERACT="yes") see sette.sh and BATCH_TEMPLATE directory
+#
+#   (note this job needs to have an input_CONFIG.cfg in which can be found input tar file)
+# 
+#  NOTE: if job is not launched for some problems you have executable ready in ${EXE_DIR} directory
+#
+#  NOTE: the changed namelists are leaved in ${EXE_DIR} directory whereas original namelist remains in ${NEW_CONF}/EXP00
+# 
+#  in ${SETTE_DIR} is created output.sette with the echo of executed commands
+#
+#  if sette.sh is stopped in output.sette there is written the last command executed by sette.sh
+#
+#  if you run: ./sette.sh 2>&1 | tee out.sette
+#
+#  in ${SETTE_DIR} out.sette is redirected standard error & standard output
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./sette.sh 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: sette.sh 2890 2011-10-06 11:03:48Z flavoni $
+#
+#   * creation
+#
+#-
+#
+#-
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=PW6_VARGAS
+export BATCH_COMMAND=llsubmit
+export MPI_INTERACT="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
+cd ${SETTE_DIR}
+cp BATCH_TEMPLATE/batch-${COMPILER} job_batch_template || exit
+
+for config in 1 2 3 4 5 6 7 8
+do
+
+# TESTS FOR GYRE_LOBSTER CONFIGURATION
+if [ ${config} -eq 1 ] ;  then
+    ## Restartability tests for GYRE_LOBSTER
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRELOB_LONG -r GYRE_LOBSTER add_key "key_mpp_mpi key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 120
+    set_namelist namelist nn_stock 60
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_GYRE.cfg 4 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_SHORT\"
+    set_namelist namelist nn_it000 61
+    set_namelist namelist nn_itend 120
+    set_namelist namelist nn_stock 60
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    cp ..\/LONG\/GYRELOB_LONG_00000060_restart*.nc .
+    set_namelist namelist cn_ocerst_in \"GYRELOB_LONG_00000060_restart\"
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"GYRELOB_LONG_00000060_restart_trc\"
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_GYRE.cfg 4 ${TEST_NAME}
+fi
+
+if [ ${config} -eq 2 ] ;  then
+    ## Repropducibility tests for GYRE_LOBSTER
+    export TEST_NAME="REPRO_1_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n GYRELOB_4 -r GYRE_LOBSTER add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_14\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 60
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist nn_bench 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist jpni 1
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 4
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_GYRE.cfg 4 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_2"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"GYRELOB_22\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 60
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_GYRE.cfg 4 ${TEST_NAME}
+fi
+
+# TESTS FOR ORCA2_LIM_PISCES CONFIGURATION
+if [ ${config} -eq 3 ] ;  then
+    ## Restartability tests for ORCA2_LIM_PISCES
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2LIMPIS_LONG -r ORCA2_LIM_PISCES -j 8 add_key "key_mpp_mpi key_mpp_rep" 
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"O2LP_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 150
+    set_namelist namelist nn_stock 75
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_LIM_PISCES.cfg 4 ${TEST_NAME}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"O2LP_SHORT\"
+    set_namelist namelist nn_it000 76
+    set_namelist namelist nn_itend 150
+    set_namelist namelist nn_stock 75
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    set_namelist namelist nn_solv 2
+    cp ../LONG/O2LP_LONG_00000075_restart*nc .
+    set_namelist namelist cn_ocerst_in \"O2LP_LONG_00000075_restart\"
+    set_namelist namelist_ice cn_icerst_in \"O2LP_LONG_00000075_restart_ice\"
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"O2LP_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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_LIM_PISCES.cfg 4 ${TEST_NAME}
+fi
+
+if [ ${config} -eq 4 ] ;  then
+    ## Repropducibility tests for ORCA2_LIM_PISCES
+    export TEST_NAME="REPRO_4_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2LIMPIS_16 -r ORCA2_LIM_PISCES -j 8 add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 16
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_LIM_PISCES.cfg 16 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_8"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 16
+    set_namelist namelist nn_solv 2
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_LIM_PISCES.cfg 16 ${TEST_NAME}
+fi
+
+# TESTS FOR ORCA2_OFF_PISCES CONFIGURATION
+if [ ${config} -eq 5 ] ;  then
+    ## Restartability tests for ORCA2_OFF_PISCES
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_LONG -r ORCA2_OFF_PISCES -j 8 add_key "key_mpp_mpi key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"OFFP_LONG\"
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist nn_stock 20
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_OFF_PISCES.cfg 4 ${TEST_NAME}
+    
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist cn_exp \"OFFP_SHORT\"
+    set_namelist namelist nn_it000 21
+    set_namelist namelist nn_itend 40
+    set_namelist namelist nn_stock 20
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 4
+    cp ../LONG/OFFP_LONG_00000020_restart*nc .
+    set_namelist namelist_top ln_diatrc .false.
+    set_namelist namelist_top ln_rsttr .true.
+    set_namelist namelist_top nn_rsttr 2
+    set_namelist namelist_top cn_trcrst_in \"OFFP_LONG_00000020_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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_OFF_PISCES.cfg 4 ${TEST_NAME}
+fi
+
+if [ ${config} -eq 6 ] ;  then
+    ## Repropducibility tests for ORCA2_OFF_PISCES
+    export TEST_NAME="REPRO_4_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2OFFPIS_16 -r ORCA2_OFF_PISCES -j 8 add_key "key_mpp_rep key_mpp_mpi"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 16
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_OFF_PISCES.cfg 16 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPRO_2_8"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 40
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 2
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 16
+    set_namelist namelist_top ln_trcdta .false.
+    set_namelist namelist_top ln_diatrc .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 ln_ironsed .false.
+    set_namelist namelist_pisces ln_river .false.
+    set_namelist namelist_pisces ln_ndepo .false.
+    set_namelist namelist_pisces ln_dust .false.
+    set_namelist namelist_pisces ln_presatm .false.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_OFF_PISCES.cfg 16 ${TEST_NAME}
+fi
+
+# TESTS FOR AMM12 CONFIGURATION
+if [ ${config} -eq 7 ] ;  then
+    ## Reproducibility tests for AMM12
+    export TEST_NAME="REPO_8_4"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_32 -r AMM12 add_key "key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 576
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_AMM12.cfg 32 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="REPO_4_8"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 576
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 4
+    set_namelist namelist jpnj 8
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_AMM12.cfg 32 ${TEST_NAME}
+fi
+
+if [ ${config} -eq 8 ] ;  then
+    ## Restartability tests for AMM12
+    export TEST_NAME="LONG"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 add_key "key_mpp_rep"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 12
+    set_namelist namelist nn_stock 6
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_AMM12.cfg 32 ${TEST_NAME}
+
+    cd ${SETTE_DIR}
+    export TEST_NAME="SHORT"
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 7
+    set_namelist namelist nn_itend 12
+    set_namelist namelist nn_fwb 0
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist nn_dyn2d 2
+    set_namelist namelist nn_tra_dta 0
+    set_namelist namelist jpni 8
+    set_namelist namelist jpnj 4
+    set_namelist namelist jpnij 32
+    set_namelist namelist ln_rstart .true.
+    set_namelist namelist nn_rstctl 2
+    cp ../LONG/AMM12_00000006_restart*.nc .
+    set_namelist namelist cn_ocerst_in \"AMM12_00000006_restart\"
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_AMM12.cfg 32 ${TEST_NAME}
+fi
+
+# TEST FOR ORCA2_LIM_AGRIF : simple test of running AGRIF (no restartability neither reproducibility tests)
+if [ ${config} -eq 9 ] ;  then
+    ## ORCA2_LIM with Agulhas AGRIF zoom in MPI
+    export TEST_NAME="SHORT"
+    cd ${SETTE_DIR}
+    . ../CONFIG/makenemo -m ${CMP_NAM} -n ORCA2AGUL_1_2 -r ORCA2_LIM -j 8 add_key "key_mpp_rep key_mpp_mpi key_agrif" del_key "key_zdftmx"
+    cd ${SETTE_DIR}
+    . param.cfg
+    . all_functions.sh
+    . prepare_exe_dir.sh
+    cd ${EXE_DIR}
+    set_namelist namelist nn_it000 1
+    set_namelist namelist nn_itend 75
+    set_namelist namelist ln_ctl .false.
+    set_namelist namelist ln_clobber .true.
+    set_namelist namelist jpni 1
+    set_namelist namelist jpnj 2
+    set_namelist namelist jpnij 2
+    set_namelist 1_namelist nn_it000 1
+    set_namelist 1_namelist nn_itend 150
+    set_namelist 1_namelist ln_ctl .false.
+    set_namelist 1_namelist ln_clobber .true.
+    cd ${SETTE_DIR}
+    . ./fcm_job.sh input_ORCA2_LIM_AGRIF.cfg 2 ${TEST_NAME}
+fi
+
+done
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette_beginner.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette_beginner.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/SETTE/sette_beginner.sh	(revision 3437)
@@ -0,0 +1,87 @@
+#!/bin/bash
+#############################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# 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
+#+
+#
+# ===================
+# sette_beginner.sh
+# ===================
+#
+# ----------------------------------------------
+# Set of tests for NEMO for beginners
+# ----------------------------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ ./sette_beginner.sh
+#
+# DESCRIPTION
+# ===========
+# First simple example of how to use SETTE: create GYRE_SHORT configuration, compile it with 1 proc, and test it for a SHORT test: 5days
+#-
+#
+# Compiler among those in NEMOGCM/ARCH
+COMPILER=PW6_VARGAS
+export BATCH_COMMAND_PAR="llsubmit"
+export BATCH_COMMAND_SEQ=$BATCH_COMMAND_PAR
+# export MPI_INTERACT="no"
+
+# 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 1 proc, by default in cpp_GYRE.fcm file : 
+export TEST_NAME="TEST02"
+cd ${SETTE_DIR}
+. ../CONFIG/makenemo -m ${CMP_NAM} -n GYRE_SHORT -r GYRE
+cd ${SETTE_DIR}
+. param.cfg 
+. all_functions.sh
+# creation of execution directory
+. prepare_exe_dir.sh
+JOB_FILE=${EXE_DIR}/run_job.sh
+cd ${EXE_DIR}
+# setting namelist parameters
+# experience name
+set_namelist namelist cn_exp \"GYRE_SHORT\"
+# first time step
+set_namelist namelist nn_it000 1
+# last time step
+set_namelist namelist nn_itend 120
+# frequency of creation of a restart file
+set_namelist namelist nn_stock 60
+
+cd ${SETTE_DIR}
+# . ./prepare_job.sh input_file_config_name NB_PROCS TEST_NAME MPI_FLAG JOB_FILE
+. ./prepare_job.sh input_GYRE.cfg 1 SHORT no $JOB_FILE
+# run job, with 1 processor, test named SHORT (= 60 time steps)
+#. ./fcm_job.sh NB_PROCS JOB_FILE INTERACT_FLAG MPI_FLAG
+    cd ${SETTE_DIR}   
+. ./fcm_job.sh 1 $JOB_FILE no no
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh	(revision 3437)
@@ -0,0 +1,83 @@
+#!/bin/bash
+######################################################
+# Author : Simona Flavoni for NEMO
+# Contact : sflod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fadd_keys   : add keys in cpp.fcm file  
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fadd_keys.sh
+# ============
+#
+# --------------------
+# Add compilation keys
+# --------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fadd_keys.sh CONFIG_NAME add_key "LIST_KEYS"
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Script to add a set off key when compiling a configuration.
+# The list off key to be added has to be enclosed with " ". 
+# A 'sed' is performed to modify the CONFIG_NAME/cpp.fcm file to    
+# add the new key(s). 
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fadd_keys.sh ORCA2_LIM add_key "key_mpp_mpi key_nproci=1 key_nprocj=10"
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: Fadd_keys.sh 2158 2010-10-20 17:30:03Z sflod $
+#
+#
+#
+#   * creation
+#
+#-
+ echo "Adding keys in : ${NEW_CONF}" 
+ for i in ${list_add_key} ; do
+	if [ "$(echo ${i} | grep -c key_nproc )" -ne 0 ] ; then
+		sed -e "s/key_nproc[ij]=.[0-9]* //"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+       	 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+		echo " "
+		sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+       	 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+	elif [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "$i" )" -ne 0 ] ; then
+ 	echo "key $i already present in cpp_${NEW_CONF}.fcm" 
+	else
+	sed -e "s/$/ ${i}/"  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm >  ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp
+ 	mv ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm.tmp   ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm
+ 	echo "added key $i in ${NEW_CONF}" 
+	fi
+ done
+ 
+ unset -v list_add_key
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 3437)
@@ -0,0 +1,81 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==================
+# Fcheck_archfile.sh
+# ==================
+#
+# --------------------------
+# Check the compilation file
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcheck_archfile.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Check the choice of the compiler.
+# Three cases :  
+#
+# - There was a previous choice
+# - A new one has be specified, we use this one
+# - No information, exit
+#
+# We use TOOLS/COMPILE/arch.fcm to see if something was chosen. 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcheck_archfile.sh ARCHFILE COMPILER
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ ${#2} -eq 0 ]; then
+   if [ ! -f ${COMPIL_DIR}/$1 ]; then
+   echo "Warning !!!"
+   echo "NO compiler chosen"
+   echo "Try makenemo -h for help"
+   echo "EXITING..."
+   exit 1 
+   fi
+else
+   myfile=$( find ${MAIN_DIR}/ARCH -name arch-${2}.fcm -print )
+   if [ ${#myfile} -gt 0 ]; then
+      ln -sf  ${myfile} ${COMPIL_DIR}/$1
+   else
+      echo "Warning !!!"
+      echo "Compiler not existing"
+      echo "Try makenemo -h for help"
+      echo "EXITING..."
+      exit 1       
+   fi   
+fi
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 3437)
@@ -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 onfiguration 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 defaut 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh	(revision 3437)
@@ -0,0 +1,68 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# =============
+# Fclean_var.sh
+# =============
+#
+# ----------------------------
+# Clean environement variables
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fclean_var.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Clean environement variables
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fclean_var.sh
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+#- Unset variables
+
+unset -v NSTOP
+unset -v TAB
+unset -v NEW_CONF
+unset -v REF_CONF
+unset -v CMP_NAM
+unset -v NBR_PRC
+unset -v NEM_SUBDIR
+unset -v MAIN_DIR
+unset -v CONFIG_DIR
+unset -v TOOLS_DIR
+unset -v COMPIL_DIR
+unset -v NEMO_DIR
+unset -v USEBLD
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 3437)
@@ -0,0 +1,62 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ============
+# Fcopy_dir.sh
+# ============
+#
+# --------------------------
+# Copy a reference directory
+# --------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fcopy_dir.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# When a refenrence configuration is set, 
+# Copy NEMO sub-directories needed (OPA_SRC, TOP_SRC ...)
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fcopy_dir.sh ORCA2_LIM
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+declare -a ZTAB
+grep "$1 " ${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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fdel_keys.sh	(revision 3437)
@@ -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, contianing the list of keys. 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fdel_keys.sh CONFIG_NAME del_key "key_agrif"
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: Fdel_keys.sh 2158 2010-10-20 17:30:03Z sflod $
+#
+#
+#
+#   * creation
+#
+#-
+ echo "Removing keys in : ${NEW_CONF}"
+ 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 3437)
@@ -0,0 +1,115 @@
+#!/bin/bash
+######################################################
+# Author : Rachid Benshila for NEMO
+# Contact : rblod@locean-ipsl.upmc.fr
+#
+# Some functions called from makenemo
+# Fmake_WORK      : create links in the WORK
+######################################################
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# =============
+# Fmake_WORK.sh
+# =============
+#
+# -----------------------
+# Make the WORK directory
+# -----------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fmake_WORK.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Make the WORK directory:
+#
+# - Create lin in NEW_CONF/WORK
+# - Use specified sub-directories previously
+# - OPA has to be done first !!!
+#
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fmake_WORK.sh ORCA2_LIM OPA_SRC LIM_SRC_2
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+declare 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 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh	(revision 3437)
@@ -0,0 +1,67 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ===============
+# Fmake_config.sh
+# ===============
+#
+# ---------------
+# Make the config 
+# ---------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fmake_config.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# - Make the config directory 
+# - Create repositories needed :
+#  
+#  - EXP00 for namelist
+#  - MY_SRC for user sources
+#  - BLD for compilation 
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fmake_config.sh CONFIG_NAME REF_CONFIG_NAME 
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+\mkdir  ${1}
+\mkdir  ${1}/EXP00
+\mkdir  ${1}/MY_SRC
+\cp -R  ${2}/cpp_${2}.fcm ${1}/cpp_${1}.fcm
+\cp -R  ${2}/EXP00/*namelist* ${1}/EXP00/.
+[ -f ${2}/EXP00/AGRIF_FixedGrids.in ] &&  \cp -R  ${2}/EXP00/AGRIF_FixedGrids.in ${1}/EXP00/.
+[ -f ${2}/EXP00/iodef.xml ] &&  \cp -R  ${2}/EXP00/iodef.xml ${1}/EXP00/.
+[ -f ${2}/EXP00/xmlio_server.def ] &&  \cp -R  ${2}/EXP00/xmlio_server.def ${1}/EXP00/.
+[ -d    ${2}/MY_SRC ] && \cp  ${2}/MY_SRC/* ${1}/MY_SRC/. 2> /dev/null
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh	(revision 3437)
@@ -0,0 +1,71 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==============
+# Fprep_agrif.sh
+# ==============
+#
+# ---------------------
+# Preparation for AGRIF
+# ---------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ Fprep_agrif.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Prepare directories for AGRIF and copy files needed
+#
+# Compile the conv
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./Fprep_agrif.sh CONFIG_NAME
+#
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id$
+#
+#
+#
+#   * creation
+#
+#-
+
+#- AGRIF conv
+if [ "$AGRIFUSE" == 1 ]; then
+
+#- CONV
+#fcm build ${TOOLS_DIR}/conv.cfg || exit 1
+gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB
+
+#- AGRIF sources
+[ ! -d $2/$1/OPAFILES ] && mkdir  $2/$1/OPAFILES
+[ ! -d $2/$1/OPAFILES/AGRIF_INC ] && mkdir  $2/$1/OPAFILES/AGRIF_INC
+[ ! -d $2/$1/OPAFILES/AGRIF_MODELFILES ] && mkdir  $2/$1/OPAFILES/AGRIF_MODELFILES
+cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/agrif_opa.in  $2/$1/OPAFILES/
+cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv  $2/$1/OPAFILES/
+
+fi
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/agrifpp.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/agrifpp.sh	(revision 3437)
@@ -0,0 +1,89 @@
+#!/bin/bash
+#set -x
+set -o posix
+#set -u
+#set -e
+#+
+#
+# ==========
+# agrifpp.sh
+# ==========
+#
+# ----------------------------
+# Preform AGrif pre-processing
+# ----------------------------
+#
+# SYNOPSIS
+# ========
+#
+# ::
+#
+#  $ agrifpp.sh
+#
+#
+# DESCRIPTION
+# ===========
+#
+#
+# Look after key agrif, if yes the conv is used, otherwise standard pre-processing is performed.
+#
+# EXAMPLES
+# ========
+#
+# ::
+#
+#  $ ./agrifpp.sh 1 -Dkey
+# 
+#  or
+#
+#  $ ./agrifpp.sh -Dkey
+#
+# TODO
+# ====
+#
+# option debug
+#
+#
+# EVOLUTIONS
+# ==========
+#
+# $Id: agrifpp.sh 2143 2010-10-04 12:49:55Z rblod $
+#
+#
+#
+#   * creation
+#
+#-
+
+if [ "$1" == "1" ]; then
+   shift
+   MYFILE=`echo $* |awk -F" " '{print $NF}' `  
+   FPP_OPT=` echo $* |awk '{  for (i=1 ; i<NF ; i++ )  { printf " %s",  $i } }'`
+
+
+   if [ "${MYFILE}" != "par_oce.F90" -a  ! -f ${NEMO_TDIR}/${NEW_CONF}}/OPAFILES/param_done ]; then
+      cpp ${FPP_OPT} ${CONFIG_DIR}/${NEW_CONF}/WORK/par_oce.F90 > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/par_oce.F90
+      (cd ${NEMO_TDIR}/${NEW_CONF}/OPAFILES ; ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/conv agrif_opa.in -rm -comdirin ./ -comdirout AGRIF_MODELFILES/ -convfile par_oce.F90 > /dev/null )
+      cpp ${FPP_OPT}  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC  ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_MODELFILES/par_oce.F90 > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/par_oce.F90
+      touch ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/param_done
+   elif  [ "${MYFILE}" == "par_oce.F90" -a -f ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/param_done ] ; then
+      cd  ${NEMO_TDIR}/${NEW_CONF}/OPAFILES
+      cpp ${FPP_OPT} -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC ${MYFILE}
+      exit
+   fi
+
+   if [ "${MYFILE}" == agrif2model.F90 ]; then
+      cpp  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC $@
+      exit
+   fi 
+
+   cpp  -I${NEMO_TDIR}/${NEW_CONF}/OPAFILES/AGRIF_INC $@ > ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/${MYFILE}
+   ( cd ${NEMO_TDIR}/${NEW_CONF}/OPAFILES ; ${NEMO_TDIR}/${NEW_CONF}/OPAFILES/conv agrif_opa.in -rm -comdirin ./ -comdirout AGRIF_MODELFILES/ -convfile ${MYFILE} > /dev/null )
+   cd  ${NEMO_TDIR}/${NEW_CONF}
+   sed 's/[ 	]*$//' OPAFILES/AGRIF_MODELFILES/${MYFILE}> OPAFILES/${MYFILE}
+   cpp ${FPP_OPT} -IOPAFILES/AGRIF_INC OPAFILES/${MYFILE} 
+else
+   shift
+   cpp $@
+fi
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld.cfg	(revision 3437)
@@ -0,0 +1,90 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/cpp.fcm
+
+search_src           1
+
+src::xmlf90::cml          $MAIN_DIR/EXTERNAL/XMLF90/src/cml
+src::xmlf90::dom          $MAIN_DIR/EXTERNAL/XMLF90/src/dom
+src::xmlf90::sax          $MAIN_DIR/EXTERNAL/XMLF90/src/sax
+src::xmlf90::strings      $MAIN_DIR/EXTERNAL/XMLF90/src/strings
+src::xmlf90::wxml         $MAIN_DIR/EXTERNAL/XMLF90/src/wxml
+src::xmlf90::xpath        $MAIN_DIR/EXTERNAL/XMLF90/src/xpath
+src::xmlio                $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/XMLIO
+src::ioserver             $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/IOSERVER
+src::ioipsl               $MAIN_DIR/EXTERNAL/IOIPSL/src
+src::agrif                $MAIN_DIR/EXTERNAL/AGRIF/AGRIF_FILES
+src::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+#bld::lib::xmlf90           xmlf90
+#bld::lib::xmlio            xmlio
+#bld::lib::ioserver         ioserver
+#bld::lib::ioipsl           ioipsl
+#bld::lib::agrif            agrif
+#bld::lib::nemo             nemo
+#bld::target libxmlf90.a libioserver.a libxmlio.a libioipsl.a libagrif.a libnemo.a server.exe nemo.exe
+bld::target  server.exe nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::fflags::agrif   %FFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Pre-process code before analysing dependencies
+bld::pp::xmlio    1
+bld::pp::ioserver 1
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::pp::agrif    1
+bld::tool::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::xmlio    0 %FPPFLAGS
+bld::tool::fppflags::ioserver 0 %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+bld::tool::fppflags::agrif    0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bld_tools.cfg	(revision 3437)
@@ -0,0 +1,44 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_tools.fcm
+
+search_src           1
+
+src::nemo                 $TOOLS_DIR/$NEW_CONF/src
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::mpi
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxag.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxag.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxag.cfg	(revision 3437)
@@ -0,0 +1,79 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/cpp.fcm
+
+search_src           1
+
+src::xmlf90::cml          $MAIN_DIR/EXTERNAL/XMLF90/src/cml
+src::xmlf90::dom          $MAIN_DIR/EXTERNAL/XMLF90/src/dom
+src::xmlf90::sax          $MAIN_DIR/EXTERNAL/XMLF90/src/sax
+src::xmlf90::strings      $MAIN_DIR/EXTERNAL/XMLF90/src/strings
+src::xmlf90::wxml         $MAIN_DIR/EXTERNAL/XMLF90/src/wxml
+src::xmlf90::xpath        $MAIN_DIR/EXTERNAL/XMLF90/src/xpath
+src::xmlio                $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/XMLIO
+src::ioserver             $MAIN_DIR/EXTERNAL/XMLIO_SERVER/src/IOSERVER
+src::ioipsl               $MAIN_DIR/EXTERNAL/IOIPSL/src
+src::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+bld::target  server.exe nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Pre-process code before analysing dependencies
+bld::pp::xmlio    1
+bld::pp::ioserver 1
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::tool::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::xmlio    0 %FPPFLAGS
+bld::tool::fppflags::ioserver 0 %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxio.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxio.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxio.cfg	(revision 3437)
@@ -0,0 +1,71 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc $COMPIL_DIR/arch_nemo.fcm
+inc $COMPIL_DIR/cpp.fcm
+
+search_src           1
+
+src::ioipsl               $MAIN_DIR/EXTERNAL/IOIPSL/src
+src::agrif                $MAIN_DIR/EXTERNAL/AGRIF/AGRIF_FILES
+src::nemo                 $CONFIG_DIR/$NEW_CONF/WORK
+
+bld::target  nemo.exe
+bld::exe_dep
+
+
+dir::root            $NEMO_TDIR/$NEW_CONF/BLD
+
+
+bld::tool::fc        %FC 
+bld::tool::fflags    %FCFLAGS %USER_INC
+bld::tool::fflags::agrif   %FFLAGS %USER_INC
+bld::tool::ld        %LD
+bld::tool::ldflags   %LDFLAGS %USER_LIB
+bld::tool::ar        %AR
+bld::tool::arflags   %ARFLAGS
+bld::tool::make      %MK
+
+# Pre-process code before analysing dependencies
+bld::pp::ioipsl   1
+bld::pp::nemo     1
+bld::pp::agrif    1
+bld::tool::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+bld::tool::fppflags::agrif    0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxioxag.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxioxag.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/bldxioxag.cfg	(revision 3437)
@@ -0,0 +1,67 @@
+# ----------------------- 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::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::fpp       $COMPIL_DIR/agrifpp.sh
+bld::tool::fppflags::nemo ${AGRIFUSE} %FPPFLAGS
+bld::tool::fppflags::ioipsl   0 %FPPFLAGS
+
+# Ignore the following dependencies
+bld::excl_dep        inc::netcdf.inc
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::netcdf
+bld::excl_dep        h::netcdf.inc
+bld::excl_dep        h::mpif.h
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        inc::mpe_logf.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_proto
+bld::excl_dep        use::mod_prism_def_partition_proto
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_get_proto
+bld::excl_dep        use::mod_prism_put_proto
+bld::excl_dep        use::mod_comprism_proto
+bld::excl_dep        use::mkl_dfti
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".h90" as an extension for CPP include files
+bld::infile_ext::h90  CPP::INCLUDE
+
+# extension for module output
+bld::outfile_ext::mod .mod
+
+# rename executable to nemo.exe
+bld::exe_name::model  nemo.exe
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/conv.cfg
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/conv.cfg	(revision 3437)
@@ -0,0 +1,33 @@
+# ----------------------- FCM extract configuration file -----------------------
+# template to compile agrif conv, currently not used
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+inc $COMPIL_DIR/arch.fcm
+
+bld::tool::make      %MK
+
+src::convsrc   $MAIN_DIR/EXTERNAL/AGRIF/LIB
+
+ #----------------------------------------------------------------------------
+# Build options (code-specific, machine-independent)
+# ----------------------------------------------------------------------------
+dir::root            $NEMO_TDIR/$NEW_CONF/AGRIFLIB
+
+bld::tool::cflags::convsrc  -O0  
+bld::tool::ld::convsrc   cc
+bld::tool::ldflags::convsrc -O  ../obj/fortran.o ../obj/fortran.o 
+bld::pp 1
+
+
+
+bld::exe_name::main conv
+bld::target                              libconvsrc.a  fortran.o main.o  conv
+bld::exe_dep::conv      
+
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/tools.txt
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/COMPILE/tools.txt	(revision 3437)
@@ -0,0 +1,1 @@
+REBUILD 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R05
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R05	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R2
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/namelist_R2	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/cfg_tools.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/create_coordinates.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/domain.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/io_netcdf.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/mixed_grid.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/projection.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/readwrite.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/types.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/GRIDGEN/src/types.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh	(revision 3437)
@@ -0,0 +1,130 @@
+#!/bin/bash
+#------------------------------------------------
+#$Id$
+#------------------------------------------------
+#
+set -u
+#
+# if not argument -> get the help
+[ $# -eq 0 ] && ./$0 --help && exit
+#
+inxml=0
+insrc=0
+while [ $# -gt 0 ]   # Until you run out of parameters . . . 
+do    
+    case "$1" in 
+	-h|--help)
+	    echo
+	    echo 'Description:'
+	    echo '      check that an xml file is coherant with the source code:'
+	    echo '         - all variable ids defined by "call iom_put" must have their counterpart'
+	    echo '           in the variable definition in xml file'
+	    echo '         - list variable ids defined in xml file without any corresponding call'
+	    echo '           to iom_put. This can be done but it is useless as iom will only ouput zeros'
+	    echo '         - all variable ids used in the files definition in xml file must have'
+	    echo '           their counterpart in the variable definition in xml file'
+	    echo 'Usage:'
+	    echo '      chk_iomput.sh [OPTION]'
+	    echo '  or  chk_iomput.sh [OPTION] xmlfile DIRECTORIES'
+	    echo '         with:'
+	    echo '           xmlfile:  the xml file to test'
+	    echo '           DIRECTORIES: a list of directories containing the source code'
+	    echo 'Options'
+	    echo ' -h, --help           to get this help'
+	    echo ' --inxml              only print all variable definitions found in the xml file'
+	    echo ' --insrc              only print all variable definitions found in the source code'
+	    echo 'Examples'
+	    echo '      chk_iomput.sh'
+	    echo '      chk_iomput.sh --help'
+	    echo '      chk_iomput.sh ../../CONFIG/ORCA2_LIM/EXP00/iodef.xml "../../NEMO/OPA_SRC/ ../../NEMO/LIM_SRC_2/"'
+	    echo
+	    exit ;;
+        --inxml) inxml=1 ;;
+        --insrc) insrc=1 ;;
+	-*) echo ; echo "illegal option" ; ./$0 --help && exit ;;
+	*) [ $# -ne 2 ] && echo && echo "wrong number of arguments" && ./$0 --help && exit
+	    xmlfile=${1}
+	    srcdir=${2}
+	   shift
+    esac
+    shift       # Check next set of parameters. 
+done 
+#
+[ ! -f "$xmlfile" ] && echo "$xmlfile not found, we stop..." && exit
+for i in $srcdir 
+do
+    [ ! -d $i ] && echo "$i is not a directory, we stop..." && exit
+done
+#
+#------------------------------------------------
+#
+[ $inxml -eq 1 ] && grep "< *field * id *=" $xmlfile
+[ $insrc -eq 1 ] && find $srcdir -name "*.[Ffh]90" -exec grep -iH "^[^\!]*call  *iom_put *(" {} \;
+[ $(( $insrc + $inxml )) -ge 1 ] && exit
+#
+#------------------------------------------------
+#
+# list of file containing "CALL iom_put" in $srcdir
+#
+srclist=$( find $srcdir -name "*.[Ffh]90" -exec grep -il "^[^\!]*call  *iom_put *(" {} \; )
+#
+# list of variables used in "CALL iom_put"
+#
+varlistsrc=$( find $srcdir -name "*.[Ffh]90" -exec grep -i  "^[^\!]*call  *iom_put *(" {} \; | sed -e "s/.*iom_put *( *[\"\']\([^\"\']*\)[\"\'] *,.*/\1/" | sort -d )
+#
+# list of variables defined in the xml file
+#
+varlistxml=$( grep "< *field * id *=" $xmlfile  | sed -e "s/^.*< *field * id *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+# list of variables to be outputed in the xml file
+#
+varlistout=$( grep "< *field * ref *=" $xmlfile  | sed -e "s/^.*< *field * ref *= *[\"\']\([^\"\']*\)[\"\'].*/\1/" | sort -d )
+#
+echo "--------------------------------------------------"
+echo  check if all iom_put found in $srcdir
+echo  have a corresponding variable definition in $xmlfile
+echo "--------------------------------------------------"
+for var in $varlistsrc
+do
+    tst=$( echo " "$varlistxml" " | grep -c " $var " )
+    if [ $tst -ne 1 ] 
+    then
+	echo "problem with $var: $tst lines corresponding to its definition in $xmlfile, but defined in the code in"
+	for f in $srclist
+	do
+	    grep -iH "^[^\!]*call  *iom_put *( *[\"\']${var}[\"\'] *," $f
+	done
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  check if all variables defined in $xmlfile
+echo  have a corresponding \"call iom_put\" in sources found in $srcdir
+echo "--------------------------------------------------"
+#
+for var in $varlistxml
+do
+    found=$( echo " "$varlistsrc" " | grep -c " $var " )
+    if [ $found -eq 0 ] 
+    then
+	echo \"call iom_put\" not found for variable $var
+	grep "< *field * id *= *[\"\']${var}[\"\']" $xmlfile
+	echo
+    fi
+done
+#
+echo "--------------------------------------------------"
+echo  ${xmlfile}: check if all variables to be outputed in files are really defined...
+echo "--------------------------------------------------"
+#
+# list of variables defined in the xml file
+for var in $varlistout
+do
+    found=$( echo " "$varlistxml" " | grep -c " $var " )
+    [ $found -eq 0 ] && echo variable to be outputed but not defined: $var 
+done
+
+
+
+exit
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 3437)
@@ -0,0 +1,33 @@
+#!/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 -ue
+#
+echo "check for all *90 files contained in "$( pwd )" and its subdirectories"
+#
+for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) )
+do
+
+    # number of lines with wrk_alloc
+    n1=$( grep -ic "call *wrk_alloc *(" $ff )  
+    # replace wrk_alloc with wrk_dealloc and count the lines
+    n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
+    # we should get n2 = 2 * n1...
+    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff" 
+   
+    # same story but for wrk_dealloc
+    n1=$( grep -ic "call *wrk_dealloc *(" $ff )  
+    n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
+    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff" 
+   
+done
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 3437)
@@ -0,0 +1,166 @@
+#!/bin/bash
+#
+set -u
+#set -xv
+#
+# for on each file containing a call to work alloc (exept BDY files that are too complicated...)
+#for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY )
+for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY )
+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/[^(]*\((.*)\).*/\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
+# LIM_SRC_2/limrhg_2.F90
+sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$
+mv tmp$$ LIM_SRC_2/limrhg_2.F90
+# LIM_SRC_3/limitd_me.F90
+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
+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
+sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \
+    -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_dif.F90
+# LIM_SRC_3/limthd_ent.F90
+sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \
+    -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_ent.F90
+# OPA_SRC/DYN/divcur.F90
+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
+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
+sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) ::   zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$
+mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90
+
+# link for limrhg.F90...
+cd LIM_SRC_2
+ln -sf ../LIM_SRC_3/limrhg.F90 .
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/namelist	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mpp_optimiz_zoom_nc.f90	(revision 3437)
@@ -0,0 +1,372 @@
+PROGRAM mpp_optimiz_nc
+ !!---------------------------------------------------------------------
+ !!
+ !!                       PROGRAM MPP_OPTIMIZ_NC
+ !!                     ***********************
+ !!
+ !!  PURPOSE :
+ !!  ---------
+ !!              This program is build to optimize the domain beakdown into
+ !!              subdomain for mpp computing.
+ !!              Once the grid size, and the land/sea mask is known, it looks
+ !!              for all the possibilities within a range of setting parameters
+ !!              and determine the optimal.
+ !!
+ !!              Optimization is done with respect to the maximum number of
+ !!              sea processors and to the maximum numbers of procs (jprocx)
+ !!                     
+ !!              Optional optimization can be performed takink into account
+ !!              the maximum available processor memory ppmcal. This is
+ !!              activated if jpmen =1
+ !!
+ !! history:
+ !! --------
+ !!       original  : 95-12 (Imbard M) for OPA8.1, CLIPPER
+ !!       f90       : 03-06 (Molines JM), namelist as input
+ !!                 : 05-05 (Molines JM), bathy in ncdf
+ !!----------------------------------------------------------------------
+ !! * modules used
+  USE netcdf
+
+  IMPLICIT NONE
+
+  INTEGER ::  jprocx=250   !: maximum number of proc. (Read from namelist)
+  INTEGER ::  jpmem=0      !: memory constraint (1) or no constraint (0)
+     !                     !  (use 1 with caution as the memory size of 
+     !                     !   the code lays on OPA 8.1 estimates ...)
+     !
+  INTEGER          ::  &
+       jpk    = 46  ,    & !: vertical levels (namelist)
+       jpiglo = 1442,    & !: I-size of the model (namelist)
+       jpjglo = 1021,    & !: J-size of the model (namelist)
+       jpidta = 1442,    & !: I-size of the data file (namelist)
+       jpjdta = 1021,   &  !: J-size of the data files (namelist)
+       nizoom = 1 ,     &  !: I zoom indicator (namelist)
+       njzoom = 1 ,     &  !: J zoom indicatori (namelist)
+       numnam = 4          !: logical unit for the namelist
+  NAMELIST /namspace/ jpk,jpiglo,jpjglo,jpidta,jpjdta,nizoom,njzoom
+  NAMELIST /namproc/ jprocx, jpmem
+
+  INTEGER ::  jpnix ,jpnjx  
+  !
+  INTEGER,PARAMETER :: jpreci=1 ,jprecj=1
+  !
+  ! Following variables are used only if jpmem=1
+  REAL(KIND=4) ::  ppmpt ,   &
+       ppmcal = 225000000., &  !: maximum memory of one processor for a given machine (in 8 byte words)
+       ppmin  = 0.4,         & !: minimum ratio to fill the memory
+       ppmax  = 0.9            !: maximum ration to fill the memory
+  ! Aleph
+  !     PARAMETER(ppmcal= 16000000.)
+  !Brodie
+  !     PARAMETER(ppmcal=250000000.)
+  ! Uqbar
+  !     PARAMETER(ppmcal=3750000000.)
+  ! Zahir
+  !     PARAMETER(ppmcal=225000000.)
+
+  CHARACTER(LEN=80) :: cbathy, &       !: File name of the netcdf bathymetry (namelist)
+      &                clvar           !: Variable name in netcdf for the bathy to be read
+  LOGICAL ::  ln_zps=.false.           !: Logical flag for partial cells.
+  NAMELIST /namfile/ cbathy, ln_zps
+  NAMELIST /namparam/ ppmcal, ppmin, ppmax
+  !
+  INTEGER :: iumout = 1
+  INTEGER :: ji,jj,jn,jni,jnj,jni2,jnj2
+  INTEGER :: iumbat,ifreq,il1,il2
+  INTEGER :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
+  INTEGER :: iilb,ijlb,ireci,irecj,in
+  INTEGER :: ipi,ipj
+  INTEGER :: inf10,inf30,inf50,iptx,isw
+  INTEGER :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
+  !
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
+  !
+  REAL(KIND=4)                           ::  zmin,zmax,zper,zmem
+  REAL(KIND=4)                           ::  zzmin,zzmax,zperx
+  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask ,&  ! jpiglo -jpjglo
+      &                                        zdta      ! jpidta -jpjdta
+
+ ! CDF stuff
+  INTEGER :: ncid, ivarid, istatus
+  LOGICAL ::  llbon=.false.
+  !
+  ! 0. Initialisation
+  ! -----------------
+  OPEN(numnam,FILE='namelist')
+  REWIND(numnam)
+  READ(numnam,namspace)
+
+  REWIND(numnam)
+  READ(numnam,namfile)
+
+  REWIND(numnam)
+  READ(numnam,namparam)
+
+  REWIND(numnam)
+  READ(numnam,namproc)
+
+  ! estimated  code size expressed in number of 3D arrays (valid for OPA8.1)
+  ppmpt = 55.+73./jpk
+  jpnix = jprocx ; jpnjx=jprocx
+
+  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo),zdta(jpidta,jpjdta) )
+  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
+  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
+
+  OPEN(iumout,FILE='processor.layout')
+  WRITE(iumout,*)
+  WRITE(iumout,*) ' optimisation de la partition'
+  WRITE(iumout,*) ' ----------------------------'
+  WRITE(iumout,*)
+  !
+  ! * Read cdf bathy file
+  !
+         IF ( ln_zps ) THEN        ! partial steps
+            clvar = 'Bathymetry'
+         ELSE 
+            clvar = 'Bathy_level'  ! full steps
+         ENDIF
+
+         INQUIRE( FILE=cbathy, EXIST=llbon )
+      IF( llbon ) THEN
+            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
+            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
+            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
+            istatus=NF90_CLOSE(ncid)
+      ELSE
+          PRINT *,' File missing : ', trim(cbathy)
+          STOP
+      ENDIF
+  ibathy(:,:)=zdta(:,:)
+
+  !
+  ! Building the mask
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj) = float(ibathy(ji+nizoom - 1,jj+njzoom -1))
+     END DO
+  END DO
+
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj)=  min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))  ! Old vector coding rule ...
+     END DO
+  END DO
+  !
+  !  Main loop on processors
+  ! ------------------------
+  iii=1 ; iij=1
+  iiii=jpiglo ; iijj=jpjglo
+  iptx=0
+  iimoy=0
+  zzmin=0. ; zzmax=0.
+  iinf10=0 ; iinf30=0 ; iinf50=0
+  zperx=1.
+  in=0
+  DO jni=1,jpnix
+     DO jnj=1,jpnjx
+        !
+        ! Limitation ob the maxumun number of PE's
+        IF(jni*jnj >  jprocx) goto 1000
+        !
+        ! Partition
+        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+        !
+        ! Memory optimization ?
+        isw=0
+        zmem=ppmpt*ipi*ipj*jpk
+        IF(zmem > ppmcal) go to 1000
+        IF(jpmem == 1) THEN
+           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
+        ENDIF
+        IF(isw.EQ.1) go to 1000
+        in=in+1
+        !
+        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
+        WRITE(iumout,*) ' '
+        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
+        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
+        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
+        !
+        ! Coin en bas a gauche de chaque processeur
+        !
+        iilb=1
+        ijlb=1
+        ireci=2*jpreci
+        irecj=2*jprecj
+        iresti = MOD ( jpiglo - ireci , jni )
+        irestj = MOD ( jpjglo - irecj , jnj )
+        !
+        IF (iresti.EQ.0) iresti = jni
+        DO jj=1,jnj
+           DO ji=1,iresti
+              ippdi(ji,jj) = ipi
+           END DO
+           DO ji=iresti+1,jni
+              ippdi(ji,jj) = ipi -1
+           END DO
+        END DO
+        IF (irestj.EQ.0) irestj = jnj
+        DO ji=1,jni
+           DO jj=1,irestj
+              ippdj(ji,jj) = ipj
+           END DO
+           DO jj=irestj+1,jnj
+              ippdj(ji,jj) = ipj -1
+           END DO
+        END DO
+        DO jj=1,jnj
+           DO ji=1,jni
+              iidom(ji,jj)=iilb
+              ijdom(ji,jj)=ijlb
+           END DO
+        END DO
+        WRITE(iumout,*) " iresti=",iresti," irestj=",irestj
+        !
+        !  2. Boucle sur les processeurs
+        ! ------------------------------
+        !
+        ivide=0
+        imoy=0
+        zmin=1.e+20
+        zmax=-1.e+20
+        inf10=0
+        inf30=0
+        inf50=0
+        !
+        DO jni2=1,jni
+           DO jnj2=1,jnj
+
+              IF(jni.GT.1)THEN
+                 DO jj=1,jnj
+                    DO ji=2,jni
+                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
+                    END DO
+                 END DO
+                 iilb=iidom(jni2,jnj2)
+              ENDIF
+              IF(jnj.GT.1)THEN
+                 DO jj=2,jnj
+                    DO ji=1,jni
+                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
+                    END DO
+                 END DO
+                 ijlb=ijdom(jni2,jnj2)
+              ENDIF
+              isurf=0
+              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
+                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+              ELSE
+                 imoy=imoy+isurf
+              ENDIF
+              zper=float(isurf)/float(ipi*ipj)
+              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
+              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
+              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
+              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
+              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
+              !
+              !
+              ! 3. Fin de boucle sur les processeurs, impression
+              ! ------------------------------------------------
+              !
+           END DO
+        END DO
+        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
+        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
+        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
+        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
+        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
+        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
+        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
+        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
+        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10 -inf30
+        WRITE(iumout,*) ' nombre de points integres   ', (jni*jnj-ivide)*ipi*ipj
+        WRITE(iumout,*) ' nbr de pts supplementaires  ', (jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
+        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) ' % sup                       ',zper
+        WRITE(iumout,*)
+        ! 
+        ! 
+        ! 4. Recherche de l optimum
+        ! -------------------------
+        !
+        IF(ivide.GT.iptx) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iptx=ivide
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ENDIF
+        !
+        ! 5. Fin de boucle sur le nombre de processeurs
+        ! ---------------------------------------------
+        !
+      1000 continue
+     END DO
+  END DO
+  !
+  !
+  ! 6. Affichage resultat
+  ! ---------------------
+  !
+  IF(in.EQ.0) THEN
+     WRITE(iumout,*) ' le choix n'' a pas pu etre fait '
+     WRITE(iumout,*)
+     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
+     STOP 
+  ENDIF
+  WRITE(iumout,*) ' choix optimum'
+  WRITE(iumout,*) ' ============='
+  WRITE(iumout,*) 
+  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
+  WRITE(iumout,*) ' '
+  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
+  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
+  WRITE(iumout,*) 
+  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
+  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
+  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
+  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
+  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
+  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
+  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
+  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10 -iinf30
+  WRITE(iumout,*) ' nombre de points integres   ', (iii*iij-iptx)*iiii*iijj
+  WRITE(iumout,*) ' nbr de pts supplementaires  ', (iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
+  WRITE(iumout,*) ' % sup                       ',zperx
+  WRITE(iumout,*)
+  CLOSE(iumout)
+  !
+  !
+  !
+  STOP
+END PROGRAM mpp_optimiz_nc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/MPP_PREP/src/mppopt_showproc_nc.f90	(revision 3437)
@@ -0,0 +1,450 @@
+PROGRAM mppopt_showproc_nc
+ !!---------------------------------------------------------------------
+ !!
+ !!                       PROGRAM MPP_showproc_nc
+ !!                     ***********************
+ !!
+ !!  PURPOSE :
+ !!  ---------
+ !!              Build a ascii file (suitable for the overlay function of
+ !!              chart) holding the chosen domain decomposition, formely
+ !!              determined by mpp_opatimize_nc.
+ !!              It takes the same namelist than  mpp_optimize_nc, with
+ !!              the jpni, jpnj given in the namelist (NAMKEEP)
+ !!              
+ !!
+ !!              The output file is called from a root name in the namelist
+ !!              (covdta) with the jpni, jpnj, and jpnij added to the name.
+ !!   MODIFICATIONS:
+ !!   --------------
+ !!       original  : 95-12 (Imbard M)
+ !!       modif pour chart : 98-12 ( J.M. Molines)
+ !!             26/05/2005 : English documentation (partial ..) JMM
+ !!----------------------------------------------------------------------
+  !
+  USE netcdf
+  IMPLICIT NONE
+  !
+  INTEGER ::  jprocx=250
+  !
+  INTEGER :: jpmem=0
+  !
+  ! les dimensions du modele
+  !
+  INTEGER :: jpk,jpiglo,jpjglo, jpidta, jpjdta
+  NAMELIST /namspace/ jpk,jpiglo,jpjglo, jpidta, jpjdta,nizoom,njzoom
+  NAMELIST /namproc/ jprocx, jpmem
+
+  INTEGER :: jpni,jpnj, jpnij
+  CHARACTER(LEN=80) :: covdta, cdum
+  NAMELIST /namkeep/ jpni,jpnj,covdta
+
+  CHARACTER(LEN=80) ::  cbathy
+  LOGICAL :: ln_zps=.false.
+  NAMELIST /namfile / cbathy, ln_zps
+  !!
+  ! quelques parametres
+  !
+  INTEGER ::  jpnix,jpnjx
+  !
+  INTEGER,PARAMETER ::  jpreci=1,jprecj=1
+  !
+  ! les dimensions de la memoire du modele et du calculateur (T3E)
+  !
+  REAL(KIND=4) ::  ppmpt ,   &
+       ppmcal = 1000000000., &
+       ppmin  = 0.4,         &
+       ppmax  = 1.0
+  ! Aleph
+  !     PARAMETER(ppmcal=16000000.)
+  !Brodie
+  !     PARAMETER(ppmcal=250000000.)
+  ! Uqbar
+  !     PARAMETER(ppmcal=3750000000.)
+  ! Zahir
+  !     PARAMETER(ppmcal=1000000000.)
+  NAMELIST /namparam/ ppmcal, ppmin, ppmax
+
+
+  !
+  INTEGER,PARAMETER ::  iumout=8, numnam=4, iumbat=11
+  INTEGER           :: ji,jj,jn,jni,jnj,jni2,jnj2
+  INTEGER           ::  ifreq,il1,il2
+  INTEGER           :: ii,iim,ij,ijm,imoy,iost,iresti,irestj,isurf,ivide
+  INTEGER           :: iilb,ijlb,ireci,irecj,in
+  INTEGER           :: ipi,ipj
+  INTEGER           :: inf10,inf30,inf50,iptx,isw
+  INTEGER           :: iii,iij,iiii,iijj,iimoy,iinf10,iinf30,iinf50
+  !
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ibathy    ! jpidta -jpjdta
+  INTEGER,DIMENSION(:,:),ALLOCATABLE     ::  ippdi, ippdj ,iidom, ijdom
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nlei, nldi,nlej,nldj,ICOUNT
+  INTEGER,DIMENSION(:)  ,ALLOCATABLE     :: nleiv, nldiv,nlejv,nldjv
+  INTEGER           :: jjc, nizoom, njzoom
+  !
+  REAL(KIND=4) :: zmin,zmax,zper,zmem
+  REAL(KIND=4) :: zzmin,zzmax,zperx
+  REAL(KIND=4),DIMENSION(:,:),ALLOCATABLE  ::  zmask, zdta, &   ! jpiglo -jpjglo
+                   zlamt, zphit
+  REAL(KIND=4),DIMENSION(:),ALLOCATABLE  ::  zdept   ! jpk
+  LOGICAL :: llbon, lwp=.true.
+  CHARACTER(LEN=80) ::  clvar
+  INTEGER :: numout=6, itime, ipk, istep,  inum
+  REAL(KIND=4) :: zdt, zdate0
+  ! CDF stuff
+  INTEGER :: ncid, ivarid, istatus
+
+  !
+  !
+  !
+  ! 0. Initialisation
+  ! -----------------
+  !
+  OPEN(numnam,FILE='namelist')
+
+  REWIND(numnam)
+  READ(numnam,namspace)
+  ALLOCATE ( ibathy(jpidta,jpjdta), zmask(jpiglo,jpjglo) ,zdta(jpidta,jpjdta))
+  ALLOCATE ( zlamt(jpidta,jpjdta), zphit(jpidta,jpjdta))
+
+  REWIND(numnam)
+  READ(numnam,namparam)
+
+  REWIND(numnam)
+  READ(numnam,namproc)
+
+  ppmpt = 55.+73./jpk
+  jpnix = jprocx ; jpnjx=jprocx
+
+  ALLOCATE (ippdi(jpnix,jpnjx), ippdj(jpnix,jpnjx) )
+  ALLOCATE (iidom(jpnix,jpnjx), ijdom(jpnix,jpnjx) )
+  ALLOCATE (nlei(jprocx), nldi(jprocx) )
+  ALLOCATE (nlej(jprocx), nldj(jprocx) )
+! empty processors
+  ALLOCATE (nleiv(jprocx), nldiv(jprocx) )
+  ALLOCATE (nlejv(jprocx), nldjv(jprocx) )
+  ALLOCATE (ICOUNT(jprocx), zdept(jpk) )
+
+  REWIND(numnam)
+  READ(numnam,namfile) 
+
+  REWIND(numnam)
+  READ(numnam,namkeep)
+
+  WRITE(iumout,*)
+  WRITE(iumout,*) ' optimisation de la partition'
+  WRITE(iumout,*) ' ----------------------------'
+  WRITE(iumout,*)
+
+  !
+  ! Lecture de la bathymetrie
+  !
+      ! open the file
+         IF ( ln_zps ) THEN
+            clvar = 'Bathymetry'
+
+         ELSE
+            clvar = 'Bathy_level'
+         ENDIF
+
+         INQUIRE( FILE=cbathy, EXIST=llbon )
+      IF( llbon ) THEN
+            istatus=NF90_OPEN(cbathy,NF90_NOWRITE,ncid)
+            istatus=NF90_INQ_VARID(ncid,clvar,ivarid)
+            istatus=NF90_GET_VAR(ncid,ivarid,zdta)
+            istatus=NF90_CLOSE(ncid)
+      ELSE
+          WRITE(numout,*)'    mppini_2 : unable to read the file', cbathy
+      ENDIF
+
+      ! land/sea mask over the global/zoom domain
+
+!     imask(:,:)=1
+!     WHERE ( zdta(jpizoom:jpiglo+jpizoom-1, jpjzoom:jpjglo+jpjzoom-1) == 0.e0 ) imask = 0
+      ibathy(:,:)=zdta(:,:)
+
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj) = float(ibathy(ji+nizoom -1,jj+njzoom -1))
+     END DO
+  END DO
+  DO jj=1,jpjglo
+     DO ji=1,jpiglo
+        zmask(ji,jj)= min(REAL(1.,kind=4),max(REAL(0.,kind=4),zmask(ji,jj)))
+     END DO
+  END DO
+  print *,'Nombre de pts mer :', sum(zmask)
+  !
+  !
+  !  1. Boucle sur le nombre de processeurs
+  ! ---------------------------------------
+  !
+  iii=1
+  iij=1
+  iiii=jpiglo
+  iijj=jpjglo
+  iptx=0
+  iimoy=0
+  zzmin=0.
+  zzmax=0.
+  iinf10=0
+  iinf30=0
+  iinf50=0
+  zperx=1.
+  in=0
+! Next loop corresponds to just 1 case, which is the one kept from mpp_optimize.
+  DO jni=jpni,jpni
+     DO jnj=jpnj,jpnj
+        !
+        ! Limitation nombre de pe
+        !
+        IF(jni*jnj.GT.jprocx) go to 1000
+        !
+        ! Partition
+        !
+        ipi=(jpiglo-2*jpreci + (jni-1))/jni + 2*jpreci
+        ipj=(jpjglo-2*jprecj + (jnj-1))/jnj + 2*jprecj
+        !
+        ! Optimisation memoire ?
+        !
+        isw=0
+        zmem=ppmpt*ipi*ipj*jpk + jpiglo*jpjglo
+        IF(zmem.GT.ppmcal) go to 1000
+        IF(jpmem.EQ.1) THEN
+           IF(zmem.GT.ppmax*ppmcal.OR.zmem.LT.ppmin*ppmcal) isw=1
+        ENDIF
+        IF(isw.EQ.1) go to 1000
+        in=in+1
+        !
+        WRITE(iumout,*) '--> nombre de processeurs ',jni*jnj
+        WRITE(iumout,*) ' '
+        WRITE(iumout,*) " jpni=",jni ," jpnj=",jnj
+        WRITE(iumout,*) " jpi= ",ipi ," jpj= ",ipj
+        zper=(jni*jnj*ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) " rapport jpnij*domain/global domain ",zper
+        !
+        ! Coin en bas a gauche de chaque processeur
+        !
+        iilb=1
+        ijlb=1
+        ireci=2*jpreci
+        irecj=2*jprecj
+        iresti = MOD ( jpiglo - ireci , jni )
+        irestj = MOD ( jpjglo - irecj , jnj )
+        !
+        IF (iresti.EQ.0) iresti = jni
+        DO jj=1,jnj
+           DO ji=1,iresti
+              ippdi(ji,jj) = ipi
+           END DO
+           DO ji=iresti+1,jni
+              ippdi(ji,jj) = ipi -1
+           END DO
+        END DO
+        IF (irestj.EQ.0) irestj = jnj
+        DO ji=1,jni
+           DO jj=1,irestj
+              ippdj(ji,jj) = ipj
+           END DO
+           DO jj=irestj+1,jnj
+              ippdj(ji,jj) = ipj -1
+           END DO
+        END DO
+        DO jj=1,jnj
+           DO ji=1,jni
+              iidom(ji,jj)=iilb
+              ijdom(ji,jj)=ijlb
+           END DO
+        END DO
+        !
+        !  2. Boucle sur les processeurs
+        ! ------------------------------
+        !
+        ivide=0
+        imoy=0
+        zmin=1.e+20
+        zmax=-1.e+20
+        inf10=0
+        inf30=0
+        inf50=0
+        jjc=0
+        !
+        DO jni2=1,jni
+           DO jnj2=1,jnj
+
+              IF(jni.GT.1)THEN
+                 DO jj=1,jnj
+                    DO ji=2,jni
+                       iidom(ji,jj)=iidom(ji-1,jj)+ippdi(ji-1,jj)-ireci
+                    END DO
+                 END DO
+                 iilb=iidom(jni2,jnj2)
+              ENDIF
+              IF(jnj.GT.1)THEN
+                 DO jj=2,jnj
+                    DO ji=1,jni
+                       ijdom(ji,jj)=ijdom(ji,jj-1)+ippdj(ji,jj-1)-irecj
+                    END DO
+                 END DO
+                 ijlb=ijdom(jni2,jnj2)
+              ENDIF
+              isurf=0
+
+              DO jj=1+jprecj,ippdj(jni2,jnj2)-jprecj
+                 DO  ji=1+jpreci,ippdi(jni2,jnj2)-jpreci
+                    IF(zmask(ji+iilb-1,jj+ijlb-1).EQ.1.) isurf=isurf+1
+                 END DO
+              END DO
+              IF(isurf.EQ.0) THEN
+                 ivide=ivide+1
+                 nldiv(ivide)=jpreci+iilb
+                 nleiv(ivide)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldjv(ivide)=jprecj+ijlb
+                 nlejv(ivide)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ELSE
+                 imoy=imoy+isurf
+                 jjc=jjc+1
+                 icount(jjc)=isurf 
+                 nldi(jjc)=jpreci+iilb
+                 nlei(jjc)=iilb+ippdi(jni2,jnj2)-1-jpreci
+                 nldj(jjc)=jprecj+ijlb
+                 nlej(jjc)=ijlb+ippdj(jni2,jnj2)-1-jprecj
+              ENDIF
+              zper=float(isurf)/float(ipi*ipj)
+              IF(zmin.GT.zper.AND.isurf.NE.0) zmin=zper
+              IF(zmax.LT.zper.AND.isurf.NE.0) zmax=zper
+              IF(zper.LT.0.1.AND.isurf.NE.0) inf10=inf10+1
+              IF(zper.LT.0.3.AND.isurf.NE.0) inf30=inf30+1
+              IF(zper.LT.0.5.AND.isurf.NE.0) inf50=inf50+1
+              !
+              !
+              ! 3. Fin de boucle sur les processeurs, impression
+              ! ------------------------------------------------
+              !
+           END DO
+        END DO
+        WRITE(iumout,*) ' nombre de processeurs       ',jni*jnj
+        WRITE(iumout,*) ' nombre de processeurs mer   ',jni*jnj-ivide
+        WRITE(iumout,*) ' nombre de processeurs terre ',ivide
+        WRITE(iumout,*) ' moyenne de recouvrement     ',float(imoy)/float(jni*jnj-ivide)/float(ipi*ipj)
+        WRITE(iumout,*) ' minimum de recouvrement     ',zmin
+        WRITE(iumout,*) ' maximum de recouvrement     ',zmax
+        WRITE(iumout,*) ' nb de p recouvrement < 10 % ',inf10
+        WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',inf30-inf10
+        WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',inf50-inf10-inf30
+        WRITE(iumout,*) ' nombre de points integres   ',(jni*jnj-ivide)*ipi*ipj
+        WRITE(iumout,*) ' nbr de pts supplementaires  ',(jni*jnj-ivide)*ipi*ipj-jpiglo*jpjglo
+        zper=float((jni*jnj-ivide))*float(ipi*ipj)/float(jpiglo*jpjglo)
+        WRITE(iumout,*) ' % sup                       ',zper
+        WRITE(iumout,*)
+        WRITE(iumout,*) ' PROCESSORS WITH LESS THAN 100 WATER POINTS'
+
+        WRITE(cdum,'(a,1h-,i3.3,1hx,i3.3,1h_,i3.3)') TRIM(covdta),jpni,jpnj,jni*jnj -ivide
+        OPEN (10,file=cdum)
+        WRITE(10,'(a,i5)')'#',jni*jnj -ivide
+        DO jjc=1,jni*jnj-ivide
+           WRITE(10,'(a,i5)')'#',jjc
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nlei(jjc)+1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nlej(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldi(jjc)-1+nizoom-1,nldj(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999 
+           IF (icount(jjc).LT.100) THEN
+              WRITE(iumout,*)' proc ji=',jjc,' water points:', icount(jjc)
+              WRITE(iumout,*) ' ji from ',nldi(jjc), ' to :',nlei(jjc)
+              WRITE(iumout,*) ' jj /  mask value for all ji'
+              DO jj=nldj(jjc),nlej(jjc)
+                 WRITE(iumout,900) jj,(INT(zmask(ji,jj)),ji=nldi(jjc),nlei(jjc))
+              ENDDO
+900           FORMAT(1x,i4,1x,9(10i1,1x))
+           ENDIF
+        ENDDO
+        WRITE(10,'(a,i5)')'# vides:',ivide
+        DO jjc=1,ivide
+           WRITE(10,'(a,i5)')'# vide ',jjc
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nldiv(jjc)-1+nizoom-1,nlejv(jjc)+1+njzoom -1
+           WRITE(10,'(2i5)')nleiv(jjc)+1+nizoom-1,nldjv(jjc)-1+njzoom -1
+           WRITE(10,'(2i5)') 9999,9999
+        END DO
+
+        ! 
+        ! 
+        ! 4. Recherche de l optimum
+        ! -------------------------
+        !
+        IF(ivide.GT.iptx) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iptx=ivide
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ELSE IF(ivide.EQ.iptx.AND.zperx.LT.zper) THEN
+           iii=jni
+           iij=jnj
+           iiii=ipi
+           iijj=ipj
+           iimoy=imoy
+           zzmin=zmin
+           zzmax=zmax
+           iinf10=inf10
+           iinf30=inf30
+           iinf50=inf50
+           zperx=zper
+        ENDIF
+        !
+        ! 5. Fin de boucle sur le nombre de processeurs
+        ! ---------------------------------------------
+        !
+1000    CONTINUE
+     END DO
+  END DO
+  !
+  !
+  ! 6. Affichage resultat
+  ! ---------------------
+  !
+  IF(in.EQ.0) THEN
+     WRITE(iumout,*) ' le choix n a pas pu etre fait '
+     WRITE(iumout,*)
+     WRITE(iumout,*) 'le nombre de processeurs maximum est insuffisant'
+     STOP 
+  ENDIF
+  WRITE(iumout,*) ' choix optimum'
+  WRITE(iumout,*) ' ============='
+  WRITE(iumout,*) 
+  WRITE(iumout,*) '--> nombre de processeurs ',iii*iij
+  WRITE(iumout,*) ' '
+  WRITE(iumout,*) " jpni=",iii ," jpnj=",iij
+  WRITE(iumout,*) " jpi= ",iiii ," jpj= ",iijj
+  WRITE(iumout,*) 
+  WRITE(iumout,*) ' nombre de processeurs mer   ',iii*iij-iptx
+  WRITE(iumout,*) ' nombre de processeurs terre ',iptx
+  WRITE(iumout,*) ' moyenne de recouvrement     ',float(iimoy)/float(iii*iij-iptx)/float(iiii*iijj)
+  WRITE(iumout,*) ' minimum de recouvrement     ',zzmin
+  WRITE(iumout,*) ' maximum de recouvrement     ',zzmax
+  WRITE(iumout,*) ' nb de p recouvrement < 10 % ',iinf10
+  WRITE(iumout,*) ' nb de p      10 < nb < 30 % ',iinf30-iinf10
+  WRITE(iumout,*) ' nb de p      30 < nb < 50 % ',iinf50-iinf10-iinf30
+  WRITE(iumout,*) ' nombre de points integres   ',(iii*iij-iptx)*iiii*iijj
+  WRITE(iumout,*) ' nbr de pts supplementaires  ',(iii*iij-iptx)*iiii*iijj-jpiglo*jpjglo
+  WRITE(iumout,*) ' % sup                       ',zperx
+  WRITE(iumout,*)
+  !
+  !
+  !
+  STOP
+END PROGRAM mppopt_showproc_nc
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/agulhas
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/agulhas	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/agulhas	(revision 3437)
@@ -0,0 +1,95 @@
+&input_output
+    iom_activated = true 
+/
+
+&coarse_grid_files    
+    parent_coordinate_file = 'coordinates.nc'
+    parent_meshmask_file   = 'meshmask.nc'  
+/    
+    
+&bathymetry    
+    new_topo = true
+    elevation_database = 'bathymetry_meter_ORCA_R05.nc'
+    elevation_name = 'topo'
+    smoothing = true
+    smoothing_factor = 0.6
+    nb_connection_pts = 3    
+    removeclosedseas = true
+    type_bathy_interp = 0 
+/   
+
+&nesting    
+    imin = 125
+    imax = 170
+    jmin = 36
+    jmax = 63
+    rho  = 4									
+    rhot = 2
+    bathy_update = true
+    updated_parent_file = 'bathy_updated.nc'				
+/
+
+&vertical_grid    
+    ppkth = 21.4333619793800
+    ppacr = 3
+    ppdzmin = 0
+    pphmax  = 0
+    psur = -4762.96143546300
+    pa0  = 255.58049070440
+    pa1  = 245.58132232490
+    N  = 31
+/    
+    
+&partial_cells    	
+    partial_steps = true
+    parent_bathy_meter = 'bathy_meter.nc'
+    parent_batmet_name = 'Bathymetry'
+    e3zps_min = 25.
+    e3zps_rat = 0.2
+/
+
+&nemo_coarse_grid    
+    jpizoom = 1			
+    jpjzoom = 1			
+/
+&forcing_files		   
+    U_FILES = 'taux_1m.nc'
+!'dyna_grid_U.nc'                              ! needed for Offline
+    V_FILES =  'tauy_1m.nc'
+!'dyna_grid_V.nc'                              ! needed for Offline
+    FLX_FILES = 
+    'data_1m_salinity_nomask.nc',
+    'data_1m_potential_temperature_nomask.nc',
+    'flx.nc',
+    'geothermal_heating.nc'
+!    'river.orca.nc ',                         ! needed for Pisces
+!    'ndeposition.orca.nc',                    ! needed for Pisces 
+!    'dust.orca.nc',                           ! needed for Pisces 
+!    'bathy.orca.nc'                           ! needed for Pisces
+!'dyna_grid_T.nc',                             ! needed for Offline
+!'dyna_grid_W.nc'                              ! needed for Offline 
+/
+
+&interp
+    VAR_INTERP =
+    'votemper/bicubic',
+    'vosaline/bicubic'
+!    'dust/bilinear',
+!    'riverdic/bilinear',
+!    'riverpoc/bilinear',
+!    'riverdoc/bilinear',
+!    'nedep/bilinear',
+!    'bathy/bilinear'
+/
+
+&restart
+    restart_file = 'restart.nc'   
+    shlat = 0
+    dimg = false
+    dimg_output_file = 'test_dimg'
+    adatrj = 360.25 
+    interp_type = 'bilinear'
+/ 
+&restart_trc
+    restart_trc_file = 'restart_trc.nc'   
+/ 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90	(revision 3437)
@@ -0,0 +1,792 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)	*
+!************************************************************************
+!
+!Smoothing procedures : Pierrick Penven 2004
+!
+MODULE agrif_connect_topo
+  !
+  USE agrif_types
+  !
+  IMPLICIT NONE           
+  !
+CONTAINS
+  !
+  !
+  !************************************************************************
+  ! 									*
+  ! MODULE  CONNECT_TOPO							*
+  !									*
+  ! module containing subroutine used for : 				*
+  !   - Parent-Child bathymetry connection				*
+  !   - Bathymetry smoothing						*
+  !   - Meters to levels conversion					*
+  !   - Parent Bathymetry update 						*
+  !									*
+  !************************************************************************
+  !
+  !****************************************************************
+  !   subroutine init_constant_bathy				*
+  !								*
+  !								*
+  ! - input :							*
+  !     coarse_bathy : coarse grid bathymetry 			*
+  ! - ouput :							*
+  !    bathy_fin_constant : coarse bathymetry on fine grid	*
+  !								*
+  !****************************************************************
+  !
+  SUBROUTINE init_constant_bathy(coarse_bathy,bathy_fin_constant)
+    !       
+    IMPLICIT NONE 
+    !      
+    INTEGER :: i,j,ii,jj,ji
+    INTEGER :: jpt,ipt,diff,indx,indy,bornex,borney,bornex2,borney2
+    INTEGER :: jdeb,ideb,ifin,jfin
+    REAL*8, DIMENSION(:,:)  :: coarse_bathy
+    REAL*8, DIMENSION(:,:),POINTER :: bathy_fin_constant
+    TYPE(Coordinates) :: Grid     
+    !
+    !
+    diff = 0
+    IF(MOD(rho,2) .EQ. 0) diff = 1
+    !
+    indx = 2 + CEILING(irafx/2.0) + diff      
+    indy = 2 + CEILING(irafy/2.0) + diff
+    bornex = nbghostcellsfine + CEILING(irafx/2.0) + diff - irafx
+    borney = nbghostcellsfine + CEILING(irafy/2.0) + diff - irafy
+    bornex2 = nxfin - (nbghostcellsfine-1) + irafx - CEILING(irafx/2.0) 
+    borney2 = nyfin - (nbghostcellsfine-1) + irafy - CEILING(irafy/2.0) 
+    !    
+    ALLOCATE(bathy_fin_constant(bornex-FLOOR(irafx/2.0):bornex2+FLOOR(irafx/2.0), &
+         borney-FLOOR(irafy/2.0):borney2+FLOOR(irafy/2.0)))
+    !
+    DO j = borney,borney2,irafy
+
+       jpt = jmin + 3 - 1 + (j-indy)/irafy
+       IF(j<=1) jpt = jmin + 1
+
+       DO i = bornex,bornex2,irafx
+
+          ipt = imin + 3 - 1 + (i-indx)/irafx
+          IF(i<=1) ipt = imin + 1
+          !       
+          DO jj = j-FLOOR(irafy/2.0),j+FLOOR(irafy/2.0)-diff
+             DO ii = i-FLOOR(irafx/2.0),i+FLOOR(irafx/2.0)-diff
+
+                bathy_fin_constant(ii,jj) = coarse_bathy(ipt,jpt)
+
+             END DO
+          END DO
+
+       END DO
+    END DO
+    !
+    !
+  END SUBROUTINE init_constant_bathy
+  !
+  !****************************************************************
+  !   subroutine meter_to_levels					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE meter_to_levels(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry from etopo to vertical levels'
+    !
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth 
+
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    DO i = 1,N
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
+    !
+    gdepw(1) = 0.0
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4)
+    !
+    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) &
+         ALLOCATE(Grid%bathy_level(jpi,jpj))    
+    !
+    Grid%bathy_level = N-1
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    !
+    !
+    DO j = 1,jpj
+       DO i = 1,jpi
+          !
+          IF (Grid%bathy_meter(i,j) .EQ. 0.0 ) THEN
+             Grid%bathy_level(i,j)=0.
+          ELSE
+             !	
+             k1=4
+             DO WHILE (k1 .LT. (N-1))
+                IF ((Grid%bathy_meter(i,j).GE.gdepw(k1)) &
+                     .AND.(Grid%bathy_meter(i,j).LE.gdepw(k1+1))) EXIT
+                k1=k1+1
+             END DO
+             Grid%bathy_level(i,j)=k1
+             !
+          ENDIF
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE meter_to_levels
+  !
+  !!
+  !****************************************************************
+  !   subroutine levels_to_meter					*
+  !								*
+  ! subroutine to convert bathymetry in meters to bathymetry	*
+  ! in vertical levels						*
+  !								*
+  ! - input/output :						*
+  !     Grid : grid where conversion is required			*
+  !								*
+  !various input parameters come from namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE levels_to_meter(Grid)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax
+    TYPE(Coordinates) :: Grid
+    INTEGER :: i,j
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1,ji,jj,jpi,jpj
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !       
+    WRITE(*,*) 'convert bathymetry in meters for smoothing'
+    !
+    jpi = SIZE(Grid%bathy_level,1)
+    jpj = SIZE(Grid%bathy_level,2)
+    !              
+    !             
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '
+       STOP      
+       !       
+    ENDIF
+    !
+    zacr = ppacr
+    zkth = ppkth 
+
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
+    !
+    gdepw(1) = 0.0  
+    !
+    IF(.NOT. ASSOCIATED(Grid%bathy_meter)) THEN
+       ALLOCATE(Grid%bathy_meter(jpi,jpj))  
+    ELSE
+       IF( ANY(SHAPE(Grid%bathy_meter)/=(/jpi,jpj/)) ) THEN	   
+          DEALLOCATE(Grid%bathy_meter)   
+          ALLOCATE(Grid%bathy_meter(jpi,jpj))     
+       ENDIF
+    ENDIF
+    !      
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          !
+          Grid%bathy_meter(ji,jj) = gdepw( INT( Grid%bathy_level(ji,jj) ) + 1 )
+          !
+       END DO
+    END DO
+    !
+  END SUBROUTINE levels_to_meter
+  !
+
+  !****************************************************************
+  !   subroutine smooth_topo					*
+  !								*
+  ! subroutine to smooth a given bathymetry (in meters)		*
+  !  hanning filter is used (smoothing criterion : rfactor)	*
+  !								*
+  ! - input/output :						*
+  !     h : bathymetry						*
+  !								*
+  !various input parameters are stored in namelist.input files	*
+  !****************************************************************
+  !
+  SUBROUTINE smooth_topo(h,nbiter)
+    !
+    IMPLICIT NONE
+    ! 
+    REAL*8, DIMENSION(:,:) :: h
+    REAL*8 :: hmin,cff,nu,r
+    REAL*8, DIMENSION(:,:), ALLOCATABLE :: rx,ry,cx,cy,f_x,f_y
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,nbiter,i,j
+    REAL*8,DIMENSION(:,:),ALLOCATABLE :: maskedtopo
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)     
+    !       
+    ALLOCATE(cx(M,L),cy(M,L))
+    ALLOCATE(rx(M,L),ry(M,L))
+    ALLOCATE(f_x(M,L),f_y(M,L))
+    ALLOCATE(maskedtopo(M,L))
+    !
+    WRITE(*,*) ''
+    WRITE(*,*) 'smooth the topography (Hanning filter)'
+    WRITE(*,*) 'slope parameter = ',smoothing_factor
+    !
+    hmin = 1.1
+    WHERE(h <= hmin)
+       h = hmin
+    END WHERE
+    !       
+    WHERE (h == hmin)
+       maskedtopo = 0.
+    ELSEWHERE
+       maskedtopo = 1.
+    END WHERE
+    !
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    cff = 0.8
+    nu = 3.0/16.0
+    rx=0.
+    ry=0.      
+    CALL rfact(h,rx,ry,maskedtopo)    
+    r = MAX(MAXVAL(rx),MAXVAL(ry))
+    h = LOG(h)         
+    nbiter = 0
+    !       
+    DO WHILE (r.GT.smoothing_factor .AND. nbiter < 500  )         
+       !       
+       nbiter=nbiter+1       
+       WHERE(rx > cff*smoothing_factor)
+          cx = 1
+       ELSEWHERE
+          cx = 0
+       END WHERE
+       CALL hanningx(cx,maskedtopo)      
+       WHERE(ry > cff*smoothing_factor)
+          cy = 1
+       ELSEWHERE
+          cy = 0
+       END WHERE
+       CALL hanningy(cy,maskedtopo)      
+       CALL FX(h,f_x,cx,maskedtopo)
+       CALL FY(h,f_y,cy,maskedtopo)       
+       h(2:Mm,2:Lm) = h(2:Mm,2:Lm) + maskedtopo(2:Mm,2:Lm)*nu *                 &
+            ((f_x(2:Mm,3:L)-f_x(2:Mm,2:Lm)) + &     
+            (f_y(3:M,2:Lm)-f_y(2:Mm,2:Lm)))       
+       CALL rfact(EXP(h),rx,ry,maskedtopo)
+       r = MAX(MAXVAL(rx(2:Mm,2:L)),MAXVAL(ry(2:M,2:Lm)))
+       !
+    END DO
+    !       
+    WRITE(*,*) 'iterations = ',nbiter
+    WRITE(*,*) ''
+    h = EXP(h)               
+    WHERE( ABS(h-hmin) <= 0.001 )
+       h = 0.
+    END WHERE
+    DEALLOCATE(rx,ry,cx,cy,f_x,f_y,maskedtopo)
+    !
+  END SUBROUTINE smooth_topo
+  !       
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanning(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !      
+    h(2:Mm,2:Lm) = maskedtopo(2:Mm,2:Lm)*0.125*(   h(1:Mmm,2:Lm) + &
+         h(3:M,2:Lm)   + &
+         h(2:Mm,1:Lmm) + &
+         h(2:Mm,3:L)   + &
+         4*h(2:Mm,2:Lm))+(1.-maskedtopo(2:Mm,2:Lm))*h(2:Mm,2:Lm)
+    !
+  END SUBROUTINE hanning
+  !      
+  !************************************************************************
+  ! subroutine hanningx(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningx(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h      
+    DO j=3,Lm
+       DO i=2,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+    j=2
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    j=L
+    DO i=2,Mm
+       IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i+1,j)+htemp(i-1,j)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningx
+
+  !************************************************************************
+  ! subroutine hanning(bathy_meter)
+  !************************************************************************
+  !
+  SUBROUTINE hanningy(h,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,maskedtopo
+    REAL*8, DIMENSION(:,:), ALLOCATABLE ::  htemp 
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L
+    INTEGER :: i,j
+    !      
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1      
+    ALLOCATE(htemp(M,L))
+    !      
+    htemp = h
+
+    DO j=2,Lm
+       DO i=3,Mm
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+             h(i,j)=0.125*(htemp(i-1,j)+htemp(i+1,j) &
+                  +htemp(i,j+1)+htemp(i,j-1)+4.*htemp(i,j))
+          ENDIF
+       ENDDO
+    ENDDO
+
+    i=2
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    i=M
+    DO j=2,Lm
+       IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .NE.0.) THEN
+          h(i,j)=0.25*(htemp(i,j+1)+htemp(i,j-1)+2.*htemp(i,j))
+       ENDIF
+    ENDDO
+
+    DEALLOCATE(htemp)
+    !
+  END SUBROUTINE hanningy
+
+  !      
+  !************************************************************************
+  ! subroutine FX(bathy_meter,fx)
+  !************************************************************************
+  !
+  SUBROUTINE FX(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h,c
+    REAL*8, DIMENSION(:,:)  :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    !
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    !
+    f = 0.0     
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    floc = 0.  
+
+    DO j=2,L
+       DO i=1,M
+
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)).EQ.0.) THEN
+             floc(i,j)=0.
+          ELSEIF ((i.EQ.1).OR.(i.EQ.M)) THEN     
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))              
+          ELSEIF ((maskedtopo(i-1,j)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))    
+          ELSEIF ((maskedtopo(i+1,j)*maskedtopo(i+1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i,j-1))       
+          ELSE               
+             floc(i,j)=(5./12.)*(h(i,j)-h(i,j-1)) &
+                  +(1./12.)*(h(i-1,j)-h(i-1,j-1)+h(i+1,j)-h(i+1,j-1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !      
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !           	       
+    !
+  END SUBROUTINE FX
+  !
+  !
+  !      
+  !************************************************************************
+  ! subroutine FY(bathy_meter,fy)
+  !************************************************************************
+  !
+  SUBROUTINE FY(h,f,c,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:) :: h,c
+    REAL*8, DIMENSION(:,:) :: f,maskedtopo
+    REAL*8, DIMENSION(SIZE(h,1),SIZE(h,2))  :: floc
+    INTEGER :: Mm,Mmm,Lm,Lmm,M,L,i,j
+    f=0.0 
+    !            
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    floc = 0.
+
+    DO j=1,L
+       DO i=2,M
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)).EQ.0.) THEN
+             floc(i,j) = 0.
+          ELSEIF ((j.EQ.1).OR.(j.EQ.L)) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j-1)*maskedtopo(i-1,j-1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSEIF ((maskedtopo(i,j+1)*maskedtopo(i-1,j+1)).EQ.0.) THEN
+             floc(i,j)=(7./12.)*(h(i,j)-h(i-1,j))
+          ELSE      
+             floc(i,j)=(5./12.)*(h(i,j)-h(i-1,j)) &
+                  +(1./12.)*(h(i,j-1)-h(i-1,j-1)+h(i,j+1)-h(i-1,j+1))
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j = 1,L
+       DO i = 1,M
+          f(i,j) = c(i,j)*floc(i,j) 
+       END DO
+    END DO
+    !      
+  END SUBROUTINE FY
+  !
+  !
+  !****************************************************************
+  !   subroutine rfact						*
+  !								*
+  ! subroutine to check if smoothing criterion 			*
+  !                     is verified everywhere			*
+  !								*
+  ! - input :							*
+  !     h : bathymetry						*
+  ! - ouput :							*
+  !    rx,ry : delta(theta)/theta in x and y directions		*
+  !****************************************************************
+  !
+  SUBROUTINE rfact(h,rx,ry,maskedtopo)
+    !
+    IMPLICIT NONE
+    !
+    REAL*8, DIMENSION(:,:)  :: h
+    REAL*8, DIMENSION(:,:)  :: rx,ry
+    REAL*8, DIMENSION(:,:)  :: maskedtopo
+    INTEGER M,L,i,j,Mm,Mmm,Lm,Lmm
+    !
+    M = SIZE(h,1)
+    L = SIZE(h,2)
+    Mm = M-1
+    Mmm = Mm - 1
+    Lm = L-1
+    Lmm = Lm - 1
+    !
+    rx=0.
+    ry=0.
+    !      
+    DO j=2,L
+       DO i=1,M	     
+          rx(i,j) = ABS(h(i,j)-h(i,j-1))/(h(i,j)+h(i,j-1))
+          IF ((maskedtopo(i,j)*maskedtopo(i,j-1)) .EQ.0.) THEN
+             rx(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+    DO j=1,L
+       DO i=2,M
+          ry(i,j) = ABS(h(i,j)-h(i-1,j))/(h(i,j)+h(i-1,j))
+          IF ((maskedtopo(i,j)*maskedtopo(i-1,j)) .EQ.0.) THEN
+             ry(i,j)=0.
+          ENDIF
+       ENDDO
+    ENDDO
+    !
+  END SUBROUTINE rfact
+  !
+  !
+  !****************************************************************
+  !   subroutine Update_Parent_Bathy				*
+  !								*
+  ! (if desired) subroutine to update parent grid bathymetry	*
+  ! for consistency with fine grid bathymetry			*
+  !								*
+  ! if a given coarse grid point is masked and one of the		*
+  ! child grid points contained in this coarse cell is not masked	*
+  ! the corresponding coarse grid point is unmasked with gdepw(4) *
+  ! value								*
+  !								*
+  ! - input :							*
+  !     G0,G1 : both grids involved				*
+  ! - ouput :							*
+  !    G0 parent grid containing updated bathymetry		*
+  !****************************************************************
+  !
+  !
+  SUBROUTINE Update_Parent_Bathy( G0,G1 )
+    !
+    IMPLICIT NONE
+
+    TYPE(coordinates) :: G0,G1
+    INTEGER :: ji,jj,jk,ipt,jpt,diff,indx,indy,bornex,borney,bornex2,borney2
+    !
+    INTEGER :: ideb,jdeb,ifin,jfin
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin
+    INTEGER :: i,j
+    INTEGER :: k1
+    INTEGER :: compt
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    !                     
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' ' 
+       STOP     
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth 
+
+    !
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+    END DO
+    !
+    zmin = gdepw(4)
+    !      
+    diff = 0
+    IF(MOD(rho,2) .EQ. 0) diff = 1
+
+    ideb = 3 + (irafx - 1)/2
+    jdeb = 3 + (irafy - 1)/2
+
+    jfin = nyfin - 2 - (irafy)/2
+    ifin = nxfin - 2 - (irafx)/2
+    !
+    WRITE(*,*) '---------------------------------'
+    WRITE(*,*) 'Parent grid bathymetry update ...'
+    compt = 0
+    !
+    DO jj = jdeb,jfin,irafy
+       jpt = jmin + 3 - 1 + (jj - jdeb) / irafy
+       DO ji = ideb,ifin,irafx
+          ipt = imin + 3 - 1 + (ji - ideb) / irafx
+          !
+          IF( G0%Bathy_meter(ipt,jpt) .LE. 0. .AND.                      &
+               MAXVAL(G1%Bathy_meter(ji-irafx/2+diff:ji+irafx/2, &
+               jj-irafy/2+diff:jj+irafy/2)).GT. 0.  ) THEN
+             G0%Bathy_meter(ipt,jpt) = zmin
+             !
+             compt = compt + 1
+             !
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+    !
+    WRITE(*,*) ' Number of coarse grid points updated = ',compt
+    WRITE(*,*) '---------------------------------'
+    !      
+  END SUBROUTINE Update_Parent_Bathy
+
+END MODULE agrif_connect_topo
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_bathy.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_coordinates.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_data.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart.f90	(revision 3437)
@@ -0,0 +1,982 @@
+!
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemari�(Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!
+PROGRAM create_rstrt
+  !
+  USE NETCDF
+  USE bilinear_interp
+  USE bicubic_interp
+  USE agrif_readwrite
+  USE io_netcdf 
+  USE agrif_extrapolation
+  USE agrif_interpolation
+  USE agrif_partial_steps        
+  !
+  IMPLICIT NONE
+  !
+  !************************************************************************
+  ! 									*
+  ! PROGRAM  CREATE_RSTRT							*
+  !									*
+  ! program to interpolate parent grid restart file to child grid		*
+  !									*
+  !									*
+  !Interpolation is carried out using bilinear interpolation		*
+  !routine from SCRIP package						*		
+  !									*
+  !http://climate.lanl.gov/Software/SCRIP/				*
+  !************************************************************************
+  !
+  ! variables declaration
+  !      
+  CHARACTER*20,DIMENSION(:),POINTER :: Ncdf_varname => NULL()
+  CHARACTER*20 :: vert_coord_name
+  CHARACTER*1 :: posvar
+  CHARACTER*100 :: Child_file,Childcoordinates,varname,Childbathy,Childbathymeter   
+  REAL*8, POINTER, DIMENSION(:,:) :: lonChild,latChild => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: lonParent,latParent => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: tabvar3d,tabinterp3d,mask => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:) :: fmask,fse3u,fse3v,fse3t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: un,ub,vn,vb,tn,tb => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: sshn,sshb,sb,sn,gcx,gcxb => NULL()      
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabinterp4d,tabvar1,tabvar2,tabvar3 => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: rotn,rotb,hdivn,hdivb => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: timedepth_temp => NULL()
+  REAL*8, POINTER, DIMENSION(:) :: tabtemp1D,nav_lev => NULL()
+  INTEGER, POINTER, DIMENSION(:) :: tabtemp1DInt => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: tabtemp2D,zwf => NULL()
+  REAL*8, POINTER, DIMENSION(:,:) :: e1f,e2f,e1v,e2v,e1u,e2u,e1t,e2t => NULL()
+  REAL*8, POINTER, DIMENSION(:,:,:,:) :: tabtemp4D => NULL()
+  INTEGER,DIMENSION(:),POINTER :: src_add,dst_add  => NULL()
+  REAL*8,DIMENSION(:,:),POINTER :: matrix,bathy_G0 => NULL()
+  LOGICAL,DIMENSION(:,:,:),POINTER :: Tmask => NULL()
+  LOGICAL,DIMENSION(:,:),POINTER :: masksrc => NULL()
+  LOGICAL, DIMENSION(:,:,:), POINTER :: detected_pts
+  LOGICAL :: Interpolation,Extrapolation,Pacifique,op
+  REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp       
+  INTEGER :: narg,iargc,ncid,x,y,t,z,z_a,x_a,y_a,z_b,nbvert_lev,m
+  REAL*8 :: now_wght,before_wght
+  INTEGER :: i,j,k,status,ji,jj
+  CHARACTER(len=20),DIMENSION(4) :: dimnames
+  CHARACTER(len=80) :: namelistname
+  TYPE(Coordinates) :: G0,G1
+  INTEGER :: jpi,jpj,jpk,jpni,jpnj,jpnij,jpiglo,jpjglo,nlcit,nlcjt,nldit
+  INTEGER :: nldjt,nleit,nlejt,nimppt,njmppt
+  REAL*8 :: tabtemp0dreal
+  INTEGER :: tabtemp0dint
+  CHARACTER(len=20) :: timedimname
+
+  !      
+  ! Variables for dimg
+  ! 
+  INTEGER :: ino0, it0, ipcg0, isor0, itke0,nfice,nfbulk
+  INTEGER :: irecl8, irec,ndastp,narea,nsolv
+  INTEGER :: jk,kt            ! dummy loop indices
+  INTEGER :: inum             ! temporary logical unit
+  INTEGER :: ios1 , ios2      ! flag for ice and bulk in the current run
+  INTEGER :: ios3             ! flag for free surface.  0 = none 1 = yes.  0 = none 1 = yes
+  INTEGER :: ios4             ! flag for coupled (1) or not (0)    
+  !       
+  narg = iargc()
+  IF (narg == 0) THEN
+     namelistname = 'namelist.input'
+  ELSE
+     CALL getarg(1,namelistname)
+  ENDIF
+  !
+  ! read input file
+  !
+  CALL read_namelist(namelistname)
+  !      
+  IF(TRIM(restart_file) == '/NULL') THEN
+     WRITE(*,*) 'no restart file specified in ',TRIM(namelistname)
+     STOP
+  END IF
+
+  IF (iom_activated) THEN
+     timedimname = 't'
+  ELSE
+     timedimname='time'
+  ENDIF
+
+  !
+  WRITE(*,*) ''
+  WRITE(*,*) 'Interpolation of restart file : ',TRIM(restart_file)
+  WRITE(*,*) ''
+  !
+  CALL Read_Ncdf_VarName(restart_file,Ncdf_varname)
+  !       
+  CALL set_child_name(parent_coordinate_file,Childcoordinates)   
+  CALL set_child_name(parent_meshmask_file,Childbathy) 
+  CALL set_child_name(parent_bathy_meter,Childbathymeter)   
+  !
+  ! create this file
+  !
+  IF( .NOT. dimg ) THEN           
+     CALL set_child_name(restart_file,Child_file)
+     status = nf90_create(Child_file,NF90_WRITE,ncid)
+     status = nf90_close(ncid)
+     WRITE(*,*) 'Child grid restart file name = ',TRIM(Child_file)      
+     WRITE(*,*) ''
+  ENDIF
+
+  ! 
+  ! read dimensions in parent restart file
+  !
+  CALL Read_Ncdf_dim('x',restart_file,x)
+  CALL Read_Ncdf_dim('y',restart_file,y) 
+  CALL Read_Ncdf_dim('z',restart_file,z)
+  CALL Read_Ncdf_dim('x_a',restart_file,x_a)
+  CALL Read_Ncdf_dim('y_a',restart_file,y_a)
+  CALL Read_Ncdf_dim('z_a',restart_file,z_a)
+  CALL Read_Ncdf_dim('z_b',restart_file,z_b)
+
+  IF( z .NE. N ) THEN
+     WRITE(*,*) '***'
+     WRITE(*,*) 'Number of vertical levels doesn t match between namelist and restart file'
+     WRITE(*,*) 'Please check the values in namelist file'
+     STOP
+  ENDIF
+  !
+  ! mask initialization for extrapolation and interpolation
+  ! 
+  WRITE(*,*) 'mask initialisation on coarse and fine grids'
+  !           
+  status = Read_Local_Coordinates(parent_coordinate_file,G0,(/jpizoom,jpjzoom/),(/x,y/))
+  status = Read_Coordinates(Childcoordinates,G1,Pacifique)
+  !
+  !longitude modification if child domain covers Pacific ocean area
+  !      
+  IF( Pacifique ) THEN
+     !
+     WHERE( G0%nav_lon < 0 )
+        G0%nav_lon = G0%nav_lon + 360.
+     END WHERE
+     !              
+     WHERE( G1%nav_lon < 0 )
+        G1%nav_lon = G1%nav_lon + 360.
+     END WHERE
+     !
+  ENDIF
+  !
+  CALL Init_mask(parent_meshmask_file,G0,x,y)
+  CALL Init_mask(childbathy,G1,1,1)
+
+  G0%tmask = 1.    
+
+  DO k=1,z
+     ALLOCATE(tabvar1(x,y,1,1))
+     CALL Read_Ncdf_var('sn',TRIM(restart_file),tabvar1,1,k)
+     WHERE( tabvar1(:,:,1,1) == 0. ) 
+        G0%tmask(:,:,k) = 0.
+     END WHERE
+     DEALLOCATE(tabvar1)
+  END DO
+  !
+  G0%umask(1:x-1,:,:) = G0%tmask(1:x-1,:,:)*G0%tmask(2:x,:,:)
+  G0%vmask(:,1:y-1,:) = G0%tmask(:,1:y-1,:)*G0%tmask(:,2:y,:)
+  !
+  G0%umask(x,:,:) = G0%tmask(x,:,:)
+  G0%vmask(:,y,:) = G0%tmask(:,y,:)
+  !      
+  G0%fmask(1:x-1,1:y-1,:) = G0%tmask(1:x-1,1:y-1,:)*G0%tmask(2:x,1:y-1,:)* &
+       G0%tmask(1:x-1,2:y,:)*G0%tmask(2:x,2:y,:) 
+  !
+  G0%fmask(x,:,:) = G0%tmask(x,:,:)
+  G0%fmask(:,y,:) = G0%tmask(:,y,:)
+  !
+  !   *****   ***  **   ** ******
+  !   *    *   *   * * * * *
+  !   *    *   *   *  *  * *  ***
+  !   *    *   *   *     * *    *
+  !   *****   ***  *     * ******
+  !
+  IF(dimg) THEN
+     !        
+     WRITE(*,*) 'create dimg restart file'
+     DO m = 7,1000 
+        INQUIRE(Unit=inum,Opened=op)
+        IF( .NOT. op ) THEN
+           inum = m
+           EXIT
+        ENDIF
+     ENDDO
+     !
+     inum = 11
+     irecl8 = nxfin * nyfin * 8
+     OPEN(inum,FILE=TRIM(dimg_output_file),FORM='UNFORMATTED',  &
+          ACCESS='DIRECT',RECL=irecl8)
+     !       
+     CALL Read_Ncdf_var('info',TRIM(restart_file),tabtemp4D)    
+     !        
+     ino0 = NINT(tabtemp4D(1,1,1,1))
+     it0 = NINT(tabtemp4D(1,1,2,1))*rhot
+     WRITE(*,*) 'restart file created for kt = ',it0
+     ipcg0 = NINT(tabtemp4D(1,1,3,1))
+     isor0 = NINT(tabtemp4D(1,1,4,1))
+     itke0 = 0
+     IF(tabtemp4D(1,1,5,1)==1.) itke0 = 1 
+     ndastp = NINT(tabtemp4D(1,1,6,1))
+     ! number of elapsed days since the begining of the run              
+     !
+     DEALLOCATE(tabtemp4D)
+     !
+     IF (isor0 + 1 == 3) THEN 
+        isor0 = 2
+        ipcg0 = 2
+     ENDIF
+     !        
+     CALL Read_Ncdf_var('nfice',TRIM(restart_file),tabtemp4D)     
+     nfice = NINT(tabtemp4D(1,1,1,1))
+     DEALLOCATE(tabtemp4D)
+     !
+     CALL Read_Ncdf_var('nfbulk',TRIM(restart_file),tabtemp4D)     
+     nfbulk = NINT(tabtemp4D(1,1,1,1))
+     DEALLOCATE(tabtemp4D)
+     !
+     nfice = 5
+     nfbulk = 5
+     !
+     ios1 = 0
+     ios2 = 0
+     ios3 = 1          ! flag for free surface.  0 = none 1 = yes.  0
+     ios4 = 0
+     narea = 1
+     jpi = nxfin
+     jpj = nyfin
+     jpk = z
+     jpni = 1
+     jpnj = 1
+     jpnij = 1
+     narea = 1
+     jpiglo = nxfin
+     jpjglo = nyfin
+     nlcit = nxfin
+     nlcjt = nyfin
+     nldit = 1
+     nldjt = 1
+     nleit = nxfin
+     nlejt = nyfin
+     nimppt = 1
+     njmppt = 1
+     !
+     PRINT*,'jpi = ',jpi
+     PRINT*,'jpj = ',jpj
+     PRINT*,'jpk = ',jpk
+     PRINT*,'nfice = ',nfice
+     PRINT*,'nfbulk = ',nfbulk
+     PRINT*,'ndastp = ',ndastp
+     !
+     WRITE(inum,REC=1) irecl8, ino0, it0, isor0, ipcg0, itke0, &
+          nfice, nfbulk , ios1, ios2, ios3, ios4, &
+          ndastp, adatrj, jpi, jpj, jpk,  &
+          jpni, jpnj, jpnij, narea, jpiglo, jpjglo, &
+          nlcit, nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt
+     !          
+     irec = 2
+     !
+     !   *****    *****    ******
+     !   *        *    *   *   
+     !   *        *    *   *** 
+     !   *        *    *   *   
+     !   *****    *****    *  
+     !
+  ELSE
+
+
+     !
+     ! write dimensions in output file
+     !          
+     CALL Write_Ncdf_dim('x',Child_file,nxfin)
+     CALL Write_Ncdf_dim('y',Child_file,nyfin)
+     CALL Write_Ncdf_dim('z',Child_file,z)
+     CALL Write_Ncdf_dim(TRIM(timedimname),Child_file,0) 
+     IF (.NOT.iom_activated) THEN
+        CALL Write_Ncdf_dim('x_a',Child_file,x_a)
+        CALL Write_Ncdf_dim('y_a',Child_file,y_a)
+        CALL Write_Ncdf_dim('z_a',Child_file,z_a)
+        CALL Write_Ncdf_dim('z_b',Child_file,z_b)
+     ENDIF
+     !
+     !
+  ENDIF
+
+
+
+
+
+
+  !
+  !
+  !
+  DO i = 1,SIZE(Ncdf_varname)      
+     !      
+     ! loop on variables names
+     !      
+     SELECT CASE (TRIM(Ncdf_varname(i)))
+        !
+        !copy nav_lon from child coordinates to output file      
+        !
+     CASE('nav_lon')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy nav_lon'
+           CALL Read_Ncdf_var('nav_lon',TRIM(Childcoordinates),tabtemp2D) 
+           CALL Write_Ncdf_var('nav_lon',(/'x','y'/),Child_file,tabtemp2D,'float')
+           CALL Copy_Ncdf_att('nav_lon',TRIM(restart_file),Child_file, &
+                MINVAL(tabtemp2D),MAXVAL(tabtemp2D))
+           DEALLOCATE(tabtemp2D)
+           Interpolation = .FALSE.
+        ENDIF
+        !	     
+        !copy nav_lat from child coordinates to output file
+        !
+     CASE('nav_lat')             
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy nav_lat'
+           CALL Read_Ncdf_var('nav_lat',TRIM(Childcoordinates),tabtemp2D) 
+           CALL Write_Ncdf_var('nav_lat',(/'x','y'/),Child_file,tabtemp2D,'float')
+           CALL Copy_Ncdf_att('nav_lat',TRIM(restart_file),Child_file, &
+                MINVAL(tabtemp2D),MAXVAL(tabtemp2D)) 
+           DEALLOCATE(tabtemp2D)
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        !copy nav_lev from restart_file to output file
+        !
+     CASE('nav_lev')
+
+        WRITE(*,*) 'copy nav_lev'
+        CALL Read_Ncdf_var('nav_lev',TRIM(restart_file),nav_lev) 
+        IF(.NOT. dimg ) THEN
+           CALL Write_Ncdf_var('nav_lev','z',Child_file,nav_lev,'float')
+           CALL Copy_Ncdf_att('nav_lev',TRIM(restart_file),Child_file)      
+        ENDIF
+        Interpolation = .FALSE.
+        !
+        !copy time from restart_file to output file                       
+        !
+     CASE('time')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time'
+           CALL Read_Ncdf_var('time',TRIM(restart_file),tabtemp1D) 
+           CALL Write_Ncdf_var('time',TRIM(timedimname),Child_file,tabtemp1D,'float')
+           CALL Copy_Ncdf_att('time',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1D)
+           Interpolation = .FALSE.
+        ENDIF
+        !copy time from restart_file to output file                       
+        !
+     CASE('time_counter')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time_counter'
+           CALL Read_Ncdf_var('time_counter',TRIM(restart_file),tabtemp1D) 
+           tabtemp1D = tabtemp1D * rhot
+           CALL Write_Ncdf_var('time_counter',TRIM(timedimname),Child_file,tabtemp1D,'double')
+           CALL Copy_Ncdf_att('time_counter',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1D)
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        !copy time_steps from restart_file to output file             
+        !
+     CASE('time_steps')
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy time_steps'
+           CALL Read_Ncdf_var('time_steps',TRIM(restart_file),tabtemp1DInt) 
+           CALL Write_Ncdf_var('time_steps',TRIM(timedimname),Child_file,tabtemp1DInt)
+           CALL Copy_Ncdf_att('time_steps',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp1DInt)
+           Interpolation = .FALSE.    
+        ENDIF
+        !
+        !copy info from restart_file to output file
+        !
+     CASE('info') 
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy info'        
+           CALL Read_Ncdf_var('info',TRIM(restart_file),tabtemp4D) 
+           dimnames(1)='x_a'
+           dimnames(2)='y_a'
+           dimnames(3)='z_a'
+           dimnames(4)=TRIM(timedimname)            
+           CALL Write_Ncdf_var('info',dimnames,Child_file,tabtemp4D,'double')
+           CALL Copy_Ncdf_att('info',TRIM(restart_file),Child_file) 
+           DEALLOCATE(tabtemp4D)
+           Interpolation = .FALSE. 
+        ENDIF
+        !
+     CASE('nfice','nfbulk','kt','ndastp','adatrj','rdt','rdttra1') 
+        IF(.NOT. dimg ) THEN
+           WRITE(*,*) 'copy ',TRIM(Ncdf_varname(i))
+           IF (iom_activated) THEN
+              CALL Read_Ncdf_var(TRIM(Ncdf_varname(i)),TRIM(restart_file),tabtemp0dreal)  
+              SELECT CASE (TRIM(Ncdf_varname(i)))
+              CASE('rdt','rdttra1')
+                 tabtemp0dreal = tabtemp0dreal/rhot
+              CASE('kt')
+                 tabtemp0dreal = tabtemp0dreal * rhot
+              END SELECT
+              CALL Write_Ncdf_var(TRIM(Ncdf_varname(i)),Child_file,tabtemp0dreal,'double')
+           ELSE
+              CALL Read_Ncdf_var(TRIM(Ncdf_varname(i)),TRIM(restart_file),tabtemp4D) 
+              dimnames(1)='x_a'
+              dimnames(2)='y_a'
+              dimnames(3)='z_b'
+              dimnames(4)=TRIM(timedimname)            
+              CALL Write_Ncdf_var(TRIM(Ncdf_varname(i)),dimnames,Child_file,tabtemp4D,'double')
+	      DEALLOCATE(tabtemp4D)
+           ENDIF
+           CALL Copy_Ncdf_att(TRIM(Ncdf_varname(i)),TRIM(restart_file),Child_file) 
+           Interpolation = .FALSE.
+        ENDIF
+        !
+        ! Variable interpolation according to their position on grid
+        !                                   
+     CASE('un','ub')  
+        varname = Ncdf_varname(i)
+
+        IF(TRIM(varname)=='un') irec = 6 * z + 2
+        IF(TRIM(varname)=='ub') irec = 2
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'    
+        vert_coord_name = 'z'             
+        posvar='U'
+        Interpolation = .TRUE.  
+        !
+     CASE('u_io')  
+        varname = Ncdf_varname(i)  
+        WRITE(*,*) TRIM(varname),'interpolation ...'    
+        vert_coord_name = 'z_b'             
+        posvar='U'
+        Interpolation = .TRUE. 
+        !                          
+     CASE('vn','vb')
+        varname = Ncdf_varname(i)
+
+        IF(TRIM(varname)=='vn') irec = 7 * z + 2
+        IF(TRIM(varname)=='vb') irec = 2 + z
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'      
+        vert_coord_name = 'z'
+        posvar='V'
+        Interpolation = .TRUE.     
+        !              
+     CASE('v_io')
+        varname = Ncdf_varname(i)
+        WRITE(*,*) TRIM(varname),'interpolation ...'      
+        vert_coord_name = 'z_b'
+        posvar='V'
+        Interpolation = .TRUE.
+        !             
+     CASE('gcx','gcxb','sshb','sshn','sst_io','sss_io','gsst')
+        varname = Ncdf_varname(i)    
+
+        IF(TRIM(varname)=='gcx') irec = 12 * z + 2
+        IF(TRIM(varname)=='gcxb')  irec = 12 * z + 3
+        IF(TRIM(varname)=='sshb') irec = 12 * z + 4
+        IF(TRIM(varname)=='sshn') irec = 12 * z + 5
+
+        WRITE(*,*) TRIM(varname),'interpolation ...' 
+        vert_coord_name = 'z_b'             
+        posvar='T'
+        Interpolation = .TRUE.     
+
+        !  
+     CASE ('tb','sb','sn','tn')
+        varname = Ncdf_varname(i) 
+
+        IF(TRIM(varname)=='sn') irec = 9 * z + 2
+        IF(TRIM(varname)=='tn') irec = 8 * z + 2
+        IF(TRIM(varname)=='sb') irec = 3 * z + 2
+        IF(TRIM(varname)=='tb') irec = 2 * z + 2
+
+        WRITE(*,*) TRIM(varname),'interpolation ...'     
+        vert_coord_name = 'z'
+        posvar='T'
+        Interpolation = .TRUE.            
+
+     CASE('en')
+        varname = Ncdf_varname(i) 
+        irec = 12 * z + 6
+        WRITE(*,*) TRIM(varname),'interpolation ...'     
+        vert_coord_name = 'z'
+        posvar='T'
+        Interpolation = .TRUE.             
+
+     CASE ('rotb','rotn','hdivb','hdivn')
+        Interpolation = .FALSE.
+        !
+     END SELECT
+     !      
+     IF( Interpolation ) THEN
+        !		  
+        IF( vert_coord_name == 'z') THEN
+           nbvert_lev = z 
+        ELSE IF( vert_coord_name == 'z_b') THEN
+           IF (iom_activated) THEN
+              nbvert_lev=1
+           ELSE
+              nbvert_lev = z_b
+           ENDIF
+        END IF
+        !                  
+
+        !
+        t = 1
+
+        ALLOCATE(detected_pts(SIZE(G0%tmask,1),SIZE(G0%tmask,2),nbvert_lev))                             
+        ALLOCATE(tabvar1(x,y,1,2))
+        ALLOCATE(tabvar2(x,y,1,1))
+        ALLOCATE(tabvar3(x,y,1,1))
+        ALLOCATE(masksrc(x,y))
+        ALLOCATE(tabinterp4d(nxfin,nyfin,1,1)) 
+
+        !	    
+        DO n = 1,nbvert_lev
+           !
+           WRITE(*,*) 'interpolate/extrapolate ', &
+                TRIM(varname),' for vertical level = ',n   
+           !                           
+           !                                                       
+           !                            If(n==1) then
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)    
+           !                            else if (n==2) then
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar2,t,n-1)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)            
+           !                            else 
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar3,t,n-2)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar2,t,n-1)
+           !                                      Call Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)
+           !                            endif                                                        	                  
+           !
+           CALL Read_Ncdf_var(varname,TRIM(restart_file),tabvar1,t,n)
+           IF(n==1) THEN
+              !                            
+           ELSE IF (n==2) THEN
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+           ELSE
+              tabvar3(:,:,:,1) = tabvar2(:,:,:,1)
+              tabvar2(:,:,:,1) = tabvar1(:,:,:,2)
+
+           ENDIF
+           !                            
+           SELECT CASE(posvar)
+              ! 
+           CASE('T')
+              !
+              IF(MAXVAL(G1%tmask(:,:,n)) == 0.) THEN		      
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n                     
+              ELSE		       		      
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n)                                            
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n)                                 
+
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%nav_lat,G1%nav_lat, &
+                         G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%nav_lat,G1%nav_lat, &
+                         G0%nav_lon,G1%nav_lon,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add) 
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1t,G0%e2t,G1%e1t,G1%e2t,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%tmask(:,:,n)
+              !
+           CASE('U')
+              !
+              IF(MAXVAL(G1%umask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n  
+              ELSE		
+                 !
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'U')  
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n,'U')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiu,G1%gphiu,   &
+                         G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiu,G1%gphiu,   &
+                         G0%glamu,G1%glamu,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1u,G0%e2u,G1%e1u,G1%e2u,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%umask(:,:,n)
+              !
+           CASE('V')
+              !		
+              IF(MAXVAL(G1%vmask(:,:,n)) == 0) THEN
+                 tabinterp4d = 0.0
+                 WRITE(*,*) 'only land points on level ',n 
+              ELSE		
+                 !
+
+                 CALL extrap_detect(G0,G1,detected_pts(:,:,n),n,'V')
+
+                 CALL correct_field(detected_pts(:,:,n),tabvar1,tabvar2,&
+                      tabvar3,G0,nav_lev,masksrc,n,'V')
+                 !                                                           
+                 SELECT CASE(TRIM(interp_type))
+                 CASE('bilinear')                                                       
+                    CALL get_remap_matrix(G0%gphiv,G1%gphiv,   &
+                         G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_remap(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1),nxfin,nyfin, &
+                         matrix,src_add,dst_add)     
+                 CASE('bicubic')                                   
+                    CALL get_remap_bicub(G0%gphiv,G1%gphiv,   &
+                         G0%glamv,G1%glamv,masksrc,matrix,src_add,dst_add)
+                    CALL make_bicubic_remap(tabvar1(:,:,1,1),masksrc,tabinterp4d(:,:,1,1),&
+                         nxfin,nyfin,matrix,src_add,dst_add)                        
+                 END SELECT
+                 !                      
+                 CALL Correctforconservation(tabvar1(:,:,1,1),tabinterp4d(:,:,1,1), &
+                      G0%e1v,G0%e2v,G1%e1v,G1%e2v,nxfin,nyfin,posvar,imin-jpizoom+1,jmin-jpjzoom+1)
+
+              ENDIF
+
+              tabinterp4d(:,:,1,1) =  tabinterp4d(:,:,1,1) * G1%vmask(:,:,n)
+              !
+           END SELECT
+           !
+           IF(dimg) THEN
+              !
+              WRITE(inum,REC=irec) tabinterp4d(:,:,1,1)
+              irec = irec + 1
+              !
+           ELSE
+              !
+              dimnames(1)='x'
+              dimnames(2)='y'
+              IF ((iom_activated).AND.(vert_coord_name == 'z_b')) THEN
+                 dimnames(3)=TRIM(timedimname)
+              ELSE
+                 dimnames(3)=vert_coord_name
+                 dimnames(4)=TRIM(timedimname)
+              ENDIF
+              !             
+              IF(TRIM(varname)=='gcx' .OR. TRIM(varname)=='gcxb') THEN 
+                 PRINT*,TRIM(varname),MAXVAL(tabinterp4d),MINVAL(tabinterp4d)
+              ENDIF
+              IF ((iom_activated).AND.(vert_coord_name == 'z_b')) THEN
+                 ALLOCATE(tabvar3d(SIZE(tabinterp4d,1),SIZE(tabinterp4d,2),SIZE(tabinterp4d,3)))
+                 tabvar3d=tabinterp4d(:,:,:,1)
+                 CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                      Child_file,tabvar3d,t,'double')
+                 DEALLOCATE(tabvar3d)
+              ELSE
+                 CALL Write_Ncdf_var(TRIM(varname),dimnames, &
+                      Child_file,tabinterp4d,t,n,'double')
+              ENDIF
+              !
+              CALL Copy_Ncdf_att(TRIM(varname),TRIM(restart_file),Child_file)
+              !
+           ENDIF
+           !
+           IF(ASSOCIATED(matrix)) DEALLOCATE(matrix,src_add,dst_add)   
+           !
+        END DO
+        ! 
+        DEALLOCATE(detected_pts)
+        DEALLOCATE(tabinterp4d)
+        DEALLOCATE(tabvar1,tabvar2,tabvar3)
+        DEALLOCATE(masksrc)  
+        !                     
+     ENDIF
+
+  END DO
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  !
+  ALLOCATE(rotn(nxfin,nyfin,z,1),rotb(nxfin,nyfin,z,1))
+  ALLOCATE(hdivn(nxfin,nyfin,z,1),hdivb(nxfin,nyfin,z,1))
+  !                          
+  !
+  IF(dimg) THEN         
+     ALLOCATE(un(nxfin,nyfin,z,1),ub(nxfin,nyfin,z,1))
+     ALLOCATE(vn(nxfin,nyfin,z,1),vb(nxfin,nyfin,z,1))
+     irec = 6 * z + 2
+     CALL read_dimg_var(inum,irec,un,z)  
+     irec = 2
+     CALL read_dimg_var(inum,irec,ub,z)
+     irec = 7 * z + 2
+     CALL read_dimg_var(inum,irec,vn,z)
+     irec = 2 + z
+     CALL read_dimg_var(inum,irec,vb,z)                      
+  ELSE
+     CALL Read_Ncdf_var('un',Child_file,un)      
+     CALL Read_Ncdf_var('vn',Child_file,vn)
+     !	 	 
+     CALL Read_Ncdf_var('ub',Child_file,ub)
+     CALL Read_Ncdf_var('vb',Child_file,vb)
+  ENDIF
+  !
+
+  IF(rhot == 1) THEN
+     WRITE(*,*) ''	 
+     WRITE(*,*) 'no time interpolation (time refinement ratio = 1)'
+  ELSE   
+     WRITE(*,*) ''
+     WRITE(*,*) 'time interpolation'
+     now_wght = (rhot-1.)/rhot
+     before_wght = 1./rhot
+     !    
+     ub = now_wght*un + before_wght*ub
+     vb = now_wght*vn + before_wght*vb
+     !-----------------------	       	       
+     IF(dimg) THEN
+        ALLOCATE(tn(nxfin,nyfin,z,1),tb(nxfin,nyfin,z,1))
+        irec = 8 * z + 2
+        CALL read_dimg_var(inum,irec,tn,z)
+        irec = 2 * z + 2
+        CALL read_dimg_var(inum,irec,tb,z)               
+     ELSE
+        CALL Read_Ncdf_var('tb',Child_file,tb)
+        CALL Read_Ncdf_var('tn',Child_file,tn)
+     ENDIF
+     !----------------------               
+     tb = now_wght*tn + before_wght*tb
+
+     IF(dimg) THEN
+        irec = 2 * z + 2
+        CALL write_dimg_var(inum,irec,tb,z)                
+     ELSE
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('tb',dimnames,Child_file,tb,'double')
+     ENDIF
+     !
+     DEALLOCATE(tn,tb)
+     !----------------------	       
+     IF(dimg) THEN
+        ALLOCATE(sn(nxfin,nyfin,z,1),sb(nxfin,nyfin,z,1))
+        irec = 9 * z + 2
+        CALL read_dimg_var(inum,irec,sn,z)
+        irec = 3 * z + 2
+        CALL read_dimg_var(inum,irec,sb,z)              
+     ELSE	       
+        CALL Read_Ncdf_var('sb',Child_file,sb)
+        CALL Read_Ncdf_var('sn',Child_file,sn)            
+     ENDIF
+     !----------------------               
+     sb = now_wght*sn + before_wght*sb
+
+     IF(dimg) THEN
+        irec = 3 * z + 2
+        CALL write_dimg_var(inum,irec,sb,z)                
+     ELSE               
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('sb',dimnames,Child_file,sb,'double')
+     ENDIF
+     !----------------------                             
+     DEALLOCATE(sn,sb)
+     !	       
+     IF(dimg) THEN
+        ALLOCATE(gcx(nxfin,nyfin,1,1),gcxb(nxfin,nyfin,1,1))
+        irec = 12 * z + 2
+        CALL read_dimg_var(inum,irec,gcx,1)
+        irec = 12 * z + 3
+        CALL read_dimg_var(inum,irec,gcxb,1) 
+     ELSE  
+        CALL Read_Ncdf_var('gcx',Child_file,gcx)
+        CALL Read_Ncdf_var('gcxb',Child_file,gcxb)
+     ENDIF
+     !----------------------               
+     gcxb = now_wght*gcx + before_wght*gcxb
+
+     IF(dimg) THEN
+        irec = 12 * z + 3
+        CALL write_dimg_var(inum,irec,gcxb,1)                
+     ELSE               
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z_b'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('gcxb',dimnames,Child_file,gcxb,'double')
+     ENDIF
+     !-----------------------               
+     PRINT*,' gcx = ',MAXVAL(gcx),MINVAL(gcx)
+     PRINT*,' gcxb = ',MAXVAL(gcxb),MINVAL(gcxb)
+
+     DEALLOCATE(gcx,gcxb)
+     !
+     IF(dimg) THEN
+        ALLOCATE(sshn(nxfin,nyfin,1,1),sshb(nxfin,nyfin,1,1))
+        irec = 12 * z + 5
+        CALL read_dimg_var(inum,irec,sshn,1)
+        irec = 12 * z + 4
+        CALL read_dimg_var(inum,irec,sshb,1) 
+     ELSE 	       
+        CALL Read_Ncdf_var('sshb',Child_file,sshb)
+        CALL Read_Ncdf_var('sshn',Child_file,sshn)
+     ENDIF
+     !----------------------               
+     sshb = now_wght*sshn + before_wght*sshb
+
+     IF(dimg) THEN
+        irec = 12 * z + 4
+        CALL write_dimg_var(inum,irec,sshb,1)                
+     ELSE  	       
+        dimnames(1)='x'
+        dimnames(2)='y'
+        dimnames(3)='z_b'
+        dimnames(4)=TRIM(timedimname)
+        CALL Write_Ncdf_var('sshb',dimnames,Child_file,sshb,'double')
+     ENDIF
+     !               
+     DEALLOCATE(sshb,sshn) 
+
+     !    
+  ENDIF
+  !
+  WRITE(*,*) 'Compute hdivn,rotn with new interpolated fields ...'
+  !
+  !fmask:land/ocean mask at f-point (=0. or 1.)=shlat along lateral boundaries
+  !
+  ALLOCATE(fse3u(nxfin,nyfin,z),fse3v(nxfin,nyfin,z),fse3t(nxfin,nyfin,z)) 
+  !      
+  IF(partial_steps) THEN
+     status = Read_Bathymeter(TRIM(Childbathymeter),G1)
+     CALL get_scale_factors( G1,fse3t,fse3u,fse3v )
+  ELSE       
+     fse3t(:,:,:) = 1.0
+     fse3u(:,:,:) = 1.0
+     fse3v(:,:,:) = 1.0
+  ENDIF
+  !
+  !
+  DO k = 1,z  
+     !	 
+     DO j = 2,nyfin-1
+        DO i = 2, nxfin-1
+           !
+           hdivn(i,j,k,1) = (G1%e2u(i,j)*fse3u(i,j,k)*un(i,j,k,1)-G1%e2u(i-1,j)*fse3u(i-1,j,k)*un(i-1,j,k,1)      &
+                +    G1%e1v(i,j)*fse3v(i,j,k)*vn(i,j,k,1)-G1%e1v(i,j-1)*fse3v(i,j-1,k)*vn(i,j-1,k,1))   & 
+                / ( G1%e1t(i,j) * G1%e2t(i,j) * fse3t(i,j,k) )
+           !
+           hdivb(i,j,k,1) = (G1%e2u(i,j)*fse3u(i,j,k)*ub(i,j,k,1)-G1%e2u(i-1,j)*fse3u(i-1,j,k)*ub(i-1,j,k,1)      &
+                +    G1%e1v(i,j)*fse3v(i,j,k)*vb(i,j,k,1)-G1%e1v(i,j-1)*fse3v(i,j-1,k)*vb(i,j-1,k,1))   & 
+                / ( G1%e1t(i,j) * G1%e2t(i,j) * fse3t(i,j,k) )
+           !			 
+        END DO
+     END DO
+     !
+     !
+     hdivn(1:2,:,k,1) = 0.
+     hdivn(:,1:2,k,1) = 0.
+     hdivn(nxfin-1:nxfin,:,k,1) = 0.
+     hdivn(:,nyfin-1:nyfin,k,1) = 0.
+     hdivb(1:2,:,k,1) = 0.
+     hdivb(:,1:2,k,1) = 0.
+     hdivb(nxfin-1:nxfin,:,k,1) = 0.
+     hdivb(:,nyfin-1:nyfin,k,1) = 0.         
+     !	 
+     DO j = 1, nyfin-1
+        DO i = 1, nxfin-1
+           !
+           rotn(i,j,k,1) = (G1%e2v(i+1,j)*vn(i+1,j,k,1)-G1%e2v(i,j)*vn(i,j,k,1)    &
+                - G1%e1u(i,j+1)*un(i,j+1,k,1)+G1%e1u(i,j)*un(i,j,k,1)) &
+                * G1%fmask(i,j,k) / ( G1%e1f(i,j) * G1%e2f(i,j))
+           !
+           rotb(i,j,k,1) = (G1%e2v(i+1,j)*vb(i+1,j,k,1)-G1%e2v(i,j)*vb(i,j,k,1)    &
+                - G1%e1u(i,j+1)*ub(i,j+1,k,1)+G1%e1u(i,j)*ub(i,j,k,1)) &
+                * G1%fmask(i,j,k) / ( G1%e1f(i,j) * G1%e2f(i,j))
+           !			    
+        END DO
+     END DO
+     !
+  END DO
+  !
+  PRINT*,' hdivn = ',MAXVAL(hdivn(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(hdivn(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' hdivb = ',MAXVAL(hdivb(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(hdivb(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' rotn  = ',MAXVAL(rotn(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(rotn(2:nxfin-1,2:nyfin-1,:,1))
+  PRINT*,' rotb  = ',MAXVAL(rotb(2:nxfin-1,2:nyfin-1,:,1)),MINVAL(rotb(2:nxfin-1,2:nyfin-1,:,1))
+  !
+  IF(dimg) THEN
+     !
+     irec = 10 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) rotn(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 4 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) rotb(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 11 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) hdivn(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     irec = 5 * z + 2
+     DO k=1,z
+        WRITE(inum,REC=irec) hdivb(:,:,k,1)
+        irec = irec+1
+     ENDDO
+     !          
+     CLOSE(inum)
+  ELSE
+     dimnames(1)='x'
+     dimnames(2)='y'
+     dimnames(3)='z'
+     dimnames(4)=TRIM(timedimname)
+     CALL Write_Ncdf_var('rotn',dimnames,Child_file,rotn,'double')
+     CALL Copy_Ncdf_att('rotn',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('hdivn',dimnames,Child_file,hdivn,'double')
+     CALL Copy_Ncdf_att('hdivn',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('rotb',dimnames,Child_file,rotb,'double')
+     CALL Copy_Ncdf_att('rotb',TRIM(restart_file),Child_file)
+     CALL Write_Ncdf_var('hdivb',dimnames,Child_file,hdivb,'double')
+     CALL Copy_Ncdf_att('hdivb',TRIM(restart_file),Child_file)
+  ENDIF
+  !
+  WRITE(*,*) ' '
+  WRITE(*,*) '******* restart file successfully created *******' 
+  WRITE(*,*) ' '
+  !
+  STOP 
+END PROGRAM create_rstrt
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_create_restart_trc.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_extrapolation.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_gridsearch.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_interpolation.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_modutil.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90	(revision 3437)
@@ -0,0 +1,763 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools                                    	*
+!                                                      			*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)      *
+!                        Laurent Debreu (Laurent.Debreu@imag.fr)      	*
+!************************************************************************
+!
+MODULE agrif_partial_steps
+  !
+  USE agrif_types
+CONTAINS
+
+
+
+
+
+  !
+  !************************************************************************
+  !                                                       		*
+  ! MODULE  AGRIF_PARTIAL_STEPS                                    	*
+  !									*
+  !************************************************************************
+
+
+  !************************************************************************
+  !									*
+  ! Subroutine get_partial_steps						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !       
+  SUBROUTINE get_partial_steps(Grid)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid                     
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps
+    REAL*8 e3t_ps
+
+    !
+    WRITE(*,*) 'convert bathymetry from etopo for partial step z-coordinate case'
+    WRITE(*,*) 'minimum thickness of partial step   e3zps_min = ', e3zps_min, ' (m)'
+    WRITE(*,*) '       step  level                  e3zps_rat = ', e3zps_rat       
+    !       
+    jpi = SIZE(Grid%bathy_meter,1)
+    jpj = SIZE(Grid%bathy_meter,2)       
+    !       
+    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N))
+    ALLOCATE(gdepw_ps(jpi,jpj,N))                  
+    IF (.NOT.ASSOCIATED(Grid%bathy_level)) ALLOCATE(Grid%bathy_level(jpi,jpj))
+    !       
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       WRITE(*,*) 'psur,pa0,pa1 given by namelist'
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '  
+       STOP    
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth       
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr)))
+       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+       !
+    END DO
+    !
+
+    gdepw(1) = 0.0  
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4)
+    !
+    ! Initialize bathy_level to the maximum ocean level available
+    !
+    Grid%bathy_level = N-1
+    !
+    ! storage of land and island's number (zera and negative values) in mbathy
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. )   &
+               Grid%bathy_level(ji,jj) = INT( Grid%bathy_meter(ji,jj) )
+       END DO
+    END DO
+    !
+    ! the last ocean level thickness cannot exceed e3t(jpkm1)+e3t(jpk)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    ! Compute bathy_level for ocean points (i.e. the number of ocean levels)
+    ! find the number of ocean levels such that the last level thickness
+    ! is larger than the minimum of e3zps_min and e3zps_rat * e3t (where
+    ! e3t is the reference level thickness   
+    !     
+    DO jk = N-1, 1, -1
+       zdepth = gdepw(jk) + MIN( e3zps_min, e3t(jk)*e3zps_rat )
+       DO jj = 1, jpj
+          DO ji = 1, jpi
+             IF( 0. < Grid%bathy_meter(ji,jj) .AND. Grid%bathy_meter(ji,jj) <= zdepth ) &
+                  Grid%bathy_level(ji,jj) = jk-1
+          END DO
+       END DO
+    END DO
+
+
+    CALL bathymetry_control(grid%bathy_level)
+    !
+    ! initialization to the reference z-coordinate
+    ! 
+    WRITE(*,*) ' initialization to the reference z-coordinate '
+    !     
+    DO jk = 1, N
+       !        Write(*,*) 'k = ',jk
+       gdepw_ps(1:jpi,1:jpj,jk) = gdepw(jk)
+    END DO
+    !      
+    Grid%gdepw_ps(:,:) = gdepw_ps(:,:,3)           
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == N-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                ze3wp = 0.5 * e3w(ik) * ( 1. + ( ze3tp/e3t(ik) ) )
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+                ! standard case
+             ELSE
+                !
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   !
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                !
+             ENDIF
+             !           
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj)
+          ! ocean point only
+          IF( ik > 0 ) THEN
+             ! bathymetry output
+             !
+             Grid%gdepw_ps(ji,jj) = gdepw_ps(ji,jj,ik+1)
+             !
+             !AJOUT-----------------------------------------------------------------------
+             !
+          ELSE
+             !           
+             Grid%gdepw_ps(ji,jj) = 0
+             !
+             !AJOUT------------------------------------------------------------------------
+             !           
+          ENDIF
+          !                     
+       END DO
+    END DO
+    !     
+    !
+    DEALLOCATE(gdepw,gdept,e3w,e3t)
+    DEALLOCATE(gdepw_ps)                  
+  END SUBROUTINE get_partial_steps
+  !
+  !
+  !*************************************************************************
+  !									*
+  ! Subroutine check interp						*
+  !									*
+  ! subroutine to compute gdepw_ps on the input grid (based on NEMO code) *
+  !                                                      			*
+  !************************************************************************
+  !
+  !
+  SUBROUTINE check_interp( ParentGrid , gdepwChild )
+    !
+    IMPLICIT NONE
+    !                   
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild 
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
+    REAL,DIMENSION(N) :: gdepw,e3t
+    REAL :: za0,za1,zsur,zacr,zkth,zmin,zmax,zdepth
+    INTEGER :: kbathy,jk,diff
+    INTEGER :: bornex,borney,bornex2,borney2
+    !       
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       za1=( ppdzmin - pphmax / (N-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) &
+            *  (  LOG( COSH( (N - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  )
+
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1
+       !
+    ELSE
+       !       
+       WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 
+       WRITE(*,*) ' '
+       WRITE(*,*) 'please check values of variables'
+       WRITE(*,*) 'in namelist vertical_grid section'
+       WRITE(*,*) ' '      
+       !       
+    ENDIF
+    !       
+    zacr = ppacr
+    zkth = ppkth       
+    !
+    DO i = 1,N
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))       
+    END DO
+    !
+    gdepw(1) = 0.0
+    !
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+    !       
+    bornex = nbghostcellsfine + CEILING(irafx/2.0) + diff - irafx
+    borney = nbghostcellsfine + CEILING(irafy/2.0) + diff - irafy
+    bornex2 = nxfin - (nbghostcellsfine-1) - irafx - CEILING(irafx/2.0) 
+    borney2 = nyfin - (nbghostcellsfine-1) - irafy - CEILING(irafy/2.0)                      
+    !
+    !
+    ! west boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,3+connectionsize*irafx-1, &
+         1,nyfin)
+
+    !
+    ! east boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,nxfin-2-(connectionsize*irafx-1),nxfin, &
+         1,nyfin)
+
+    !
+    ! north boundary
+    !
+
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin, &
+         nyfin-2-(connectionsize*irafy-1),nyfin )
+
+    !
+    ! south boundary
+    !
+    CALL correct_level( gdepwchild,ParentGrid,gdepw,e3t,1,nxfin, &
+         1,3+connectionsize*irafy-1 )
+
+    !       
+    !
+    !
+  END SUBROUTINE check_interp
+  !
+  SUBROUTINE correct_level( gdepwchild,ParentGrid,gdepw,e3t,minboundx,maxboundx,minboundy,maxboundy )
+    !
+    IMPLICIT NONE
+    TYPE(Coordinates) :: ParentGrid
+    REAL*8,DIMENSION(:,:) :: gdepwChild
+    REAL*8,DIMENSION(N) :: gdepw,e3t
+    INTEGER :: minboundx,maxboundx,minboundy,maxboundy
+    INTEGER :: kbathy,jk,indx,indy,diff
+    REAL :: xdiff
+    INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt
+    REAL*8 :: slopex, slopey,val,tmp1,tmp2,tmp3,tmp4
+    INTEGER :: parentbathy
+    REAL :: mindepth, maxdepth
+    REAL :: xmin,ymin,dxfin,dyfin,dsparent
+    INTEGER ipbegin,ipend,jpbegin,jpend
+    INTEGER ibegin,iend,jbegin,jend
+    REAL x,y,zmin,zmax
+    INTEGER ptx,pty
+    REAL,DIMENSION(:,:),ALLOCATABLE :: gdepwtemp
+    INTEGER,DIMENSION(:,:),ALLOCATABLE :: parentbathytab
+    !
+    !
+    ! Initialization of constant
+    !
+    zmax = gdepw(N) + e3t(N)
+    zmin = gdepw(4) 
+    !
+    ! check that interpolated value stays at the same level         
+    ! 
+    !
+    diff = 0      
+    IF ( MOD(irafx,2) .EQ. 0 ) diff = 1
+
+    xdiff = REAL(diff)/2.
+
+    dxfin = 1./irafx
+    dyfin = 1./irafy
+
+    ptx = 3
+    pty = 3
+
+    xmin = (imin-1) * 1
+    ymin = (jmin-1) * 1
+
+
+    ! compute x and y the locations of the indices minbounx and minboundy 
+
+    x = xmin + (minboundx-ptx)*dxfin  + dxfin/2.
+    y = ymin + (minboundy-pty)*dyfin  + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points      
+    ipbegin = ptx + agrif_int((x-0.-1./2.) / 1.) - 1
+    jpbegin = pty + agrif_int((y-0.-1./2.) / 1.) - 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipbegin - ptx) + 1./2.
+    y = (jpbegin - pty) + 1./2.
+
+    ibegin = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jbegin = pty + agrif_int((y-ymin-dyfin/2.)/dyfin) 
+
+    ! compute x and y the locations of the indices maxbounx and maxboundy        
+    x = xmin + (maxboundx-ptx)*dxfin + dxfin/2.
+    y = ymin + (maxboundy-pty)*dyfin + dyfin/2.
+
+    ! compute the indices of the nearest coarse grid points         
+    ipend = ptx + CEILING((x-0.-1./2) / 1.) + 1
+    jpend = pty + CEILING((y-0.-1./2) / 1.) + 1
+
+    ! compute indices of the fine grid points nearest to the preceeding coarse grid points       
+    ! (inferior values)
+
+    x = (ipend - ptx) + 1./2.
+    y = (jpend - pty) + 1./2.
+    iend = ptx + agrif_int((x-xmin-dxfin/2.)/dxfin) 
+    jend = pty + agrif_int((y-ymin-dyfin/2.)/dyfin)               
+
+
+    ALLOCATE(gdepwtemp(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+    ALLOCATE(parentbathytab(ibegin-irafx:iend+irafx,jbegin-irafy:jend+irafy))
+
+
+    jpt=jpbegin
+    DO j=jbegin,jend,irafy
+
+       ipt=ipbegin
+
+
+       DO i=ibegin,iend,irafx
+
+
+          !            
+          parentbathy = ParentGrid%bathy_level(ipt,jpt)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopex = vanleer(parentgrid%gdepw_ps(ipt-1:ipt+1,jpt))/REAL(irafx)
+
+
+          tmp1 = (maxdepth - parentgrid%gdepw_ps(ipt,jpt)) / REAL(irafx)
+          tmp2 = (parentgrid%gdepw_ps(ipt,jpt) - mindepth) / REAL(irafx)
+
+          IF (ABS(slopex) > tmp1) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp1
+             ELSE
+                slopex = -tmp1
+             ENDIF
+          ENDIF
+
+          IF (ABS(slopex) > tmp2) THEN
+             IF (slopex > 0) THEN
+                slopex = tmp2
+             ELSE
+                slopex = -tmp2
+             ENDIF
+          ENDIF
+          !                  
+          ! interpolation on fine grid points (connection zone)
+          !
+          DO ii = i-FLOOR(irafx/2.0)+diff,i+FLOOR(irafx/2.0)
+             x = ii-i - xdiff/2.
+             val = parentgrid%gdepw_ps(ipt,jpt)+slopex * x
+             gdepwtemp(ii,j) = val
+             IF (gdepwtemp(ii,j) < mindepth) THEN
+                gdepwtemp(ii,j) = mindepth
+             ENDIF
+             IF (gdepwtemp(ii,j) > maxdepth) THEN
+                gdepwtemp(ii,j) = maxdepth
+             ENDIF
+             parentbathytab(ii,j) = parentbathy
+          ENDDO
+          ipt =ipt + 1
+       ENDDO
+
+       jpt = jpt + 1                
+    ENDDO
+
+    DO j=jbegin+irafy,jend-irafy,irafy
+
+       DO i=ibegin,iend
+
+          parentbathy = parentbathytab(i,j)
+          IF (parentbathy == 0) THEN
+             mindepth = 0.
+             maxdepth = 0.
+          ELSE
+             mindepth = MAX(gdepw(parentbathy) + MIN( e3zps_min, e3t(parentbathy)*e3zps_rat ),zmin)
+             !                  maxdepth = min(gdepw(parentbathy + 1),zmax)
+             IF (parentbathy < (N-1)) THEN
+                maxdepth = gdepw(parentbathy + 1)
+             ELSE
+                maxdepth = HUGE(1.)
+             ENDIF
+          ENDIF
+
+          slopey = vanleer(gdepwtemp(i,j-irafy:j+irafy:irafy))/REAL(irafy)
+
+          tmp1 = (maxdepth - gdepwtemp(i,j)) / REAL(irafy)
+          tmp2 = (gdepwtemp(i,j) - mindepth) / REAL(irafy)
+
+          IF (ABS(slopey) > tmp1) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp1
+             ELSE
+                slopey = -tmp1
+             ENDIF
+          ENDIF
+          IF (ABS(slopey) > tmp2) THEN
+             IF (slopey > 0) THEN
+                slopey = tmp2
+             ELSE
+                slopey = -tmp2
+             ENDIF
+          ENDIF
+
+
+          DO jj = j-FLOOR(irafy/2.0)+diff,j+FLOOR(irafy/2.0)
+             y = jj-j - xdiff/2.
+             val = gdepwtemp(i,j) + slopey*y
+             gdepwtemp(i,jj) = val     
+          ENDDO
+       ENDDO
+    ENDDO
+
+
+    gdepwchild(minboundx:maxboundx,minboundy:maxboundy) = gdepwtemp(minboundx:maxboundx,minboundy:maxboundy)
+    DEALLOCATE(gdepwtemp,parentbathytab)
+
+  END SUBROUTINE correct_level
+  !
+  !
+  !***************************************************
+  ! function van leer to compute the corresponding 
+  ! Van Leer slopes
+  !***************************************************
+  !      
+  REAL FUNCTION vanleer(tab)
+    REAL, DIMENSION(3) :: tab
+    REAL res,res1
+    REAL p1,p2,p3
+
+    p1=(tab(3)-tab(1))/2.
+    p2=(tab(2)-tab(1))
+    p3=(tab(3)-tab(2))
+
+    IF ((p1>0.).AND.(p2>0.).AND.(p3>0)) THEN
+       res1=MINVAL((/p1,p2,p3/))
+    ELSEIF ((p1<0.).AND.(p2<0.).AND.(p3<0)) THEN
+       res1=MAXVAL((/p1,p2,p3/))
+    ELSE
+       res1=0.
+    ENDIF
+
+    vanleer = res1   
+
+
+  END FUNCTION vanleer
+  !
+  !
+  !********************************************************************************
+  !   subroutine bathymetry_control                        			*
+  !                                                				*
+  !  - Purpose :   check the bathymetry in levels                  		*
+  !										*
+  !  - Method  :   The array mbathy is checked to verified its consistency	*
+  !      with the model options. in particular:					*
+  !            mbathy must have at least 1 land grid-points (mbathy<=0)		*
+  !                  along closed boundary.					*
+  !            mbathy must be cyclic IF jperio=1.					*
+  !            mbathy must be lower or equal to jpk-1.				*
+  !            isolated ocean grid points are suppressed from mbathy		*
+  !                  since they are only connected to remaining			*
+  !                  ocean through vertical diffusion.				*
+  !										*
+  !										*
+  !********************************************************************************
+
+  SUBROUTINE bathymetry_control(mbathy)
+
+    INTEGER ::   i, j, jl           
+    INTEGER ::   icompt, ibtest, ikmax          
+    REAL*8, DIMENSION(:,:) :: mbathy     
+
+    ! ================
+    ! Bathymetry check
+    ! ================
+
+    ! Suppress isolated ocean grid points
+
+    WRITE(*,*)'                   suppress isolated ocean grid points'
+    WRITE(*,*)'                   -----------------------------------'
+
+    icompt = 0
+
+    DO jl = 1, 2
+       !
+       DO j = 2, SIZE(mbathy,2)-1
+          DO i = 2, SIZE(mbathy,1)-1
+
+             ibtest = MAX( mbathy(i-1,j), mbathy(i+1,j),mbathy(i,j-1),mbathy(i,j+1) )
+             !               
+             IF( ibtest < mbathy(i,j) ) THEN
+                !                  
+                WRITE(*,*) 'grid-point(i,j)= ',i,j,'is changed from',mbathy(i,j),' to ', ibtest
+                mbathy(i,j) = ibtest
+                icompt = icompt + 1
+                !
+             ENDIF
+             !           
+          END DO
+       END DO
+       !
+    END DO
+    !      
+    IF( icompt == 0 ) THEN
+       WRITE(*,*)'     no isolated ocean grid points'
+    ELSE
+       WRITE(*,*)'    ',icompt,' ocean grid points suppressed'
+    ENDIF
+    !
+
+    ! Number of ocean level inferior or equal to jpkm1
+
+    ikmax = 0
+    DO j = 1, SIZE(mbathy,2)
+       DO ji = 1, SIZE(mbathy,1)
+          ikmax = MAX( ikmax, NINT(mbathy(i,j)) )
+       END DO
+    END DO
+    !
+    IF( ikmax > N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' >  jpk-1'
+       WRITE(*,*) ' change jpk to ',ikmax+1,' to use the exact ead bathymetry'
+    ELSE IF( ikmax < N-1 ) THEN
+       WRITE(*,*) ' maximum number of ocean level = ', ikmax,' < jpk-1' 
+       WRITE(*,*) ' you can decrease jpk to ', ikmax+1
+    ENDIF
+
+  END SUBROUTINE bathymetry_control
+  !
+  !
+  !**********************************************************************************
+  !
+  !subroutine get_scale_factors
+  !
+  !**********************************************************************************
+  !
+  SUBROUTINE get_scale_factors(Grid,fse3t,fse3u,fse3v)
+    !
+    IMPLICIT NONE
+    !       
+    TYPE(Coordinates) :: Grid 
+    REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v
+    !                                  
+    REAL*8 :: za1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp
+    INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk
+    INTEGER, DIMENSION(1) :: k
+    INTEGER :: k1
+    REAL*8, POINTER, DIMENSION(:) :: gdepw,gdept,e3w,e3t
+    REAL*8, POINTER, DIMENSION(:,:)   :: hdepw,e3tp,e3wp
+    REAL*8, POINTER, DIMENSION(:,:,:) :: gdept_ps,gdepw_ps   
+    !       
+    jpi = SIZE(fse3t,1)
+    jpj = SIZE(fse3t,2) 
+    jpk = SIZE(fse3t,3)      
+    !       
+    ALLOCATE(gdepw(jpk),e3t(jpk))
+    ALLOCATE(gdepw_ps(jpi,jpj,jpk))                  
+    !       
+    IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) &
+         .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 
+       !    
+       WRITE(*,*) 'psur,pa0,pa1 computed'
+       za1=( ppdzmin - pphmax / (jpk-1) )          &
+            / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) &
+            *  (  LOG( COSH( (jpk - ppkth) / ppacr) )      &
+            - LOG( COSH( ( 1  - ppkth) / ppacr) )  )  ) 
+       !
+       za0  = ppdzmin - za1 * TANH( (1-ppkth) / ppacr )
+       zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr )  )
+       !
+    ELSE IF ( (ppdzmin == 0 .OR. pphmax == 0) .AND. psur.NE.0 .AND. &
+         pa0.NE.0 .AND. pa1.NE.0 ) THEN
+       !       
+       zsur = psur
+       za0  = pa0
+       za1  = pa1   
+       !       
+    ENDIF
+
+    zacr = ppacr
+    zkth = ppkth       
+    !         
+    !                
+    DO i = 1,jpk
+       ! 
+       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 
+       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))
+       !       
+       fse3t(:,:,i) = e3t(i)
+       gdepw_ps(:,:,i) = gdepw(i)
+       !
+    END DO
+    !                                 
+    gdepw(1) = 0.0 
+    gdepw_ps(:,:,1) = 0.0 
+    !
+    zmax = gdepw(jpk) + e3t(jpk)
+    zmin = gdepw(4)
+    !
+    DO jj = 1, jpj
+       DO ji= 1, jpi
+          IF( Grid%bathy_meter(ji,jj) <= 0. ) THEN
+             Grid%bathy_meter(ji,jj) = 0.e0
+          ELSE
+             Grid%bathy_meter(ji,jj) = MAX( Grid%bathy_meter(ji,jj), zmin )
+             Grid%bathy_meter(ji,jj) = MIN( Grid%bathy_meter(ji,jj), zmax )
+          ENDIF
+       END DO
+    END DO
+    !
+    DO jj = 1, jpj
+       DO ji = 1, jpi
+          ik = Grid%bathy_level(ji,jj) 
+          IF( ik > 0 ) THEN
+             ! max ocean level case
+             IF( ik == jpk-1 ) THEN
+                zdepwp = Grid%bathy_meter(ji,jj)
+                ze3tp  = Grid%bathy_meter(ji,jj) - gdepw(ik)
+                fse3t(ji,jj,ik  ) = ze3tp
+                fse3t(ji,jj,ik+1) = ze3tp
+                gdepw_ps(ji,jj,ik+1) = zdepwp
+             ELSE
+                IF( Grid%bathy_meter(ji,jj) <= gdepw(ik+1) ) THEN
+                   gdepw_ps(ji,jj,ik+1) = Grid%bathy_meter(ji,jj)
+                ELSE
+                   gdepw_ps(ji,jj,ik+1) = gdepw(ik+1)
+                ENDIF
+                fse3t(ji,jj,ik) = e3t(ik) * ( gdepw_ps(ji,jj,ik+1) - gdepw(ik))   & 
+                     /( gdepw(ik+1) - gdepw(ik)) 
+                fse3t(ji,jj,ik+1) = fse3t(ji,jj,ik)
+
+             ENDIF
+          ENDIF
+       END DO
+    END DO
+    !
+    DO i = 1, jpk
+       fse3u (:,:,i)  = e3t(i)
+       fse3v (:,:,i)  = e3t(i)
+    END DO
+    !
+    DO jk = 1,jpk
+       DO jj = 1, jpj-1
+          DO ji = 1, jpi-1
+             fse3u (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji+1,jj,jk))
+             fse3v (ji,jj,jk) = MIN( fse3t(ji,jj,jk), fse3t(ji,jj+1,jk))      
+          ENDDO
+       ENDDO
+    ENDDO
+    !           
+    DEALLOCATE(gdepw,e3t)
+    DEALLOCATE(gdepw_ps)
+    DEALLOCATE(Grid%bathy_meter,Grid%bathy_level) 
+    !
+  END SUBROUTINE get_scale_factors
+  !       
+END MODULE agrif_partial_steps
+
+
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_readwrite.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90	(revision 3437)
@@ -0,0 +1,229 @@
+!************************************************************************
+! Fortran 95 OPA Nesting tools						*
+!									*
+!     Copyright (C) 2005 Florian Lemarié (Florian.Lemarie@imag.fr)	*
+!									*
+!************************************************************************
+!      
+MODULE agrif_types
+  !
+  PUBLIC
+  !   
+  !*****************************
+  ! Coordinates type definition 
+  !*****************************
+  TYPE Coordinates
+     !
+     REAL*8, DIMENSION(:,:), POINTER :: nav_lon,nav_lat => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: glamv, glamu, glamt, glamf => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: gphit, gphiu, gphiv, gphif => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: e1t, e1u, e1v, e1f => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: e2t, e2u, e2v, e2f => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: bathy_level => NULL()
+     REAL*8, DIMENSION(:,:), POINTER :: bathy_meter => NULL()
+     REAL*8, DIMENSION(:,:,:),POINTER :: fmask,umask,vmask,tmask => NULL()
+     REAL*8, DIMENSION(:,:,:),POINTER :: e3t_ps,e3w_ps,gdept_ps,gdepwps => NULL()
+     REAL*8, DIMENSION(:,:),POINTER :: gdepw_ps => NULL()
+     REAL*8, DIMENSION(:), POINTER :: gdeptht => NULL()
+     INTEGER, DIMENSION(:) , POINTER :: time_steps => NULL()
+     !     
+  END TYPE Coordinates
+  !
+  !
+  !
+  CHARACTER*8,DIMENSION(10) :: flxtab = (/'socliot1','socliot2','socliopl',&
+       'socliocl','socliohu','socliowi','soshfldo','sohefldo','sowaflup','sofbt   '/)
+  !
+  !
+  !**************************************************************
+  ! Declaration of various input file variables (namelist.input) 
+  !**************************************************************
+  !
+  INTEGER irafx,irafy
+  INTEGER nxfin,nyfin
+  INTEGER, PARAMETER :: nbghostcellsfine = 2
+  INTEGER, PARAMETER :: nbghostcellscoarse = 1
+  !      
+  INTEGER imin,jmin,imax,jmax,rho,rhot
+  INTEGER shlat
+  INTEGER N,type_bathy_interp
+  ! 
+  INTEGER jpizoom,jpjzoom,nb_connection_pts
+  !      
+  REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat
+  REAL*8 psur,pa0,pa1,adatrj
+  !       
+  LOGICAL partial_steps,smoothing,bathy_update
+  LOGICAL new_topo,removeclosedseas,dimg,iom_activated
+  !       
+  CHARACTER*100 parent_meshmask_file,elevation_database,parent_bathy_meter
+  CHARACTER*100 elevation_name,parent_batmet_name
+  CHARACTER*100 parent_coordinate_file,restart_file,updated_parent_file,restart_trc_file
+  CHARACTER*100 dimg_output_file,interp_type
+  !      
+  CHARACTER(len=80),DIMENSION(20) :: flx_Files, u_files, v_files
+  CHARACTER(len=255),DIMENSION(20) :: VAR_INTERP
+  !
+  NAMELIST /input_output/iom_activated
+  !
+  NAMELIST /coarse_grid_files/parent_coordinate_file,parent_meshmask_file
+  !      
+  NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, &
+       nb_connection_pts,removeclosedseas,type_bathy_interp      
+  !      
+  NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file      
+  !
+  NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N
+  ! 
+  NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat      
+  !
+  NAMELIST /nemo_coarse_grid/ jpizoom,jpjzoom 
+  !          
+  NAMELIST /forcing_files/ flx_files, u_files, v_files 
+  !           
+  NAMELIST /interp/ VAR_INTERP
+  !      
+  NAMELIST /restart/ restart_file,shlat,dimg,dimg_output_file,adatrj,interp_type 
+
+  NAMELIST /restart_trc/ restart_trc_file,interp_type 
+
+  INTEGER :: connectionsize = 3
+  !
+CONTAINS
+  !
+  !********************************************************
+  !subroutine agrif_grid_allocate				*
+  !							*
+  !allocation of grid type elements 			*
+  !      according to nx and ny				*
+  !							*
+  !							*
+  !********************************************************
+  !       
+  SUBROUTINE agrif_grid_allocate(Grid,nx,ny)
+    !
+    TYPE(Coordinates) :: Grid
+    INTEGER :: nx,ny
+    !
+    ALLOCATE(Grid%nav_lon(nx,ny),Grid%nav_lat(nx,ny))
+    !
+    ALLOCATE(Grid%glamt(nx,ny),Grid%glamu(nx,ny),Grid%glamv(nx,ny),Grid%glamf(nx,ny))
+    ALLOCATE(Grid%gphit(nx,ny),Grid%gphiu(nx,ny),Grid%gphiv(nx,ny),Grid%gphif(nx,ny))
+    !
+    ALLOCATE(Grid%e1t(nx,ny),Grid%e1u(nx,ny),Grid%e1v(nx,ny),Grid%e1f(nx,ny))
+    ALLOCATE(Grid%e2t(nx,ny),Grid%e2u(nx,ny),Grid%e2v(nx,ny),Grid%e2f(nx,ny))
+    !
+    ALLOCATE(Grid%bathy_level(nx,ny))
+    !
+  END SUBROUTINE agrif_grid_allocate
+  !
+  !
+  !************************************************************************
+  !									*
+  !   subroutine read_namelist						*
+  !									*
+  !   read variables contained in namelist.input file   			*
+  !   filled in by user 							*
+  !									*
+  !************************************************************************
+  !
+  SUBROUTINE read_namelist(namelistname)
+    !
+    IMPLICIT NONE
+    CHARACTER(len=80) :: namelistname
+    CHARACTER*255 :: output
+    LOGICAL :: is_it_there
+    INTEGER unit_nml
+    !      
+    FLX_FILES = '/NULL'
+    U_FILES = '/NULL'
+    V_FILES = '/NULL'
+    VAR_INTERP = 'NULL'
+    unit_nml = Agrif_Get_Unit()
+    !      
+    INQUIRE ( FILE = namelistname , EXIST = is_it_there )      
+    !
+    IF ( is_it_there ) THEN 
+       !
+       OPEN ( FILE   = namelistname , &
+            UNIT   =  unit_nml        , &
+            STATUS = 'OLD'            , &
+            FORM   = 'FORMATTED'      , &
+            ACTION = 'READ'           , &
+            ACCESS = 'SEQUENTIAL'     )	  
+       !
+       REWIND(unit_nml)
+       READ (unit_nml , NML = input_output)
+       READ (unit_nml , NML = coarse_grid_files)
+       READ (unit_nml , NML = bathymetry)	  
+       READ (unit_nml , NML = nesting) 
+       READ (unit_nml , NML = vertical_grid)
+       READ (unit_nml , NML = partial_cells)                    
+       READ (unit_nml , NML = nemo_coarse_grid ) 
+       READ (unit_nml , NML = forcing_files )  
+       READ (unit_nml , NML = interp )   
+       READ (unit_nml , NML = restart )
+       READ (unit_nml , NML = restart_trc )
+       CLOSE(unit_nml)
+       !	
+       irafx = rho
+       irafy = rho
+       imin = imin + jpizoom - 1
+       imax = imax + jpizoom - 1
+       jmin = jmin + jpjzoom - 1
+       jmax = jmax + jpjzoom - 1
+       !
+       nxfin = (imax-imin)*irafx+nbghostcellsfine*2
+       nyfin = (jmax-jmin)*irafy+nbghostcellsfine*2
+       !
+    ELSE
+       !
+       PRINT *,'namelist file ''',TRIM(namelistname),''' not found'
+       STOP	 
+       !
+    END IF
+    !
+    !
+  END SUBROUTINE read_namelist
+
+  INTEGER FUNCTION agrif_int(x)
+
+    REAL :: x
+    INTEGER ::i
+
+    i = FLOOR(x) + 1
+
+    IF( ABS(x - i).LE.0.0001 )THEN
+       agrif_int = i
+    ELSE
+       agrif_int = i-1
+    ENDIF
+
+  END FUNCTION agrif_int
+  !
+  !*************************************************
+  !   function Agrif_Get_Unit                             
+  !*************************************************
+  !
+
+  INTEGER FUNCTION Agrif_Get_Unit()
+    !
+    INTEGER n
+    LOGICAL op
+    INTEGER :: nunit
+    INTEGER :: iii,out,iiimax 
+    ! 
+    DO n = 7,1000
+       ! 
+       INQUIRE(Unit=n,Opened=op)
+       !
+       IF (.NOT.op) EXIT
+       !      
+    ENDDO
+    !
+    Agrif_Get_Unit=n
+    !
+    !
+  END FUNCTION Agrif_Get_Unit
+  !
+END MODULE agrif_types
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bicubic_interp.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/bilinear_interp.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/NESTING/src/io_netcdf.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 3437)
@@ -0,0 +1,382 @@
+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 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
+
+
+END MODULE date_utils
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/DOM/dom_oce.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/greg2jul.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 3437)
@@ -0,0 +1,133 @@
+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_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
+                                                       !:                  (T): 1 file per proc
+   LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lbcnfd.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lib_mpp.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv_functions.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_fbm.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_prof_io.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_sla_io.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_sla_types.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_utils.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_vel_io.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obsprof_io.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obssla_io.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obssla_types.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obsvel_io.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/par_kind.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 3437)
@@ -0,0 +1,199 @@
+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 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+!#if   defined key_orca_r4
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R4.h90"
+!#elif defined key_orca_r2
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R2.h90"
+!#elif defined key_orca_r1
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r1'   :                           global ocean : ORCA R1
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R1.h90"
+!#elif defined key_orca_r05
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R05.h90"
+!#elif defined key_orca_r025
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r025' :                         global ocean : ORCA R025
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R025.h90"
+!#elif defined key_eel_r2
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r2'    :                                 channel : EEL R2
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R2.h90"
+!#elif defined key_eel_r5
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r5'    :                                 channel : EEL R5
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R5.h90"
+!#elif defined key_eel_r6
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r6'    :                                 channel : EEL R6
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R6.h90"
+!#elif defined key_gyre
+!   !!---------------------------------------------------------------------
+!   !!   'key_gyre'      :                        mid-latitude basin : GYRE
+!   !!---------------------------------------------------------------------
+!#             include "par_GYRE.h90"
+!#elif defined key_pomme_r025
+!   !!---------------------------------------------------------------------
+!   !!   'key_pomme_r025':                        regional basin : POMME025
+!   !!---------------------------------------------------------------------
+!#             include "par_POMME_R025.h90"
+!#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
+   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
+   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+   INTEGER, PUBLIC            ::   jpk     = jpkdta   !: number of vertical levels
+   ! zoom starting position 
+   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                                  !  = 5 North fold F-point pivot
+   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
+   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                                !  = 2 f-plane with regular grid-spacing
+   !                                                !  = 3 beta-plane with regular grid-spacing
+   !                                                !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
+   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
+   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
+   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
+   !
+   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
+   !
+!#endif
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
+#if defined key_agrif
+   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                                             !: third dimension
+   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+
+   !!---------------------------------------------------------------------
+   !! Optimization/control flags
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
+#endif
+
+#if defined key_vectopt_loop
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_oce.F90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/str_c_to_for.h90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/wrk_nemo.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/rebuild
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/rebuild	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../EXTERNAL/IOIPSL/tools/rebuild
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/calendar.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/calendar.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/calendar.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/defprec.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/defprec.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/defprec.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/errioipsl.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/errioipsl.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flincom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flincom.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/flincom.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/flio_rbld.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/flio_rbld.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/fliocom.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/fliocom.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/getincom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/getincom.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/getincom.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/histcom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/histcom.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/histcom.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ioipsl.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/ioipsl.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/mathelp.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/mathelp.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/nc4interface.F90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/nc4interface.F90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/ncunderflow.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/tools/ncunderflow.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/restcom.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/restcom.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/restcom.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/stringop.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD/src/stringop.f90	(revision 3437)
@@ -0,0 +1,1 @@
+link ../../../EXTERNAL/IOIPSL/src/stringop.f90
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 3437)
@@ -0,0 +1,1155 @@
+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
+   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
+   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 )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) )
+               CASE( NF90_SHORT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) )
+               CASE( NF90_INT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) )
+               CASE( NF90_FLOAT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) )
+               CASE( NF90_DOUBLE )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            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))))
+                  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))))
+                  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))))
+                  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))))
+                  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))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            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))
+                  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))
+                  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))
+                  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))
+                  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))
+                  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
+            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))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            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))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            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))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+         ELSE
+            WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account'
+            STOP
+         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
+            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
+         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
+         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
+         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
+         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
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE check_nf90
+
+
+END PROGRAM rebuild_nemo
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 3437)
@@ -0,0 +1,8 @@
+&namdct
+!----------------------------------------!
+!nsecdebug =-1 (debug all section        !
+!          = 0 (no section to debug)     !
+!          = n (debug section # n        !
+!----------------------------------------!
+nsecdebug= 1
+/
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 3437)
@@ -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 + 1 .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 
+               jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint
+           ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN
+               jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint
+           ELSE IF(  WestPoint%I==endingPoint%I .AND.  WestPoint%J==endingPoint%J )THEN
+               jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint
+           ELSE IF(   EstPoint%I==endingPoint%I .AND.   EstPoint%J==endingPoint%J )THEN
+               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 = ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) /  &
+                              ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I )      
+        ELSE
+           sec%slopeSection = 10000._wp
+        ENDIF
+     ENDIF
+ 
+  END SUBROUTINE compsec
+
+END MODULE compute_sections 
Index: /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 3437)
@@ -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 = 14            ! 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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/.log.dti	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/bugs	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/doc/SCRIPusers.tex	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/README	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertPOPT.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convert_old.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/convertgauss.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/create_latlon.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/grids/makefile	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_in	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/scrip_test_in	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/constants.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/copyright	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/grids.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/iounits.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/kinds_mod.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/makefile	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/netcdf.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bicubic.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_bilinear.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_conserv.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_distwgt.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_read.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_vars.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/remap_write.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/scrip_test_repeat.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/SCRIP1.4/source/timers.f	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/bin/freeform.py	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/CHANGES	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/namelist_example_bilin	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripgrid_mod.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripinterp_mod.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scripshape.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/CHANGES_BY_NOCS	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/constants.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/copyright
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/copyright	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/grids.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/iounits.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/kinds_mod.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/netcdf_mod.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bicubic.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_bilinear.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_conserv.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_distwgt.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_read.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_vars.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/remap_write.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scrip.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripgrid_mod.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripinterp_mod.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/scripshape.F90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/WEIGHTS/src/timers.f90	(revision 3437)
@@ -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/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/maketools
===================================================================
--- /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/maketools	(revision 3437)
+++ /branches/2012/dev_r3435_UKMO7_SCOORDS/NEMOGCM/TOOLS/maketools	(revision 3437)
@@ -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 ${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;
